{-# 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,
    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 Control.DeepSeq
import qualified Data.List.NonEmpty as NE

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 -> String -> String
ppCurrent :: WorkspaceId -> String
               -- ^ how to print the tag of the currently focused
               -- workspace
             , PP -> String -> String
ppVisible :: WorkspaceId -> String
               -- ^ how to print tags of visible but not focused
               -- workspaces (xinerama only)
             , PP -> String -> String
ppHidden  :: WorkspaceId -> String
               -- ^ how to print tags of hidden workspaces which
               -- contain windows
             , PP -> String -> String
ppHiddenNoWindows :: WorkspaceId -> String
               -- ^ how to print tags of empty hidden workspaces
             , PP -> Maybe (String -> String)
ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
               -- ^ how to print tags of empty visible workspaces
             , PP -> String -> String
ppUrgent :: WorkspaceId -> String
               -- ^ format to be applied to tags of urgent workspaces.
             , PP -> String -> WindowSpace -> String
ppRename :: String -> WindowSpace -> String
               -- ^ rename/augment the workspace tag
               --   (note that @WindowSpace -> …@ acts as a Reader monad)
             , PP -> String
ppSep :: String
               -- ^ separator to use between different log sections
               -- (window name, layout, workspaces)
             , PP -> String
ppWsSep :: String
               -- ^ separator to use between workspace tags
             , PP -> String -> String
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 -> String -> String
ppTitleSanitize :: String -> String
              -- ^ escape / sanitizes input to 'ppTitle'
             , PP -> String -> String
ppLayout :: String -> String
               -- ^ layout name format
             , PP -> [String] -> [String]
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 String)]
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 -> String -> 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 { ppCurrent :: String -> String
ppCurrent          = String -> String -> String -> String
wrap String
"[" String
"]"
           , ppVisible :: String -> String
ppVisible          = String -> String -> String -> String
wrap String
"<" String
">"
           , ppHidden :: String -> String
ppHidden           = forall a. a -> a
id
           , ppHiddenNoWindows :: String -> String
ppHiddenNoWindows  = forall a b. a -> b -> a
const String
""
           , ppVisibleNoWindows :: Maybe (String -> String)
ppVisibleNoWindows = forall a. Maybe a
Nothing
           , ppUrgent :: String -> String
ppUrgent           = forall a. a -> a
id
           , ppRename :: String -> WindowSpace -> String
ppRename           = forall (f :: * -> *) a. Applicative f => a -> f a
pure
           , ppSep :: String
ppSep              = String
" : "
           , ppWsSep :: String
ppWsSep            = String
" "
           , ppTitle :: String -> String
ppTitle            = Int -> String -> String
shorten Int
80
           , ppTitleSanitize :: String -> String
ppTitleSanitize    = String -> String
xmobarStrip forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dzenEscape
           , ppLayout :: String -> String
ppLayout           = forall a. a -> a
id
           , ppOrder :: [String] -> [String]
ppOrder            = forall a. a -> a
id
           , ppOutput :: String -> IO ()
ppOutput           = String -> IO ()
putStrLn
           , ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort             = X ([WindowSpace] -> [WindowSpace])
getSortByIndex
           , ppExtras :: [X (Maybe String)]
ppExtras           = []
           , ppPrinters :: WSPP
ppPrinters         = 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 String
dynamicLogString PP
pp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP -> String -> 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 String
dynamicLogString PP
pp = forall a. a -> X a -> X a
userCodeDef String
"_|_" (PP -> X String
dynamicLogString' PP
pp)

-- | The guts of 'dynamicLogString'. Forces the result, so it may throw
--   an exception (most commonly because 'ppOrder' is non-total). Use
--   'dynamicLogString' for a version that catches the exception and
--   produces an error string.
dynamicLogString' :: PP -> X String
dynamicLogString' :: PP -> X String
dynamicLogString' PP
pp = do

    WindowSet
winset <- 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 :: String
ld = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
S.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current forall a b. (a -> b) -> a -> b
$ WindowSet
winset

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

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

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

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
sepBy (PP -> String
ppSep PP
pp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP -> [String] -> [String]
ppOrder PP
pp forall a b. (a -> b) -> a -> b
$
                        [ String
ws
                        , PP -> String -> String
ppLayout PP
pp String
ld
                        , PP -> String -> String
ppTitle  PP
pp forall a b. (a -> b) -> a -> b
$ PP -> String -> String
ppTitleSanitize PP
pp String
wt
                        ]
                        forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
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 -> String
pprWindowSet [WindowSpace] -> [WindowSpace]
sort' [Window]
urgents PP
pp WindowSet
s = String -> [String] -> String
sepBy (PP -> String
ppWsSep PP
pp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> String
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
sort' forall a b. (a -> b) -> a -> b
$
            forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
s forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
s) forall a. [a] -> [a] -> [a]
++ 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 -> String
fmt WindowSpace
w = String -> String
pr (PP -> String -> WindowSpace -> String
ppRename PP
pp (forall i l a. Workspace i l a -> i
S.tag WindowSpace
w) WindowSpace
w)
      where
        printers :: WSPP
printers = PP -> WSPP
ppPrinters PP
pp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WSPP
fallbackPrinters
        pr :: String -> String
pr = forall a. a -> Maybe a -> a
fromMaybe forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WSPP
printers forall a b. (a -> b) -> a -> b
$
            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            forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppUrgent
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isCurrent'          forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppCurrent
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisible'          forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppVisible
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisibleNoWindows' forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Maybe a -> a
fromMaybe PP -> String -> String
ppVisible PP -> Maybe (String -> String)
ppVisibleNoWindows
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isHidden'           forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppHidden
               forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True           forall {f :: * -> *} {b}.
(MonadReader WS f, Alternative f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppHiddenNoWindows
  where
    WS -> Bool
cond ?-> :: (WS -> Bool) -> (PP -> b) -> f b
?-> PP -> b
ppr = (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WS -> Bool
cond forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PP -> b
ppr 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]
..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Window
x -> (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS)) (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]
..} = forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS forall a. Eq a => a -> a -> Bool
== 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent) 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' forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent) forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent') 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]
..} = forall i l a. Workspace i l a -> i
S.tag WindowSpace
wsWS forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
visibles
  where visibles :: [String]
