<commit_before>-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Pager
-- Copyright   : (c) <NAME>.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : <NAME>. <<EMAIL>>
-- Stability   : unstable
-- Portability : unportable
--
-- Common support for pager widgets. This module does not provide itself
-- any widgets, but implements an event dispatcher on which widgets can
-- subscribe the desktop events they're interested in, as well as common
-- configuration facilities.
--
-- N.B. If you're just looking for a drop-in replacement for the
-- "System.Taffybar.XMonadLog" widget that is clickable and doesn't require
-- DBus, you may want to see first "System.Taffybar.TaffyPager".
--
-- You need only one Pager component to instantiate any number of pager
-- widgets:
--
-- > pager <- pagerNew defaultPagerConfig
-- >
-- > let wss = wspaceSwitcherNew pager  -- Workspace Switcher widget
-- >     los = layoutSwitcherNew pager  -- Layout Switcher widget
-- >     wnd = windowSwitcherNew pager  -- Window Switcher widget
--
-----------------------------------------------------------------------------

module System.Taffybar.Pager
  ( Pager (..)
  , PagerConfig (..)
  , PagerIO
  , defaultPagerConfig
  , pagerNew
  , subscribe
  , colorize
  , liftPagerX11
  , liftPagerX11Def
  , runWithPager
  , shorten
  , wrap
  , escape
  ) where

import Control.Concurrent (forkIO)
import Control.Exception
import Control.Exception.Enclosed (catchAny)
import Control.Monad.Reader
import Data.IORef
import qualified Data.Map as M
import Graphics.UI.Gtk (escapeMarkup)
import Graphics.X11.Types
import Graphics.X11.Xlib.Extras
  hiding (rawGetWindowProperty, getWindowProperty8,
          getWindowProperty16, getWindowProperty32)
import System.Information.EWMHDesktopInfo
import System.Information.X11DesktopInfo
import Text.Printf (printf)

type Listener = Event -> IO ()
type Filter = Atom
type SubscriptionList = IORef [(Listener, Filter)]

-- | Structure contanining functions to customize the pretty printing of
-- different widget elements.
data PagerConfig = PagerConfig
  {
    -- | the name of the active window.
    activeWindow            :: String -> String
  -- | the currently active layout.
  , activeLayout            :: String -> String
  -- | the currently active workspace.
  , activeWorkspace         :: String -> String
  -- | inactive workspace with windows.
  , hiddenWorkspace         :: String -> String
  -- | inactive workspace with no windows.
  , emptyWorkspace          :: String -> String
  -- | all other visible workspaces (Xinerama or XRandR).
  , visibleWorkspace        :: String -> String
  -- | workspaces containing windows with the urgency hint set.
  , urgentWorkspace         :: String -> String
  -- | separator to use between desktop widgets in 'TaffyPager'.
  , widgetSep               :: String
  -- | wrap workspace buttons in a frame
  , workspaceBorder         :: Bool
  -- | space in pixels between workspace buttons
  , workspaceGap            :: Int
  -- | pad workspace name in button
  , workspacePad            :: Bool
  -- | use images in the workspace switcher
  , useImages               :: Bool
  -- | image height and width in pixels
  , imageSize               :: Int
  -- | fill empty images instead of clearing them
  , fillEmptyImages         :: Bool
  -- | get custom icon based on: has-EWMH-icon, window-title, window-class
  , customIcon              :: Bool -> String -> String -> Maybe FilePath
  -- | title windows for WindowSwitcher
  , windowSwitcherFormatter :: M.Map WorkspaceIdx String -> X11WindowHandle -> String
  }

-- | Structure containing the state of the Pager.
data Pager = Pager
  { config  :: PagerConfig -- ^ the configuration settings.
  , clients :: SubscriptionList -- ^ functions to apply on incoming events depending on their types.
  , pagerX11ContextVar :: IORef X11Context
  }

type PagerIO a = ReaderT Pager IO a

liftPagerX11 :: X11Property a -> PagerIO a
liftPagerX11 prop = ask >>= lift . flip runWithPager prop

liftPagerX11Def :: a -> X11Property a -> PagerIO a
liftPagerX11Def def prop = liftPagerX11 $ postX11RequestSyncProp prop def

runWithPager :: Pager -> X11Property a -> IO a
runWithPager pager prop = do
  x11Ctx <- readIORef $ pagerX11ContextVar pager
  -- runWithPager should probably changed so that it takes a default value
  runReaderT prop x11Ctx

