{-# LANGUAGE FlexibleContexts, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.DynamicLog
-- 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.  DynamicLog
-- provides several drop-in logHooks for this purpose, as well as
-- flexible tools for specifying your own formatting.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.DynamicLog (
    -- * Usage
    -- $usage

    -- * Drop-in loggers
    dzen,
    dzenWithFlags,
    xmobar,
    statusBar,
    dynamicLog,
    dynamicLogXinerama,

    xmonadPropLog',
    xmonadPropLog,

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

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

    -- * Formatting utilities
    wrap, pad, trim, shorten,
    xmobarColor, xmobarAction, xmobarRaw,
    xmobarStrip, xmobarStripTags,
    dzenColor, dzenEscape, dzenStrip,

    -- * Internal formatting functions
    pprWindowSet,
    pprWindowSetXinerama

    -- * To Do
    -- $todo

  ) where

-- Useful imports

import Codec.Binary.UTF8.String (encodeString)
import Control.Monad (liftM2, msum)
import Data.Char ( isSpace, ord )
import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
import Data.Ord ( comparing )
import qualified Data.Map as M
import qualified XMonad.StackSet as S

import Foreign.C (CChar)

import XMonad

import XMonad.Util.WorkspaceCompare
import XMonad.Util.NamedWindows
import XMonad.Util.Run

import XMonad.Layout.LayoutModifier
import XMonad.Hooks.UrgencyHook
import XMonad.Hooks.ManageDocks

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- >    import XMonad
-- >    import XMonad.Hooks.DynamicLog
--
-- If you just want a quick-and-dirty status bar with zero effort, try
-- the 'xmobar' or 'dzen' functions:
--
-- > main = xmonad =<< xmobar myConfig
-- >
-- > myConfig = def { ... }
--
-- There is also 'statusBar' if you'd like to use another status bar, or would
-- like to use different formatting options.  The 'xmobar', 'dzen', and
-- 'statusBar' functions are preferred over the other options listed below, as
-- they take care of all the necessary plumbing -- no shell scripting required!
--
-- Alternatively, you can choose among several default status bar formats
-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the
-- appropriate function, for instance:
--
-- > main = xmonad $ def {
-- >    ...
-- >    logHook = dynamicLog
-- >    ...
-- >  }
--
-- For more flexibility, you can also use 'dynamicLogWithPP' and supply
-- your own pretty-printing format (by either defining one from scratch,
-- or customizing one of the provided examples).
-- For example:
--
-- >    -- use sjanssen's pretty-printer format, but with the sections
-- >    -- in reverse
-- >    logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse }
--
-- Note that setting the @logHook@ only sets up xmonad's output; you
-- are responsible for starting your own status bar program (e.g. dzen
-- or xmobar) and making sure xmonad's output is piped into it
-- appropriately, either by putting it in your @.xsession@ or similar
-- file, or by using @spawnPipe@ in your @main@ function, for example:
--
-- > import XMonad.Util.Run   -- for spawnPipe and hPutStrLn
-- >
-- > main = do
-- >     h <- spawnPipe "xmobar -options -foo -bar"
-- >     xmonad $ def {
-- >       ...
-- >       logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }
--
-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of
-- your pretty-printer as in the example above; by default the status
-- will be printed to stdout rather than the pipe you create.
--
-- Even if you don't use a statusbar, you can still use
-- 'dynamicLogString' to show on-screen notifications in response to
-- some events. For example, to show the current layout when it
-- changes, you could make a keybinding to cycle the layout and
-- display the current status:
--
-- >    , ((mod1Mask, xK_a     ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d))
--

-- $todo
--
--   * incorporate dynamicLogXinerama into the PP framework somehow
--
--   * add an xmobarEscape function

------------------------------------------------------------------------

