{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE FlexibleContexts    #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.StatusBar.PP
-- Description :  The pretty-printing abstraction for handling status bars.
-- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>
-- Stability   :  unstable
-- Portability :  unportable
--
-- xmonad calls the logHook with every internal state update, which is
-- useful for (among other things) outputting status information to an
-- external status bar program such as xmobar or dzen.
--
-- This module provides a pretty-printing abstraction and utilities that can
-- be used to customize what is logged to a status bar. See
-- "XMonad.Hooks.StatusBar" for an abstraction over starting these status
-- bars. Together these are a modern replacement for
-- "XMonad.Hooks.DynamicLog", which is now just a compatibility wrapper.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.StatusBar.PP (
    -- * Usage
    -- $usage

    -- * Build your own formatter
    PP(..), def,
    dynamicLogString,
    dynamicLogWithPP,

    -- * Predicates and formatters
    -- $predicates
    WS(..), WSPP, WSPP', fallbackPrinters,
    isUrgent, isCurrent, isVisible, isVisibleNoWindows, isHidden,

    -- * Example formatters
    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,

    -- * Formatting utilities
    wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft',
    xmobarColor, xmobarFont, xmobarAction, xmobarBorder,
    xmobarRaw, xmobarStrip, xmobarStripTags,
    dzenColor, dzenEscape, dzenStrip, filterOutWsPP,

    -- * Internal formatting functions
    pprWindowSet,
    pprWindowSetXinerama

    ) where

import Control.Monad.Reader

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S

import XMonad.Util.NamedWindows
import XMonad.Util.WorkspaceCompare
import XMonad.Hooks.UrgencyHook

-- $usage
-- An example usage for this module would be:
--
-- > import XMonad
-- > import XMonad.Hooks.StatusBar
-- > import XMonad.Hooks.StatusBar.PP
-- >
-- > myPP = def { ppCurrent = xmobarColor "black" "white" }
-- > mySB = statusBarProp "xmobar" (pure myPP)
-- > main = xmonad . withEasySB mySB defToggleStrutsKey $ myConfig
--
-- Check "XMonad.Hooks.StatusBar" for more examples and an in depth
-- explanation.

-- | The 'PP' type allows the user to customize the formatting of
--   status information.
data PP = PP { PP -> WorkspaceId -> WorkspaceId
ppCurrent :: WorkspaceId -> String
               -- ^ how to print the tag of the currently focused
               -- workspace
             , PP -> WorkspaceId -> WorkspaceId
ppVisible :: WorkspaceId -> String
               -- ^ how to print tags of visible but not focused
               -- workspaces (xinerama only)
             , PP -> WorkspaceId -> WorkspaceId
ppHidden  :: WorkspaceId -> String
               -- ^ how to print tags of hidden workspaces which
               -- contain windows
             , PP -> WorkspaceId -> WorkspaceId
ppHiddenNoWindows :: WorkspaceId -> String
               -- ^ how to print tags of empty hidden workspaces
             , PP -> Maybe (WorkspaceId -> WorkspaceId)
ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
               -- ^ how to print tags of empty visible workspaces
             , PP -> WorkspaceId -> WorkspaceId
ppUrgent :: WorkspaceId -> String
               -- ^ format to be applied to tags of urgent workspaces.
             , PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename :: String -> WindowSpace -> String
               -- ^ rename/augment the workspace tag
               --   (note that @WindowSpace -> …@ acts as a Reader monad)
             , PP -> WorkspaceId
ppSep :: String
               -- ^ separator to use between different log sections
               -- (window name, layout, workspaces)
             , PP -> WorkspaceId
ppWsSep :: String
               -- ^ separator to use between workspace tags
             , PP -> WorkspaceId -> WorkspaceId
ppTitle :: String -> String
               -- ^ window title format for the focused window. To display
               -- the titles of all windows—even unfocused ones—check
               -- 'XMonad.Util.Loggers.logTitles'.
             , PP -> WorkspaceId -> WorkspaceId
ppTitleSanitize :: String -> String
              -- ^ escape / sanitizes input to 'ppTitle'
             , PP -> WorkspaceId -> WorkspaceId
ppLayout :: String -> String
               -- ^ layout name format
             , PP -> [WorkspaceId] -> [WorkspaceId]
ppOrder :: [String] -> [String]
               -- ^ how to order the different log sections. By
               --   default, this function receives a list with three
               --   formatted strings, representing the workspaces,
               --   the layout, and the current window titles,
               --   respectively. If you have specified any extra
               --   loggers in 'ppExtras', their output will also be
               --   appended to the list.  To get them in the reverse
               --   order, you can just use @ppOrder = reverse@.  If
               --   you don't want to display the current layout, you
               --   could use something like @ppOrder = \\(ws:_:t:_) ->
               --   [ws,t]@, and so on.
             , PP -> X ([WindowSpace] -> [WindowSpace])
ppSort :: X ([WindowSpace] -> [WindowSpace])
               -- ^ how to sort the workspaces.  See
               -- "XMonad.Util.WorkspaceCompare" for some useful
               -- sorts.
             , PP -> [X (Maybe WorkspaceId)]
ppExtras :: [X (Maybe String)]
               -- ^ loggers for generating extra information such as
               -- time and date, system load, battery status, and so
               -- on.  See "XMonad.Util.Loggers" for examples, or create
               -- your own!
             , PP -> WorkspaceId -> IO ()
ppOutput :: String -> IO ()
               -- ^ applied to the entire formatted string in order to
               -- output it.  Can be used to specify an alternative
               -- output method (e.g. write to a pipe instead of
               -- stdout), and\/or to perform some last-minute
               -- formatting. Note that this is only used by
               -- 'dynamicLogWithPP'; it won't work with 'dynamicLogString' or
               -- "XMonad.Hooks.StatusBar".
             , PP -> WSPP
ppPrinters :: WSPP
               -- ^ extend workspace types with custom predicates.
               -- Check $predicates for more details.
             }

-- | The default pretty printing options:
--
-- > 1 2 [3] 4 7 : full : title
--
-- That is, the currently populated workspaces, the current
-- workspace layout, and the title of the focused window.
instance Default PP where
  def :: PP
def = PP :: (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> Maybe (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WindowSpace -> WorkspaceId)
-> WorkspaceId
-> WorkspaceId
-> (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId)
-> ([WorkspaceId] -> [WorkspaceId])
-> X ([WindowSpace] -> [WindowSpace])
-> [X (Maybe WorkspaceId)]
-> (WorkspaceId -> IO ())
-> WSPP
-> PP
PP { ppCurrent :: WorkspaceId -> WorkspaceId
ppCurrent          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
"[" WorkspaceId
"]"
           , ppVisible :: WorkspaceId -> WorkspaceId
ppVisible          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
"<" WorkspaceId
">"
           , ppHidden :: WorkspaceId -> WorkspaceId
ppHidden           = WorkspaceId -> WorkspaceId
forall a. a -> a
id
           , ppHiddenNoWindows :: WorkspaceId -> WorkspaceId
ppHiddenNoWindows  = WorkspaceId -> WorkspaceId -> WorkspaceId
forall a b. a -> b -> a
const WorkspaceId
""
           , ppVisibleNoWindows :: Maybe (WorkspaceId -> WorkspaceId)
ppVisibleNoWindows = Maybe (WorkspaceId -> WorkspaceId)
forall a. Maybe a
Nothing
           , ppUrgent :: WorkspaceId -> WorkspaceId
ppUrgent           = WorkspaceId -> WorkspaceId
forall a. a -> a
id
           , ppRename :: WorkspaceId -> WindowSpace -> WorkspaceId
ppRename           = WorkspaceId -> WindowSpace -> WorkspaceId
forall (f :: * -> *) a. Applicative f => a -> f a
pure
           , ppSep :: WorkspaceId
ppSep              = WorkspaceId
" : "
           , ppWsSep :: WorkspaceId
ppWsSep            = WorkspaceId
" "
           , ppTitle :: WorkspaceId -> WorkspaceId
ppTitle            = Int -> WorkspaceId -> WorkspaceId
shorten Int
80
           , ppTitleSanitize :: WorkspaceId -> WorkspaceId
ppTitleSanitize    = WorkspaceId -> WorkspaceId
xmobarStrip (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
dzenEscape
           , ppLayout :: WorkspaceId -> WorkspaceId
ppLayout           = WorkspaceId -> WorkspaceId
forall a. a -> a
id
           , ppOrder :: [WorkspaceId] -> [WorkspaceId]
ppOrder            = [WorkspaceId] -> [WorkspaceId]
forall a. a -> a
id
           , ppOutput :: WorkspaceId -> IO ()
ppOutput           = WorkspaceId -> IO ()
putStrLn
           , ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort             = X ([WindowSpace] -> [WindowSpace])
getSortByIndex
           , ppExtras :: [X (Maybe WorkspaceId)]
ppExtras           = []
           , ppPrinters :: WSPP
ppPrinters         = WSPP
forall (f :: * -> *) a. Alternative f => f a
empty
           }

-- | Format the current status using the supplied pretty-printing format,
--   and write it to stdout.
dynamicLogWithPP :: PP -> X ()
dynamicLogWithPP :: PP -> X ()
dynamicLogWithPP PP
pp = PP -> X WorkspaceId
dynamicLogString PP
pp X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (WorkspaceId -> IO ()) -> WorkspaceId -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP -> WorkspaceId -> IO ()
ppOutput PP
pp

-- | The same as 'dynamicLogWithPP', except it simply returns the status
--   as a formatted string without actually printing it to stdout, to
--   allow for further processing, or use in some application other than
--   a status bar.
dynamicLogString :: PP -> X String
dynamicLogString :: PP -> X WorkspaceId
dynamicLogString PP
pp = do

    WindowSet
winset <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    [Window]
urgents <- X [Window]
readUrgents
    [WindowSpace] -> [WindowSpace]
sort' <- PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp

    -- layout description
    let ld :: WorkspaceId
ld = Layout Window -> WorkspaceId
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description (Layout Window -> WorkspaceId)
-> (WindowSet -> Layout Window) -> WindowSet -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Layout Window
forall i l a. Workspace i l a -> l
S.layout (WindowSpace -> Layout Window)
-> (WindowSet -> WindowSpace) -> WindowSet -> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WindowSpace)
-> (WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> WindowSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current (WindowSet -> WorkspaceId) -> WindowSet -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WindowSet
winset

    -- workspace list
    let ws :: WorkspaceId
ws = ([WindowSpace] -> [WindowSpace])
-> [Window] -> PP -> WindowSet -> WorkspaceId
pprWindowSet [WindowSpace] -> [WindowSpace]
sort' [Window]
urgents PP
pp WindowSet
winset

    -- run extra loggers, ignoring any that generate errors.
    [Maybe WorkspaceId]
extras <- (X (Maybe WorkspaceId) -> X (Maybe WorkspaceId))
-> [X (Maybe WorkspaceId)] -> X [Maybe WorkspaceId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe WorkspaceId -> X (Maybe WorkspaceId) -> X (Maybe WorkspaceId)
forall a. a -> X a -> X a
userCodeDef Maybe WorkspaceId
forall a. Maybe a
Nothing) ([X (Maybe WorkspaceId)] -> X [Maybe WorkspaceId])
-> [X (Maybe WorkspaceId)] -> X [Maybe WorkspaceId]
forall a b. (a -> b) -> a -> b
$ PP -> [X (Maybe WorkspaceId)]
ppExtras PP
pp

    -- window title
    WorkspaceId
wt <- X WorkspaceId
-> (Window -> X WorkspaceId) -> Maybe Window -> X WorkspaceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (WorkspaceId -> X WorkspaceId
forall (f :: * -> *) a. Applicative f => a -> f a
pure WorkspaceId
"") ((NamedWindow -> WorkspaceId) -> X NamedWindow -> X WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedWindow -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show (X NamedWindow -> X WorkspaceId)
-> (Window -> X NamedWindow) -> Window -> X WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X NamedWindow
getName) (Maybe Window -> X WorkspaceId)
-> (WindowSet -> Maybe Window) -> WindowSet -> X WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
S.peek (WindowSet -> X WorkspaceId) -> WindowSet -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ WindowSet
winset

    WorkspaceId -> X WorkspaceId
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId -> X WorkspaceId) -> WorkspaceId -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> [WorkspaceId] -> WorkspaceId
sepBy (PP -> WorkspaceId
ppSep PP
pp) ([WorkspaceId] -> WorkspaceId)
-> ([WorkspaceId] -> [WorkspaceId]) -> [WorkspaceId] -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP -> [WorkspaceId] -> [WorkspaceId]
ppOrder PP
pp ([WorkspaceId] -> WorkspaceId) -> [WorkspaceId] -> WorkspaceId
forall a b. (a -> b) -> a -> b
$
                        [ WorkspaceId
ws
                        , PP -> WorkspaceId -> WorkspaceId
ppLayout PP
pp WorkspaceId
ld
                        , PP -> WorkspaceId -> WorkspaceId
ppTitle  PP
pp (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ PP -> WorkspaceId -> WorkspaceId
ppTitleSanitize PP
pp WorkspaceId
wt
                        ]
                        [WorkspaceId] -> [WorkspaceId] -> [WorkspaceId]
forall a. [a] -> [a] -> [a]
++ [Maybe WorkspaceId] -> [WorkspaceId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe WorkspaceId]
extras

-- | Format the workspace information, given a workspace sorting function,
--   a list of urgent windows, a pretty-printer format, and the current
--   WindowSet.
pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String
pprWindowSet :: ([WindowSpace] -> [WindowSpace])
-> [Window] -> PP -> WindowSet -> WorkspaceId
pprWindowSet [WindowSpace] -> [WindowSpace]
sort' [Window]
urgents PP
pp WindowSet
s = WorkspaceId -> [WorkspaceId] -> WorkspaceId
sepBy (PP -> WorkspaceId
ppWsSep PP
pp) ([WorkspaceId] -> WorkspaceId)
-> ([WindowSpace] -> [WorkspaceId]) -> [WindowSpace] -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
fmt ([WindowSpace] -> [WorkspaceId])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
sort' ([WindowSpace] -> WorkspaceId) -> [WindowSpace] -> WorkspaceId
forall a b. (a -> b) -> a -> b
$
            (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WindowSpace)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
s Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
s) [WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ WindowSet -> [WindowSpace]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
s
  where
    fmt :: WindowSpace -> String
    fmt :: WindowSpace -> WorkspaceId
fmt WindowSpace
w = WorkspaceId -> WorkspaceId
pr (PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename PP
pp (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag WindowSpace
w) WindowSpace
w)
      where
        printers :: WSPP
printers = PP -> WSPP
ppPrinters PP
pp WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WSPP
fallbackPrinters
        pr :: WorkspaceId -> WorkspaceId
pr = (WorkspaceId -> WorkspaceId)
-> Maybe (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a. a -> Maybe a -> a
fromMaybe WorkspaceId -> WorkspaceId
forall a. a -> a
id (Maybe (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId)
-> Maybe (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WSPP -> WS -> Maybe (WorkspaceId -> WorkspaceId)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WSPP
printers (WS -> Maybe (WorkspaceId -> WorkspaceId))
-> WS -> Maybe (WorkspaceId -> WorkspaceId)
forall a b. (a -> b) -> a -> b
$
            WS :: [Window] -> WindowSet -> WindowSpace -> PP -> WS
WS{ wsUrgents :: [Window]
wsUrgents = [Window]
urgents, wsWindowSet :: WindowSet
wsWindowSet = WindowSet
s, wsWS :: WindowSpace
wsWS = WindowSpace
w, wsPP :: PP
wsPP = PP
pp }

-- $predicates
-- Using 'WSPP' with 'ppPrinters' allows extension modules (and users) to
-- extend 'PP' with new workspace types beyond 'ppCurrent', 'ppUrgent', and
-- the rest.

-- | The data available to 'WSPP''.
data WS = WS{ WS -> [Window]
wsUrgents :: [Window] -- ^ Urgent windows
            , WS -> WindowSet
wsWindowSet :: WindowSet -- ^ The entire 'WindowSet', for context
            , WS -> WindowSpace
wsWS :: WindowSpace -- ^ The 'WindowSpace' being formatted
            , WS -> PP
wsPP :: PP -- ^ The actual final 'PP'
            }

-- XXX: ReaderT instead of -> because there is no
--
-- > instance Alternative (Λa. r -> Maybe a)
--
-- (there cannot be, Haskell has no Λ), and there is no
--
-- > instance Alternative (Compose ((->) r) Maybe)
--
-- either, and even if there was, Compose isn't very practical.
--
-- But we don't need Alternative for WS -> Bool, so we use the simple
-- function-based reader for the condition functions, as their definitions are
-- much prettier that way. This may be a bit confusing. :-/
type WSPP' = ReaderT WS Maybe

-- | The type allowing to build formatters (and predicates). See
-- the source 'fallbackPrinters' for an example.
type WSPP = WSPP' (WorkspaceId -> String)

-- | For a 'PP' @pp@, @fallbackPrinters pp@ returns the default 'WSPP'
-- used to format workspaces: the formatter chosen corresponds to the
-- first matching workspace type, respecting the following precedence:
-- 'ppUrgent', 'ppCurrent', 'ppVisible', 'ppVisibleNoWindows', 'ppHidden',
-- 'ppHiddenNoWindows'.
--
-- This can be useful if one needs to use the default set of formatters and
-- post-process their output. (For pre-processing their input, there's
-- 'ppRename'.)
fallbackPrinters :: WSPP
fallbackPrinters :: WSPP
fallbackPrinters = WS -> Bool
isUrgent            (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> WorkspaceId -> WorkspaceId
ppUrgent
               WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isCurrent'          (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> WorkspaceId -> WorkspaceId
ppCurrent
               WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisible'          (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> WorkspaceId -> WorkspaceId
ppVisible
               WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisibleNoWindows' (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> ((WorkspaceId -> WorkspaceId)
 -> Maybe (WorkspaceId -> WorkspaceId)
 -> WorkspaceId
 -> WorkspaceId)
-> (PP -> WorkspaceId -> WorkspaceId)
-> (PP -> Maybe (WorkspaceId -> WorkspaceId))
-> PP
-> WorkspaceId
-> WorkspaceId
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (WorkspaceId -> WorkspaceId)
-> Maybe (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a. a -> Maybe a -> a
fromMaybe PP -> WorkspaceId -> WorkspaceId
ppVisible PP -> Maybe (WorkspaceId -> WorkspaceId)
ppVisibleNoWindows
               WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isHidden'           (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> WorkspaceId -> WorkspaceId
ppHidden
               WSPP -> WSPP -> WSPP
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> WS -> Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True           (WS -> Bool) -> (PP -> WorkspaceId -> WorkspaceId) -> WSPP
forall (f :: * -> *) b.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> WorkspaceId -> WorkspaceId
ppHiddenNoWindows
  where
    WS -> Bool
cond ?-> :: (WS -> Bool) -> (PP -> b) -> f b
?-> PP -> b
ppr = ((WS -> Bool) -> f Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WS -> Bool
cond f Bool -> (Bool -> f ()) -> f ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard) f () -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (WS -> b) -> f b
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PP -> b
ppr (PP -> b) -> (WS -> PP) -> WS -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WS -> PP
wsPP)

-- | Predicate for urgent workspaces.
isUrgent :: WS -> Bool
isUrgent :: WS -> Bool
isUrgent WS{[Window]
WindowSet
WindowSpace
PP
wsPP :: PP
wsWS :: WindowSpace
wsWindowSet :: WindowSet
wsUrgents :: [Window]
wsPP :: WS -> PP
wsWS :: WS -> WindowSpace
wsWindowSet :: WS -> WindowSet
wsUrgents :: WS -> [Window]
..} = (Window -> Bool) -> [Window] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Window
x -> (Maybe WorkspaceId -> Maybe WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId -> Maybe WorkspaceId
forall a. a -> Maybe a
Just (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS)) (Window -> WindowSet -> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
S.findTag Window
x WindowSet
wsWindowSet)) [Window]
wsUrgents

-- | Predicate for the current workspace. Caution: assumes default
-- precedence is respected.
isCurrent' :: WS -> Bool
isCurrent' :: WS -> Bool
isCurrent' WS{[Window]
WindowSet
WindowSpace
PP
wsPP :: PP
wsWS :: WindowSpace
wsWindowSet :: WindowSet
wsUrgents :: [Window]
wsPP :: WS -> PP
wsWS :: WS -> WindowSpace
wsWindowSet :: WS -> WindowSet
wsUrgents :: WS -> [Window]
..} = WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
S.currentTag WindowSet
wsWindowSet

-- | Predicate for the current workspace.
isCurrent :: WS -> Bool
isCurrent :: WS -> Bool
isCurrent = (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent) (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> WS -> Bool
isCurrent'

-- | Predicate for visible workspaces. Caution: assumes default
-- precedence is respected.
isVisible' :: WS -> Bool
isVisible' :: WS -> Bool
isVisible' = WS -> Bool
isVisibleNoWindows' (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Maybe (Stack Window) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Stack Window) -> Bool)
-> (WS -> Maybe (Stack Window)) -> WS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack (WindowSpace -> Maybe (Stack Window))
-> (WS -> WindowSpace) -> WS -> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WS -> WindowSpace
wsWS

-- | Predicate for visible workspaces.
isVisible :: WS -> Bool
isVisible :: WS -> Bool
isVisible = (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent) (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent') (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> WS -> Bool
isVisible'

-- | Predicate for visible workspaces that have no windows. Caution:
-- assumes default precedence is respected.
isVisibleNoWindows' :: WS -> Bool
isVisibleNoWindows' :: WS -> Bool
isVisibleNoWindows' WS{[Window]
WindowSet
WindowSpace
PP
wsPP :: PP
wsWS :: WindowSpace
wsWindowSet :: WindowSet
wsUrgents :: [Window]
wsPP :: WS -> PP
wsWS :: WS -> WindowSpace
wsWindowSet :: WS -> WindowSet
wsUrgents :: WS -> [Window]
..} = WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
visibles
  where visibles :: [WorkspaceId]
visibles = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag (WindowSpace -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WindowSpace)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) (WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
wsWindowSet)

-- | Predicate for visible workspaces that have no windows.
isVisibleNoWindows :: WS -> Bool
isVisibleNoWindows :: WS -> Bool
isVisibleNoWindows =
    (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent)
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent')
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisible')
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> WS -> Bool
isVisibleNoWindows'

-- | Predicate for non-empty hidden workspaces. Caution: assumes default
-- precedence is respected.
isHidden' :: WS -> Bool
isHidden' :: WS -> Bool
isHidden' = Maybe (Stack Window) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Stack Window) -> Bool)
-> (WS -> Maybe (Stack Window)) -> WS -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack (WindowSpace -> Maybe (Stack Window))
-> (WS -> WindowSpace) -> WS -> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WS -> WindowSpace
wsWS

-- | Predicate for hidden workspaces.
isHidden :: WS -> Bool
isHidden :: WS -> Bool
isHidden =
    (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent)
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent')
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisible')
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not (Bool -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisibleNoWindows')
        (WS -> Bool) -> (WS -> Bool) -> WS -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> WS -> Bool
isHidden'

pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama :: WindowSet -> WorkspaceId
pprWindowSetXinerama WindowSet
ws = WorkspaceId
"[" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ [WorkspaceId] -> WorkspaceId
unwords [WorkspaceId]
onscreen WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"] " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ [WorkspaceId] -> WorkspaceId
unwords [WorkspaceId]
offscreen
  where onscreen :: [WorkspaceId]
onscreen  = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag (WindowSpace -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WindowSpace)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace)
                        ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [WorkspaceId])
-> ([Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
S.screen ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [WorkspaceId])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
ws Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
ws
        offscreen :: [WorkspaceId]
offscreen = (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag ([WindowSpace] -> [WorkspaceId])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Stack Window) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Stack Window) -> Bool)
-> (WindowSpace -> Maybe (Stack Window)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack)
                        ([WindowSpace] -> [WindowSpace])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WindowSpace]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag ([WindowSpace] -> [WorkspaceId]) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WindowSpace]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