visibles = forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent)
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent')
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisible')
        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' = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isUrgent)
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isCurrent')
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisible')
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> Bool
isVisibleNoWindows')
        forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> WS -> Bool
isHidden'

pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama WindowSet
ws = String
"[" forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
onscreen forall a. [a] -> [a] -> [a]
++ String
"] " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
offscreen
  where onscreen :: [String]
onscreen  = forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall i l a sid sd. Screen i l a sid sd -> sid
S.screen forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
ws forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
ws
        offscreen :: [String]
offscreen = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall i l a. Workspace i l a -> i
S.tag forall a b. (a -> b) -> a -> b
$ 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 :: String -> String -> String -> String
wrap String
_ String
_ String
"" = String
""
wrap String
l String
r String
m  = String
l forall a. [a] -> [a] -> [a]
++ String
m forall a. [a] -> [a] -> [a]
++ String
r

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

-- | Trim leading and trailing whitespace from a string.
trim :: String -> String
trim :: String -> String
trim = String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
    where f :: String -> String
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> String -> String
shorten = String -> Int -> String -> String
shorten' String
"..."

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

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

-- | Like 'shorten'', but truncate from the left instead of right.
shortenLeft' :: String -> Int -> String -> String
shortenLeft' :: String -> Int -> String -> String
shortenLeft' String
end Int
n String
xs | Int
l forall a. Ord a => a -> a -> Bool
< Int
n     = String
xs
                      | Bool
otherwise = String
end forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
drop (Int
l forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
end) String
xs
 where l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
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 :: String -> [String] -> String
sepBy String
sep = forall a. [a] -> [[a]] -> [a]
intercalate String
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: String -> String -> String -> String
dzenColor String
fg String
bg = String -> String -> String -> String
wrap (String
fg1forall a. [a] -> [a] -> [a]
++String
bg1) (String
fg2forall a. [a] -> [a] -> [a]
++String
bg2)
 where (String
fg1,String
fg2) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fg = (String
"",String
"")
                 | Bool
otherwise = (String
"^fg(" forall a. [a] -> [a] -> [a]
++ String
fg forall a. [a] -> [a] -> [a]
++ String
")",String
"^fg()")
       (String
bg1,String
bg2) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg = (String
"",String
"")
                 | Bool
otherwise = (String
"^bg(" forall a. [a] -> [a] -> [a]
++ String
bg forall a. [a] -> [a] -> [a]
++ String
")",String
"^bg()")

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

-- | Strip dzen formatting or commands.
dzenStrip :: String -> String
dzenStrip :: String -> String
dzenStrip = String -> String -> String
strip [] where
    strip :: String -> String -> String
strip String
keep String
x
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x              = String
keep
      | String
"^^" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = String -> String -> String
strip (String
keep forall a. [a] -> [a] -> [a]
++ String
"^") (forall a. Int -> [a] -> [a]
drop Int
2 String
x)
      | String
"^"  forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = String -> String -> String
strip String
keep (forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
')') forall a b. (a -> b) -> a -> b
$ String
x)
      | Bool