-- | Run xmonad with a dzen status bar with specified dzen
--   command line arguments.
--
-- > main = xmonad =<< dzenWithFlags flags myConfig
-- >
-- > myConfig = def { ... }
-- >
-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d"
--
-- This function can be used to customize the arguments passed to dzen2.
-- e.g changing the default width and height of dzen2.
--
-- If you wish to customize the status bar format at all, you'll have to
-- use the 'statusBar' function instead.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar.
--
-- You should use this function only when the default 'dzen' function does not
-- serve your purpose.
--
dzenWithFlags :: LayoutClass l Window
    => String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzenWithFlags :: String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzenWithFlags flags :: String
flags conf :: XConfig l
conf = String
-> PP
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> IO (XConfig (ModifiedLayout AvoidStruts l))
forall (l :: * -> *).
LayoutClass l KeySym =>
String
-> PP
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar ("dzen2 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flags) PP
dzenPP XConfig Layout -> (KeyMask, KeySym)
forall (t :: * -> *). XConfig t -> (KeyMask, KeySym)
toggleStrutsKey XConfig l
conf

-- | Run xmonad with a dzen status bar set to some nice defaults.
--
-- > main = xmonad =<< dzen myConfig
-- >
-- > myConfig = def { ... }
--
-- The intent is that the above config file should provide a nice
-- status bar with minimal effort.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar. Please refer to 'dzenWithFlags' function for further
-- documentation.
--
dzen :: LayoutClass l Window
     => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzen :: XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzen conf :: XConfig l
conf = String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
forall (l :: * -> *).
LayoutClass l KeySym =>
String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzenWithFlags String
flags XConfig l
conf
 where
    fg :: String
fg      = "'#a8a3f7'" -- n.b quoting
    bg :: String
bg      = "'#3f3c6d'"
    flags :: String
flags   = "-e 'onstart=lower' -w 400 -ta l -fg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fg String -> String -> String
forall a. [a] -> [a] -> [a]
++ " -bg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bg


-- | Run xmonad with a xmobar status bar set to some nice defaults.
--
-- > main = xmonad =<< xmobar myConfig
-- >
-- > myConfig = def { ... }
--
-- This works pretty much the same as 'dzen' function above.
--
xmobar :: LayoutClass l Window
       => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
xmobar :: XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
xmobar conf :: XConfig l
conf = String
-> PP
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> IO (XConfig (ModifiedLayout AvoidStruts l))
forall (l :: * -> *).
LayoutClass l KeySym =>
String
-> PP
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar "xmobar" PP
xmobarPP XConfig Layout -> (KeyMask, KeySym)
forall (t :: * -> *). XConfig t -> (KeyMask, KeySym)
toggleStrutsKey XConfig l
conf

-- | Modifies the given base configuration to launch the given status bar,
-- send status information to that bar, and allocate space on the screen edges
-- for the bar.
statusBar :: LayoutClass l Window
          => String    -- ^ the command line to launch the status bar
          -> PP        -- ^ the pretty printing options
          -> (XConfig Layout -> (KeyMask, KeySym))
                       -- ^ the desired key binding to toggle bar visibility
          -> XConfig l -- ^ the base config
          -> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar :: String
-> PP
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> IO (XConfig (ModifiedLayout AvoidStruts l))
statusBar cmd :: String
cmd pp :: PP
pp k :: XConfig Layout -> (KeyMask, KeySym)
k conf :: XConfig l
conf = do
    Handle
h <- String -> IO Handle
forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipe String
cmd
    XConfig (ModifiedLayout AvoidStruts l)
-> IO (XConfig (ModifiedLayout AvoidStruts l))
forall (m :: * -> *) a. Monad m => a -> m a
return (XConfig (ModifiedLayout AvoidStruts l)
 -> IO (XConfig (ModifiedLayout AvoidStruts l)))
-> XConfig (ModifiedLayout AvoidStruts l)
-> IO (XConfig (ModifiedLayout AvoidStruts l))
forall a b. (a -> b) -> a -> b
$ XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall (a :: * -> *). XConfig a -> XConfig a
docks (XConfig (ModifiedLayout AvoidStruts l)
 -> XConfig (ModifiedLayout AvoidStruts l))
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall a b. (a -> b) -> a -> b
$ XConfig l
conf
        { layoutHook :: ModifiedLayout AvoidStruts l KeySym
layoutHook = l KeySym -> ModifiedLayout AvoidStruts l KeySym
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts (XConfig l -> l KeySym
forall (l :: * -> *). XConfig l -> l KeySym
layoutHook XConfig l
conf)
        , logHook :: X ()
logHook = do
                        XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf
                        PP -> X ()
dynamicLogWithPP PP
pp { ppOutput :: String -> IO ()
ppOutput = Handle -> String -> IO ()
hPutStrLn Handle
h }
        , keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys       = (Map (KeyMask, KeySym) (X ())
 -> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys' (XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf)
        }
 where
    keys' :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys' = ((KeyMask, KeySym) -> X () -> Map (KeyMask, KeySym) (X ())
forall k a. k -> a -> Map k a
`M.singleton` ToggleStruts -> X ()
forall a. Message a => a -> X ()
sendMessage ToggleStruts
ToggleStruts) ((KeyMask, KeySym) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig Layout -> (KeyMask, KeySym)
k

-- | Write a string to a property on the root window.  This property is of
-- type UTF8_STRING. The string must have been processed by encodeString
-- (dynamicLogString does this).
xmonadPropLog' :: String -> String -> X ()
xmonadPropLog' :: String -> String -> X ()
xmonadPropLog' prop :: String
prop msg :: String
msg = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    KeySym
r <- (XConf -> KeySym) -> X KeySym
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> KeySym
theRoot
    KeySym
xlog <- String -> X KeySym
getAtom String
prop
    KeySym
ustring <- String -> X KeySym
getAtom "UTF8_STRING"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> KeySym -> KeySym -> CInt -> [CChar] -> IO ()
changeProperty8 Display
d KeySym
r KeySym
xlog KeySym
ustring CInt
propModeReplace (String -> [CChar]
encodeCChar String
msg)
 where
    encodeCChar :: String -> [CChar]
    encodeCChar :: String -> [CChar]
encodeCChar = (Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CChar) -> (Char -> Int) -> Char -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)

-- | Write a string to the _XMONAD_LOG property on the root window.
xmonadPropLog :: String -> X ()
xmonadPropLog :: String -> X ()
xmonadPropLog = String -> String -> X ()
xmonadPropLog' "_XMONAD_LOG"

-- |
-- Helper function which provides ToggleStruts keybinding
--
toggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
toggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
toggleStrutsKey XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask = KeyMask
modm} = (KeyMask
modm, KeySym
xK_b )

------------------------------------------------------------------------

-- | An example log hook, which prints status information to stdout in
-- the default format:
--
-- > 1 2 [3] 4 7 : full : title
--
-- That is, the currently populated workspaces, the current
-- workspace layout, and the title of the focused window.
--
-- To customize the output format, see 'dynamicLogWithPP'.
--
dynamicLog :: X ()
dynamicLog :: X ()
dynamicLog = PP -> X ()
dynamicLogWithPP PP
forall a. Default a => a
def

-- | 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 = PP -> X String
dynamicLogString PP
pp X String -> (String -> 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 ()) -> (String -> IO ()) -> String -> X ()
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
pp = do

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

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

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

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

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

    String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ String -> String
encodeString (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
sepBy (PP -> String
ppSep PP
pp) ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP -> [String] -> [String]
ppOrder PP
pp ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                        [ String
ws
                        , PP -> String -> String
ppLayout PP
pp String
ld
                        , PP -> String -> String
ppTitle  PP
pp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ PP -> String -> String
ppTitleSanitize PP
pp String
wt
                        ]
                        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Maybe String] -> [String]
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])
-> [KeySym] -> PP -> WindowSet -> String
pprWindowSet sort' :: [WindowSpace] -> [WindowSpace]
sort' urgents :: [KeySym]
urgents pp :: PP
pp s :: WindowSet
s = String -> [String] -> String
sepBy (PP -> String
ppWsSep PP
pp) ([String] -> String)
-> ([WindowSpace] -> [String]) -> [WindowSpace] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> String) -> [WindowSpace] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> String
forall l a. Workspace String l a -> String
fmt ([WindowSpace] -> [String])
-> ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
sort' ([WindowSpace] -> String) -> [WindowSpace] -> String
forall a b. (a -> b) -> a -> b
$
            (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> WindowSpace)
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (WindowSet
-> Screen String (Layout KeySym) KeySym 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 String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen String (Layout KeySym) KeySym 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 this :: String
this     = WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
S.currentTag WindowSet
s
         visibles :: [String]
visibles = (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> String)
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map (WindowSpace -> String
forall i l a. Workspace i l a -> i
S.tag (WindowSpace -> String)
-> (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
    -> WindowSpace)
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) (WindowSet
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
s)

         fmt :: Workspace String l a -> String
fmt w :: Workspace String l a
w = PP -> String -> String
printer PP
pp (Workspace String l a -> String
forall i l a. Workspace i l a -> i
S.tag Workspace String l a
w)
          where printer :: PP -> String -> String
printer | (KeySym -> Bool) -> [KeySym] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\x :: KeySym
x -> Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Workspace String l a -> String
forall i l a. Workspace i l a -> i
S.tag Workspace String l a
w) (KeySym -> WindowSet -> Maybe String
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
S.findTag KeySym
x WindowSet
s)) [KeySym]
urgents  = PP -> String -> String
ppUrgent
                        | Workspace String l a -> String