ws

-- | Wrap a string in delimiters, unless it is empty.
wrap :: String  -- ^ left delimiter
     -> String  -- ^ right delimiter
     -> String  -- ^ output string
     -> String
wrap :: WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
_ WorkspaceId
_ WorkspaceId
"" = WorkspaceId
""
wrap WorkspaceId
l WorkspaceId
r WorkspaceId
m  = WorkspaceId
l WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
m WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
r

-- | Pad a string with a leading and trailing space.
pad :: String -> String
pad :: WorkspaceId -> WorkspaceId
pad = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
" " WorkspaceId
" "

-- | Trim leading and trailing whitespace from a string.
trim :: String -> String
trim :: WorkspaceId -> WorkspaceId
trim = WorkspaceId -> WorkspaceId
f (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
f
    where f :: WorkspaceId -> WorkspaceId
f = WorkspaceId -> WorkspaceId
forall a. [a] -> [a]
reverse (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> WorkspaceId -> WorkspaceId
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

-- | Limit a string to a certain length, adding "..." if truncated.
shorten :: Int -> String -> String
shorten :: Int -> WorkspaceId -> WorkspaceId
shorten = WorkspaceId -> Int -> WorkspaceId -> WorkspaceId
shorten' WorkspaceId
"..."

-- | Limit a string to a certain length, adding @end@ if truncated.
shorten' :: String -> Int -> String -> String
shorten' :: WorkspaceId -> Int -> WorkspaceId -> WorkspaceId
shorten' WorkspaceId
end Int
n WorkspaceId
xs | WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = WorkspaceId
xs
                  | Bool
otherwise     = Int -> WorkspaceId -> WorkspaceId
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
end) WorkspaceId
xs WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
end

-- | Like 'shorten', but truncate from the left instead of right.
shortenLeft :: Int -> String -> String
shortenLeft :: Int -> WorkspaceId -> WorkspaceId
shortenLeft = WorkspaceId -> Int -> WorkspaceId -> WorkspaceId
shortenLeft' WorkspaceId
"..."

-- | Like 'shorten'', but truncate from the left instead of right.
shortenLeft' :: String -> Int -> String -> String
shortenLeft' :: WorkspaceId -> Int -> WorkspaceId -> WorkspaceId
shortenLeft' WorkspaceId
end Int
n WorkspaceId
xs | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n     = WorkspaceId
xs
                      | Bool
otherwise = WorkspaceId
end WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ Int -> WorkspaceId -> WorkspaceId
forall a. Int -> [a] -> [a]
drop (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
end) WorkspaceId
xs
 where l :: Int
l = WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
xs

-- | Output a list of strings, ignoring empty ones and separating the
--   rest with the given separator.
sepBy :: String   -- ^ separator
      -> [String] -- ^ fields to output
      -> String
sepBy :: WorkspaceId -> [WorkspaceId] -> WorkspaceId
sepBy WorkspaceId
sep = WorkspaceId -> [WorkspaceId] -> WorkspaceId
forall a. [a] -> [[a]] -> [a]
intercalate WorkspaceId
sep ([WorkspaceId] -> WorkspaceId)
-> ([WorkspaceId] -> [WorkspaceId]) -> [WorkspaceId] -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Bool) -> [WorkspaceId] -> [WorkspaceId]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (WorkspaceId -> Bool) -> WorkspaceId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)