otherwise           = let (String
good,String
x') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'^') String
x
                              in String -> String -> String
strip (String
keep forall a. [a] -> [a] -> [a]
++ String
good) String
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 -> String -> String
xmobarFont Int
index = String -> String -> String -> String
wrap (String
"<fn=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
index forall a. [a] -> [a] -> [a]
++ String
">") String
"</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 :: String -> String -> String -> String
xmobarColor String
fg String
bg = String -> String -> String -> String
wrap String
t String
"</fc>"
 where t :: String
t = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<fc=", String
fg, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg then String
"" else String
"," forall a. [a] -> [a] -> [a]
++ String
bg, String
">"]

-- | 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 :: String -> String -> String -> String
xmobarAction String
command String
button = String -> String -> String -> String
wrap String
l String
r
    where
        l :: String
l = String
"<action=`" forall a. [a] -> [a] -> [a]
++ String
command forall a. [a] -> [a] -> [a]
++ String
"` button=" forall a. [a] -> [a] -> [a]
++ String
button forall a. [a] -> [a] -> [a]
++ String
">"
        r :: String
r = String
"</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 :: String -> String -> Int -> String -> String
xmobarBorder String
border String
color Int
width = String -> String -> String -> String
wrap String
prefix String
"</box>"
  where
    prefix :: String
prefix = String
"<box type=" forall a. [a] -> [a] -> [a]
++ String
border forall a. [a] -> [a] -> [a]
++ String
" width=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
width forall a. [a] -> [a] -> [a]
++ String
" color="
      forall a. [a] -> [a] -> [a]
++ String
color forall a. [a] -> [a] -> [a]
++ String
">"

-- | 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 :: String -> String
xmobarRaw String
"" = String
""
xmobarRaw String
s  = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<raw=", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s, String
":", String
s, String
"/>"]

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

converge :: (Eq a) => (a -> a) -> a -> a
converge :: forall a. Eq a => (a -> a) -> a -> a
converge a -> a
f a
a
  = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -- If this function terminates, we will find a match.
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(/=))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs
  forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs
 where xs :: [a]
xs = forall a. (a -> a) -> a -> [a]
iterate a -> a
f a
a

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


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

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

-- | 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 :: [String] -> PP -> PP
filterOutWsPP [String]
ws PP
pp = PP
pp { ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [WindowSpace] -> [WindowSpace]
filterOutWs [String]
ws) 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 = forall a. Default a => a
def
  { ppCurrent :: String -> String
ppCurrent         = String -> String -> String -> String
dzenColor String
"white" String
"#2b4f98" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
  , ppVisible :: String -> String
ppVisible         = String -> String -> String -> String
dzenColor String
"black" String
"#999999" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
  , ppHidden :: String -> String
ppHidden          = String -> String -> String -> String
dzenColor String
"black" String
"#cccccc" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
  , ppHiddenNoWindows :: String -> String
ppHiddenNoWindows = forall a b. a -> b -> a
const String
""
  , ppUrgent :: String -> String
ppUrgent          = String -> String -> String -> String
dzenColor String
"red" String
"yellow" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
  , ppWsSep :: String
ppWsSep           = String
""
  , ppSep :: String
ppSep             = String
""
  , ppLayout :: String -> String
ppLayout          = String -> String -> String -> String
dzenColor String
"black" String
"#cccccc"
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> String -> String
pad forall a b. (a -> b) -> a -> b
$ case String
x of
                              String
"TilePrime Horizontal" -> String
"TTT"
                              String
"TilePrime Vertical"   -> String
"[]="
                              String
"Hinted Full"          -> String
"[ ]"
                              String
_                      -> String
x
                            )
  , ppTitle :: String -> String
ppTitle           = (String
"^bg(#324c80) " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dzenEscape
  }

-- | Some nice xmobar defaults.
xmobarPP :: PP
xmobarPP :: PP
xmobarPP = forall a. Default a => a
def { ppCurrent :: String -> String
ppCurrent = String -> String -> String -> String
xmobarColor String
"yellow" String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
wrap String
"[" String
"]"
               , ppTitle :: String -> String
ppTitle   = String -> String -> String -> String
xmobarColor String
"green" String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten Int
40
               , ppVisible :: String -> String
ppVisible = String -> String -> String -> String
wrap String
"(" String
")"
               , ppUrgent :: String -> String
ppUrgent  = String -> String -> String -> String
xmobarColor String
"red" String
"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 = forall a. Default a => a
def { ppCurrent :: String -> String
ppCurrent = String -> String -> String -> String
xmobarColor String
"white" String
"black"
                 , ppTitle :: String -> String
ppTitle   = String -> String -> String -> String
xmobarColor String
"#00ee00" String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten Int
120
                 }

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