forall i l a. Workspace i l a -> i
S.tag Workspace String l a
w String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
this                                               = PP -> String -> String
ppCurrent
                        | Workspace String l a -> String
forall i l a. Workspace i l a -> i
S.tag Workspace String l a
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
visibles Bool -> Bool -> Bool
&& Maybe (Stack a) -> Bool
forall a. Maybe a -> Bool
isJust (Workspace String l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace String l a
w)                 = PP -> String -> String
ppVisible
                        | Workspace String l a -> String
forall i l a. Workspace i l a -> i
S.tag Workspace String l a
w String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
visibles                                       = ((String -> String)
 -> Maybe (String -> String) -> String -> String)
-> (PP -> String -> String)
-> (PP -> Maybe (String -> String))
-> PP
-> String
-> String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (String -> String) -> Maybe (String -> String) -> String -> String
forall a. a -> Maybe a -> a
fromMaybe PP -> String -> String
ppVisible PP -> Maybe (String -> String)
ppVisibleNoWindows
                        | Maybe (Stack a) -> Bool
forall a. Maybe a -> Bool
isJust (Workspace String l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace String l a
w)                                            = PP -> String -> String
ppHidden
                        | Bool
otherwise                                                     = PP -> String -> String
ppHiddenNoWindows

-- |
-- Workspace logger with a format designed for Xinerama:
--
-- > [1 9 3] 2 7
--
-- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,
-- and 2 and 7 are non-visible, non-empty workspaces.
--
-- At the present time, the current layout and window title
-- are not shown.  The xinerama workspace format shown above can be (mostly) replicated
-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from
-- "XMonad.Util.WorkspaceCompare".  For example,
--
-- > def { ppCurrent = dzenColor "red" "#efebe7"
-- >     , ppVisible = wrap "[" "]"
-- >     , ppSort    = getSortByXineramaRule
-- >     }
dynamicLogXinerama :: X ()
dynamicLogXinerama :: X ()
dynamicLogXinerama = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (WindowSet -> IO ()) -> WindowSet -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn (String -> IO ()) -> (WindowSet -> String) -> WindowSet -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> String
pprWindowSetXinerama

pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama :: WindowSet -> String
pprWindowSetXinerama ws :: WindowSet
ws = "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
onscreen String -> String -> String
forall a. [a] -> [a] -> [a]
++ "] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
offscreen
  where onscreen :: [String]
onscreen  = (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> String)
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [String]
forall a b. (a -> b) -> [a] -> [b]
map (WindowSpace -> String
forall i l a. Workspace i l a -> i
S.tag (WindowSpace -> String)
-> (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
    -> WindowSpace)
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace)
                        ([Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
 -> [String])
-> ([Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
    -> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail])
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Ordering)
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> ScreenId)
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
S.screen) ([Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
 -> [String])
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [String]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen String (Layout KeySym) KeySym 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 String (Layout KeySym) KeySym ScreenId ScreenDetail
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen String (Layout KeySym) KeySym 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 :: [String]
offscreen = (WindowSpace -> String) -> [WindowSpace] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> String
forall i l a. Workspace i l a -> i
S.tag ([WindowSpace] -> [String])
-> ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Stack KeySym) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Stack KeySym) -> Bool)
-> (WindowSpace -> Maybe (Stack KeySym)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack KeySym)
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 -> WindowSpace -> Ordering)
-> [WindowSpace] -> [WindowSpace]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((WindowSpace -> String) -> WindowSpace -> WindowSpace -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing WindowSpace -> String
forall i l a. Workspace i l a -> i
S.tag) ([WindowSpace] -> [String]) -> [WindowSpace] -> [String]
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 :: String -> String -> String -> String
wrap _ _ "" = ""
wrap l :: String
l r :: String
r m :: String
m  = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m String -> String -> String
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 " " " "