-- | Use dzen escape codes to output a string with given foreground
--   and background colors.
dzenColor :: String  -- ^ foreground color: a color name, or #rrggbb format
          -> String  -- ^ background color
          -> String  -- ^ output string
          -> String
dzenColor :: WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
fg WorkspaceId
bg = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap (WorkspaceId
fg1WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++WorkspaceId
bg1) (WorkspaceId
fg2WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++WorkspaceId
bg2)
 where (WorkspaceId
fg1,WorkspaceId
fg2) | WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
fg = (WorkspaceId
"",WorkspaceId
"")
                 | Bool
otherwise = (WorkspaceId
"^fg(" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
fg WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
")",WorkspaceId
"^fg()")
       (WorkspaceId
bg1,WorkspaceId
bg2) | WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
bg = (WorkspaceId
"",WorkspaceId
"")
                 | Bool
otherwise = (WorkspaceId
"^bg(" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
bg WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
")",WorkspaceId
"^bg()")

-- | Escape any dzen metacharacters.
dzenEscape :: String -> String
dzenEscape :: WorkspaceId -> WorkspaceId
dzenEscape = (Char -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'^' then WorkspaceId
"^^" else [Char
x])

-- | Strip dzen formatting or commands.
dzenStrip :: String -> String
dzenStrip :: WorkspaceId -> WorkspaceId
dzenStrip = WorkspaceId -> WorkspaceId -> WorkspaceId
strip [] where
    strip :: WorkspaceId -> WorkspaceId -> WorkspaceId