-- | Default pretty printing options.<commit_msg>Fix alignment.<commit_after>-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Pager
-- Copyright   : (c) <NAME>.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : <NAME>. <<EMAIL>>
-- Stability   : unstable
-- Portability : unportable
--
-- Common support for pager widgets. This module does not provide itself
-- any widgets, but implements an event dispatcher on which widgets can
-- subscribe the desktop events they're interested in, as well as common
-- configuration facilities.
--
-- N.B. If you're just looking for a drop-in replacement for the
-- "System.Taffybar.XMonadLog" widget that is clickable and doesn't require
-- DBus, you may want to see first "System.Taffybar.TaffyPager".
--
-- You need only one Pager component to instantiate any number of pager
-- widgets:
--
-- > pager <- pagerNew defaultPagerConfig
-- >
-- > let wss = wspaceSwitcherNew pager  -- Workspace Switcher widget
-- >     los = layoutSwitcherNew pager  -- Layout Switcher widget
-- >     wnd = windowSwitcherNew pager  -- Window Switcher widget
--
-----------------------------------------------------------------------------

module System.Taffybar.Pager
  ( Pager (..)
  , PagerConfig (..)
  , PagerIO
  , defaultPagerConfig
  , pagerNew
  , subscribe
  , colorize
  , liftPagerX11
  , liftPagerX11Def
  , runWithPager
  , shorten
  , wrap
  , escape
  ) where

import Control.Concurrent (forkIO)
import Control.Exception
import Control.Exception.Enclosed (catchAny)
import Control.Monad.Reader
import Data.IORef
import qualified Data.Map as M
import Graphics.UI.Gtk (escapeMarkup)
import Graphics.X11.Types
import Graphics.X11.Xlib.Extras
  hiding (rawGetWindowProperty, getWindowProperty8,
          getWindowProperty16, getWindowProperty32)
import System.Information.EWMHDesktopInfo
import System.Information.X11DesktopInfo
import Text.Printf (printf)

type Listener = Event -> IO ()
type Filter = Atom
type SubscriptionList = IORef [(Listener, Filter)]

-- | Structure contanining functions to customize the pretty printing of
-- different widget elements.
data PagerConfig = PagerConfig
  { activeWindow            :: String -> String
  -- ^ the name of the active window.
  , activeLayout            :: String -> String
  -- ^ the currently active layout.
  , activeWorkspace         :: String -> String
  -- ^ the currently active workspace.
  , hiddenWorkspace         :: String -> String
  -- ^ inactive workspace with windows.
  , emptyWorkspace          :: String -> String
  -- ^ inactive workspace with no windows.
  , visibleWorkspace        :: String -> String
  -- ^ all other visible workspaces (Xinerama or XRandR).
  , urgentWorkspace         :: String -> String
  -- ^ workspaces containing windows with the urgency hint set.
  , widgetSep               :: String
  -- ^ separator to use between desktop widgets in 'TaffyPager'.
  , workspaceBorder         :: Bool
  -- ^ wrap workspace buttons in a frame
  , workspaceGap            :: Int
  -- ^ space in pixels between workspace buttons
  , workspacePad            :: Bool
  -- ^ pad workspace name in button
  , useImages               :: Bool
  -- ^ use images in the workspace switcher
  , imageSize               :: Int
  -- ^ image height and width in pixels
  , fillEmptyImages         :: Bool
  -- ^ fill empty images instead of clearing them
  , customIcon              :: Bool -> String -> String -> Maybe FilePath
  -- ^ get custom icon based on: has-EWMH-icon, window-title, window-class
  , windowSwitcherFormatter :: M.Map WorkspaceIdx String -> X11WindowHandle -> String
  -- ^ title windows for WindowSwitcher
  }

-- | Structure containing the state of the Pager.
data Pager = Pager
  { config  :: PagerConfig -- ^ the configuration settings.
  , clients :: SubscriptionList -- ^ functions to apply on incoming events depending on their types.
  , pagerX11ContextVar :: IORef X11Context
  }

type PagerIO a = ReaderT Pager IO a

liftPagerX11 :: X11Property a -> PagerIO a
liftPagerX11 prop = ask >>= lift . flip runWithPager prop

liftPagerX11Def :: a -> X11Property a -> PagerIO a
liftPagerX11Def def prop = liftPagerX11 $ postX11RequestSyncProp prop def

runWithPager :: Pager -> X11Property a -> IO a
runWithPager pager prop = do
  x11Ctx <- readIORef $ pagerX11ContextVar pager
  -- runWithPager should probably changed so that it takes a default value
  runReaderT prop x11Ctx

-- | Default pretty printing options.
{'fraction_non_alphanumeric': 0.12202746455286369, 'fraction_numerical': 0.010271296192921737, 'mean_word_length': 2.539312524693797, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 61, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7459709', 'n_tokens_mistral': 2559, 'n_tokens_neox': 2470, 'n_words': 856}