-- | Trim leading and trailing whitespace from a string.
trim :: String -> String
trim :: String -> String
trim = String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
    where f :: String -> String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
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 n :: Int
n xs :: String
xs | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = String
xs
             | Bool
otherwise     = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
end) String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
end
 where
    end :: String
end = "..."

-- | 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 sep :: String
sep = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
sep ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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 :: String -> String -> String -> String
dzenColor fg :: String
fg bg :: String
bg = String -> String -> String -> String
wrap (String
fg1String -> String -> String
forall a. [a] -> [a] -> [a]
++String
bg1) (String
fg2String -> String -> String
forall a. [a] -> [a] -> [a]
++String
bg2)
 where (fg1 :: String
fg1,fg2 :: String
fg2) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fg = ("","")
                 | Bool
otherwise = ("^fg(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")","^fg()")
       (bg1 :: String
bg1,bg2 :: String
bg2) | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg = ("","")
                 | Bool
otherwise = ("^bg(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bg String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")","^bg()")

-- | Escape any dzen metacharacters.
dzenEscape :: String -> String
dzenEscape :: String -> String
dzenEscape = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\x :: Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '^' then "^^" 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 keep :: String
keep x :: String
x
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x              = String
keep
      | "^^" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = String -> String -> String
strip (String
keep String -> String -> String
forall a. [a] -> [a] -> [a]
++ "^") (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 2 String
x)
      | '^' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Char
forall a. [a] -> a
head String
x       = String -> String -> String
strip String
keep (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ')') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
x)
      | Bool