strip WorkspaceId
keep WorkspaceId
x
      | WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
x              = WorkspaceId
keep
      | WorkspaceId
"^^" WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` WorkspaceId
x = WorkspaceId -> WorkspaceId -> WorkspaceId
strip (WorkspaceId
keep WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"^") (Int -> WorkspaceId -> WorkspaceId
forall a. Int -> [a] -> [a]
drop Int
2 WorkspaceId
x)
      | Char
'^' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId -> Char
forall a. [a] -> a
head WorkspaceId
x       = WorkspaceId -> WorkspaceId -> WorkspaceId
strip WorkspaceId
keep (Int -> WorkspaceId -> WorkspaceId
forall a. Int -> [a] -> [a]
drop Int
1 (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> WorkspaceId -> WorkspaceId
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')') (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId
x)
      | Bool
otherwise           = let (WorkspaceId
good,WorkspaceId
x') = (Char -> Bool) -> WorkspaceId -> (WorkspaceId, WorkspaceId)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'^') WorkspaceId
x
                              in WorkspaceId -> WorkspaceId -> WorkspaceId
strip (WorkspaceId
keep WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
good) WorkspaceId
x'

-- | Use xmobar escape codes to output a string with the font at the given index
xmobarFont :: Int     -- ^ index: index of the font to use (0: standard font)
           -> String  -- ^ output string
           -> String
xmobarFont :: Int -> WorkspaceId -> WorkspaceId
xmobarFont Int
index = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap (WorkspaceId
"<fn=" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show Int
index WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
">") WorkspaceId
"</fn>"

-- | Use xmobar escape codes to output a string with given foreground
--   and background colors.
xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
            -> String  -- ^ background color
            -> String  -- ^ output string
            -> String
xmobarColor :: WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
fg WorkspaceId
bg = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
t WorkspaceId
"</fc>"
 where t :: WorkspaceId
t = [WorkspaceId] -> WorkspaceId
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [WorkspaceId
"<fc=", WorkspaceId
fg, if WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null WorkspaceId
bg then WorkspaceId
"" else WorkspaceId
"," WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
bg, WorkspaceId
">"]

-- | Encapsulate text with an action. The text will be displayed, and the
-- action executed when the displayed text is clicked. Illegal input is not
-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
-- syntax wherein the command is surrounded by backticks.
xmobarAction :: String
                -- ^ Command. Use of backticks (`) will cause a parse error.
             -> String
                -- ^ Buttons 1-5, such as "145". Other characters will cause a
                -- parse error.
             -> String
                -- ^ Displayed/wrapped text.
             -> String
xmobarAction :: WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarAction WorkspaceId
command WorkspaceId
button = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
l WorkspaceId
r
    where
        l :: WorkspaceId
l = WorkspaceId
"<action=`" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
command WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"` button=" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
button WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
">"
        r :: WorkspaceId
r = WorkspaceId
"</action>"

-- | Use xmobar box to add a border to an arbitrary string.
xmobarBorder :: String -- ^ Border type. Possible values: VBoth, HBoth, Full,
                       -- Top, Bottom, Left or Right
             -> String -- ^ color: a color name, or #rrggbb format
             -> Int    -- ^ width in pixels
             -> String -- ^ output string
             -> String
xmobarBorder :: WorkspaceId -> WorkspaceId -> Int -> WorkspaceId -> WorkspaceId
xmobarBorder WorkspaceId
border WorkspaceId
color Int
width = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
prefix WorkspaceId
"</box>"
  where
    prefix :: WorkspaceId
prefix = WorkspaceId
"<box type=" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
border WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
" width=" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show Int
width WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
" color="
      WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
color WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
">"

-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
-- wrapped (perhaps from window titles) will be displayed only, with all tags
-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
-- to shorten the result.
xmobarRaw :: String -> String
xmobarRaw :: WorkspaceId -> WorkspaceId
xmobarRaw WorkspaceId
"" = WorkspaceId
""
xmobarRaw WorkspaceId
s  = [WorkspaceId] -> WorkspaceId
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [WorkspaceId
"<raw=", Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show (Int -> WorkspaceId) -> Int -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length WorkspaceId
s, WorkspaceId
":", WorkspaceId
s, WorkspaceId
"/>"]