otherwise           = let (good :: String
good,x' :: String
x') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '^') String
x
                              in String -> String -> String
strip (String
keep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
good) String
x'

-- | 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 fg :: String
fg bg :: String
bg = String -> String -> String -> String
wrap String
t "</fc>"
 where t :: String
t = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["<fc=", String
fg, if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg then "" else "," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bg, ">"]

-- | 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 command :: String
command button :: String
button = String -> String -> String -> String
wrap String
l String
r
    where
        l :: String
l = "<action=`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
command String -> String -> String
forall a. [a] -> [a] -> [a]
++ "` button=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
button String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"
        r :: String
r = "</action>"

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

-- ??? add an xmobarEscape function?

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

converge :: (Eq a) => (a -> a) -> a -> a
converge :: (a -> a) -> a -> a
converge f :: a -> a
f a :: 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 :: [String] -> String -> String
xmobarStripTags tags :: [String]
tags = String -> String -> String
strip [] where
    strip :: String -> String -> String
strip keep :: String
keep [] = String
keep
    strip keep :: String
keep x :: String
x
        | rest :: String
rest: _ <- (String -> Maybe String) -> [String] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe String
dropTag [String]
tags = String -> String -> String
strip String
keep String
rest


        | '<':xs :: String
xs <- String
x = String -> String -> String
strip (String
keep String -> String -> String
forall a. [a] -> [a] -> [a]
++ "<") String
xs
        | (good :: String
good,x' :: String
x') <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '<') String
x = String -> String -> String
strip (String
keep String -> String -> String
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 tag :: String
tag = [Maybe String] -> Maybe String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
dropTilClose (String -> String
openTag String
tag String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` String
x),
                                                   String -> String
closeTag String
tag String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` String
x]

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

-- | 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
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
             , 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 title,
               --   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.
             }

-- | The default pretty printing options, as seen in 'dynamicLog'.
{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-}
defaultPP :: PP
defaultPP :: PP
defaultPP = PP
forall a. Default a => a
def

instance Default PP where
    def :: PP
def   = PP :: (String -> String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Maybe (String -> String)
-> (String -> String)
-> String
-> String
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> ([String] -> [String])
-> X ([WindowSpace] -> [WindowSpace])
-> [X (Maybe String)]
-> (String -> IO ())
-> PP
PP { ppCurrent :: String -> String
ppCurrent         = String -> String -> String -> String
wrap "[" "]"
               , ppVisible :: String -> String
ppVisible         = String -> String -> String -> String
wrap "<" ">"
               , ppHidden :: String -> String
ppHidden          = String -> String
forall a. a -> a
id
               , ppHiddenNoWindows :: String -> String
ppHiddenNoWindows = String -> String -> String
forall a b. a -> b -> a
const ""
               , ppVisibleNoWindows :: Maybe (String -> String)
ppVisibleNoWindows= Maybe (String -> String)
forall a. Maybe a
Nothing
               , ppUrgent :: String -> String
ppUrgent          = String -> String
forall a. a -> a
id
               , ppSep :: String
ppSep             = " : "
               , ppWsSep :: String
ppWsSep           = " "
               , ppTitle :: String -> String
ppTitle           = Int -> String -> String
shorten 80
               , ppTitleSanitize :: String -> String
ppTitleSanitize   = String -> String
xmobarStrip (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dzenEscape
               , ppLayout :: String -> String
ppLayout          = String -> String
forall a. a -> a
id
               , ppOrder :: [String] -> [String]
ppOrder           = [String] -> [String]
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          = []
               }

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

-- | Some nice xmobar defaults.
xmobarPP :: PP
xmobarPP :: PP
xmobarPP = PP
forall a. Default a => a
def { ppCurrent :: String -> String
ppCurrent = String -> String -> String -> String
xmobarColor "yellow" "" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> String
wrap "[" "]"
                     , ppTitle :: String -> String
ppTitle   = String -> String -> String -> String
xmobarColor "green"  "" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten 40
                     , ppVisible :: String -> String
ppVisible = String -> String -> String -> String
wrap "(" ")"
                     , ppUrgent :: String -> String
ppUrgent  = String -> String -> String -> String
xmobarColor "red" "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 :: String -> String
ppCurrent = String -> String -> String -> String
xmobarColor "white" "black"
                 , ppTitle :: String -> String
ppTitle = String -> String -> String -> String
xmobarColor "#00ee00" "" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten 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 :: String -> String
ppHiddenNoWindows = String -> String
showNamedWorkspaces
                , ppHidden :: String -> String
ppHidden  = String -> String -> String -> String
dzenColor "black"  "#a8a3f7" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
                , ppCurrent :: String -> String
ppCurrent = String -> String -> String -> String
dzenColor "yellow" "#a8a3f7" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
                , ppUrgent :: String -> String
ppUrgent  = String -> String -> String -> String
dzenColor "red"    "yellow"  (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
pad
                , ppSep :: String
ppSep     = " | "
                , ppWsSep :: String
ppWsSep   = ""
                , ppTitle :: String -> String
ppTitle   = Int -> String -> String
shorten 70
                , ppOrder :: [String] -> [String]
ppOrder   = [String] -> [String]
forall a. [a] -> [a]
reverse
                }
  where showNamedWorkspaces :: String -> String
showNamedWorkspaces wsId :: String
wsId = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
wsId) ['a'..'z']
                                       then String -> String
pad String
wsId
                                       else ""