-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
-- the matching tags like </fc>.
xmobarStrip :: String -> String
xmobarStrip :: WorkspaceId -> WorkspaceId
xmobarStrip = (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a. Eq a => (a -> a) -> a -> a
converge ([WorkspaceId] -> WorkspaceId -> WorkspaceId
xmobarStripTags [WorkspaceId
"fc",WorkspaceId
"icon",WorkspaceId
"action"])

converge :: (Eq a) => (a -> a) -> a -> a
converge :: (a -> a) -> a -> a
converge a -> a
f a
a = let xs :: [a]
xs = (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate a -> a
f a
a
    in (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> (a, a)
forall a. [a] -> a
head ([(a, a)] -> (a, a)) -> [(a, a)] -> (a, a)
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Bool) -> [(a, a)] -> [(a, a)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([(a, a)] -> [(a, a)]) -> [(a, a)] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs

xmobarStripTags :: [String] -- ^ tags
        -> String -> String -- ^ with all <tag>...</tag> removed
xmobarStripTags :: [WorkspaceId] -> WorkspaceId -> WorkspaceId
xmobarStripTags [WorkspaceId]
tags = WorkspaceId -> WorkspaceId -> WorkspaceId
strip [] where
    strip :: WorkspaceId -> WorkspaceId -> WorkspaceId
strip WorkspaceId
keep [] = WorkspaceId
keep
    strip WorkspaceId
keep WorkspaceId
x
        | WorkspaceId
rest: [WorkspaceId]
_ <- (WorkspaceId -> Maybe WorkspaceId)
-> [WorkspaceId] -> [WorkspaceId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WorkspaceId -> Maybe WorkspaceId
dropTag [WorkspaceId]
tags = WorkspaceId -> WorkspaceId -> WorkspaceId
strip WorkspaceId
keep WorkspaceId
rest


        | Char
'<':WorkspaceId
xs <- WorkspaceId
x = WorkspaceId -> WorkspaceId -> WorkspaceId
strip (WorkspaceId
keep WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"<") WorkspaceId
xs
        | (WorkspaceId
good,WorkspaceId
x') <- (Char -> Bool) -> WorkspaceId -> (WorkspaceId, WorkspaceId)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<') WorkspaceId
x = WorkspaceId -> WorkspaceId -> WorkspaceId
strip (WorkspaceId
keep WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
good) WorkspaceId
x' -- this is n^2 bad... but titles have few tags
      where dropTag :: String -> Maybe String
            dropTag :: WorkspaceId -> Maybe WorkspaceId
dropTag WorkspaceId
tag = [Maybe WorkspaceId] -> Maybe WorkspaceId
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(WorkspaceId -> WorkspaceId)
-> Maybe WorkspaceId -> Maybe WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WorkspaceId -> WorkspaceId
dropTilClose (WorkspaceId -> WorkspaceId
openTag WorkspaceId
tag WorkspaceId -> WorkspaceId -> Maybe WorkspaceId
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` WorkspaceId
x),
                                                   WorkspaceId -> WorkspaceId
closeTag WorkspaceId
tag WorkspaceId -> WorkspaceId -> Maybe WorkspaceId
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` WorkspaceId
x]

    dropTilClose, openTag, closeTag :: String -> String
    dropTilClose :: WorkspaceId -> WorkspaceId
dropTilClose = Int -> WorkspaceId -> WorkspaceId
forall a. Int -> [a] -> [a]
drop Int
1 (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> WorkspaceId -> WorkspaceId
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>')
    openTag :: WorkspaceId -> WorkspaceId
openTag WorkspaceId
str = WorkspaceId
"<" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
str WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"="
    closeTag :: WorkspaceId -> WorkspaceId
closeTag WorkspaceId
str = WorkspaceId
"</" WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
str WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
">"

-- | Transforms a pretty-printer into one not displaying the given workspaces.
--
-- For example, filtering out the @NSP@ workspace before giving the 'PP' to
-- 'dynamicLogWithPP':
--
-- > logHook = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] $ def
--
-- Here is another example, when using "XMonad.Layout.IndependentScreens".  If
-- you have handles @hLeft@ and @hRight@ for bars on the left and right screens,
-- respectively, and @pp@ is a pretty-printer function that takes a handle, you
-- could write
--
-- > logHook = let log screen handle = dynamicLogWithPP . filterOutWsPP [scratchpadWorkspaceTag] . marshallPP screen . pp $ handle
-- >           in log 0 hLeft >> log 1 hRight
filterOutWsPP :: [WorkspaceId] -> PP -> PP
filterOutWsPP :: [WorkspaceId] -> PP -> PP
filterOutWsPP [WorkspaceId]
ws PP
pp = PP
pp { ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = (([WindowSpace] -> [WindowSpace])
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> [WindowSpace] -> [WindowSpace]
filterOutWs [WorkspaceId]
ws) (([WindowSpace] -> [WindowSpace])
 -> [WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
-> X ([WindowSpace] -> [WindowSpace])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp }

-- | Settings to emulate dwm's statusbar, dzen only.
dzenPP :: PP
dzenPP :: PP
dzenPP = PP
forall a. Default a => a
def
  { ppCurrent :: WorkspaceId -> WorkspaceId
ppCurrent         = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"white" WorkspaceId
"#2b4f98" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
  , ppVisible :: WorkspaceId -> WorkspaceId
ppVisible         = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"black" WorkspaceId
"#999999" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
  , ppHidden :: WorkspaceId -> WorkspaceId
ppHidden          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"black" WorkspaceId
"#cccccc" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
  , ppHiddenNoWindows :: WorkspaceId -> WorkspaceId
ppHiddenNoWindows = WorkspaceId -> WorkspaceId -> WorkspaceId
forall a b. a -> b -> a
const WorkspaceId
""
  , ppUrgent :: WorkspaceId -> WorkspaceId
ppUrgent          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"red" WorkspaceId
"yellow" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
  , ppWsSep :: WorkspaceId
ppWsSep           = WorkspaceId
""
  , ppSep :: WorkspaceId
ppSep             = WorkspaceId
""
  , ppLayout :: WorkspaceId -> WorkspaceId
ppLayout          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"black" WorkspaceId
"#cccccc"
                          (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\WorkspaceId
x -> WorkspaceId -> WorkspaceId
pad (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ case WorkspaceId
x of
                              WorkspaceId
"TilePrime Horizontal" -> WorkspaceId
"TTT"
                              WorkspaceId
"TilePrime Vertical"   -> WorkspaceId
"[]="
                              WorkspaceId
"Hinted Full"          -> WorkspaceId
"[ ]"
                              WorkspaceId
_                      -> WorkspaceId
x
                            )
  , ppTitle :: WorkspaceId -> WorkspaceId
ppTitle           = (WorkspaceId
"^bg(#324c80) " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++) (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
dzenEscape
  }

-- | Some nice xmobar defaults.
xmobarPP :: PP
xmobarPP :: PP
xmobarPP = PP
forall a. Default a => a
def { ppCurrent :: WorkspaceId -> WorkspaceId
ppCurrent = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
"yellow" WorkspaceId
"" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
"[" WorkspaceId
"]"
               , ppTitle :: WorkspaceId -> WorkspaceId
ppTitle   = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
"green" WorkspaceId
"" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WorkspaceId -> WorkspaceId
shorten Int
40
               , ppVisible :: WorkspaceId -> WorkspaceId
ppVisible = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
wrap WorkspaceId
"(" WorkspaceId
")"
               , ppUrgent :: WorkspaceId -> WorkspaceId
ppUrgent  = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
"red" WorkspaceId
"yellow"
               }

-- | The options that sjanssen likes to use with xmobar, as an
-- example.  Note the use of 'xmobarColor' and the record update on
-- 'def'.
sjanssenPP :: PP
sjanssenPP :: PP
sjanssenPP = PP
forall a. Default a => a
def { ppCurrent :: WorkspaceId -> WorkspaceId
ppCurrent = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
"white" WorkspaceId
"black"
                 , ppTitle :: WorkspaceId -> WorkspaceId
ppTitle   = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
xmobarColor WorkspaceId
"#00ee00" WorkspaceId
"" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WorkspaceId -> WorkspaceId
shorten Int
120
                 }

-- | The options that byorgey likes to use with dzen, as another example.
byorgeyPP :: PP
byorgeyPP :: PP
byorgeyPP = PP
forall a. Default a => a
def { ppHiddenNoWindows :: WorkspaceId -> WorkspaceId
ppHiddenNoWindows = WorkspaceId -> WorkspaceId
showNamedWorkspaces
                , ppHidden :: WorkspaceId -> WorkspaceId
ppHidden          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"black" WorkspaceId
"#a8a3f7" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
                , ppCurrent :: WorkspaceId -> WorkspaceId
ppCurrent         = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"yellow" WorkspaceId
"#a8a3f7" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
                , ppUrgent :: WorkspaceId -> WorkspaceId
ppUrgent          = WorkspaceId -> WorkspaceId -> WorkspaceId -> WorkspaceId
dzenColor WorkspaceId
"red" WorkspaceId
"yellow" (WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId) -> WorkspaceId -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WorkspaceId
pad
                , ppSep :: WorkspaceId
ppSep             = WorkspaceId
" | "
                , ppWsSep :: WorkspaceId
ppWsSep           = WorkspaceId
""
                , ppTitle :: WorkspaceId -> WorkspaceId
ppTitle           = Int -> WorkspaceId -> WorkspaceId
shorten Int
70
                , ppOrder :: [WorkspaceId] -> [WorkspaceId]
ppOrder           = [WorkspaceId] -> [WorkspaceId]
forall a. [a] -> [a]
reverse
                }
 where
  showNamedWorkspaces :: WorkspaceId -> WorkspaceId
showNamedWorkspaces WorkspaceId
wsId =
    if (Char -> Bool) -> WorkspaceId -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> WorkspaceId -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` WorkspaceId
wsId) [Char
'a' .. Char
'z'] then WorkspaceId -> WorkspaceId
pad WorkspaceId
wsId else WorkspaceId
""