{-# 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           = String -> String
forall a. a -> a
id
           , ppHiddenNoWindows :: String -> String
ppHiddenNoWindows  = String -> String -> String
forall a b. a -> b -> a
const String
""
           , ppVisibleNoWindows :: Maybe (String -> String)
ppVisibleNoWindows = Maybe (String -> String)
forall a. Maybe a
Nothing
           , ppUrgent :: String -> String
ppUrgent           = String -> String
forall a. a -> a
id
           , ppRename :: String -> WindowSpace -> String
ppRename           = String -> WindowSpace -> String
forall a. a -> WindowSpace -> a
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 (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           = []
           , ppPrinters :: WSPP
ppPrinters         = WSPP
forall a. ReaderT WS Maybe a
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 X String -> (String -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
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 = String -> X String -> X String
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 <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    [Window]
urgents <- X [Window]
readUrgents
    [WindowSpace] -> [WindowSpace]
sort' <- PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp

    -- layout description
    let ld :: String
ld = Layout Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (Layout Window -> String)
-> (WindowSet -> Layout Window) -> WindowSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Layout Window
forall i l a. Workspace i l a -> l
S.layout (WindowSpace -> Layout Window)
-> (WindowSet -> WindowSpace) -> WindowSet -> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> WindowSpace)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> WindowSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current (WindowSet -> String) -> WindowSet -> String
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 <- (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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe String -> X (Maybe String) -> X (Maybe String)
forall a. a -> X a -> X a
userCodeDef 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

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

    String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$! String -> String
forall a. NFData a => a -> a
force (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ 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])
-> [Window] -> PP -> WindowSet -> String
pprWindowSet [WindowSpace] -> [WindowSpace]
sort' [Window]
urgents PP
pp 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
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 Window) Window ScreenId ScreenDetail
 -> WindowSpace)
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
s Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible WindowSet
s) [WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ WindowSet -> [WindowSpace]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
S.hidden WindowSet
s
  where
    fmt :: WindowSpace -> String
    fmt :: WindowSpace -> String
fmt WindowSpace
w = String -> String
pr (PP -> String -> WindowSpace -> String
ppRename PP
pp (WindowSpace -> String
forall i l a. Workspace i l a -> i
S.tag WindowSpace
w) WindowSpace
w)
      where
        printers :: WSPP
printers = PP -> WSPP
ppPrinters PP
pp WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WSPP
fallbackPrinters
        pr :: String -> String
pr = (String -> String) -> Maybe (String -> String) -> String -> String
forall a. a -> Maybe a -> a
fromMaybe String -> String
forall a. a -> a
id (Maybe (String -> String) -> String -> String)
-> Maybe (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ WSPP -> WS -> Maybe (String -> String)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT WSPP
printers (WS -> Maybe (String -> String)) -> WS -> Maybe (String -> String)
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            (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppUrgent
               WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isCurrent'          (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppCurrent
               WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisible'          (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppVisible
               WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isVisibleNoWindows' (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> ((String -> String)
 -> Maybe (String -> String) -> String -> String)
-> (PP -> String -> String)
-> (PP -> Maybe (String -> String))
-> PP
-> String
-> String
forall a b c. (a -> b -> c) -> (PP -> a) -> (PP -> b) -> PP -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (String -> String) -> Maybe (String -> String) -> String -> String
forall a. a -> Maybe a -> a
fromMaybe PP -> String -> String
ppVisible PP -> Maybe (String -> String)
ppVisibleNoWindows
               WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WS -> Bool
isHidden'           (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppHidden
               WSPP -> WSPP -> WSPP
forall a.
ReaderT WS Maybe a -> ReaderT WS Maybe a -> ReaderT WS Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> WS -> Bool
forall a. a -> WS -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True           (WS -> Bool) -> (PP -> String -> String) -> WSPP
forall {f :: * -> *} {b}.
(Alternative f, MonadReader WS f) =>
(WS -> Bool) -> (PP -> b) -> f b
?-> PP -> String -> String
ppHiddenNoWindows
  where
    WS -> Bool
cond ?-> :: (WS -> Bool) -> (PP -> b) -> f b
?-> PP -> b
ppr = ((WS -> Bool) -> f Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WS -> Bool
cond f Bool -> (Bool -> f ()) -> f ()
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard) f () -> f b -> f b
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (WS -> b) -> f b
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (PP -> b
ppr (PP -> b) -> (WS -> PP) -> WS -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WS -> PP
wsPP)

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

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

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

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

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

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

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

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

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

-- | 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 = 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 | String -> Int
forall a. [a] -> 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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
end) String
xs String -> String -> String
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n     = String
xs
                      | Bool
otherwise = String
end String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
end) String
xs
 where l :: Int
l = String -> Int
forall a. [a] -> Int
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 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate 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 a. [a] -> 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 String
fg 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 (String
fg1,String
fg2) | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
fg = (String
"",String
"")
                 | Bool
otherwise = (String
"^fg(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",String
"^fg()")
       (String
bg1,String
bg2) | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg = (String
"",String
"")
                 | Bool
otherwise = (String
"^bg(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",String
"^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 (\Char
x -> if Char
x Char -> Char -> Bool
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
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x              = String
keep
      | String
"^^" 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]
++ String
"^") (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
x)
      | String
"^"  String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = String -> String -> String
strip String
keep (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
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
/= Char
')') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
x)
      | Bool
otherwise           = let (String
good,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
/= Char
'^') 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 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=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
index String -> String -> String
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 = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<fc=", String
fg, if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg then String
"" else String
"," String -> String -> 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=`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
command String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"` button=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
button String -> String -> String
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=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
border String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" width=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
width String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" color="
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
color String -> String -> String
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  = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<raw=", Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
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 = (String -> String) -> String -> String
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
  = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> ([a] -> (a, a)) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (a, a) -> (a, a)
forall a. NonEmpty a -> a
NE.head (NonEmpty (a, a) -> (a, a))
-> ([a] -> NonEmpty (a, a)) -> [a] -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> NonEmpty (a, a)
forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -- If this function terminates, we will find a match.
  ([(a, a)] -> NonEmpty (a, a))
-> ([a] -> [(a, a)]) -> [a] -> NonEmpty (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((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] -> [(a, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs
  ([a] -> a) -> [a] -> a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
xs
 where xs :: [a]
xs = (a -> a) -> a -> [a]
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]
_ <- (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


        | Char
'<':String
xs <- String
x = String -> String -> String
strip (String
keep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"<") String
xs
        | (String
good,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
/= Char
'<') 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 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 a b. (a -> b) -> Maybe a -> Maybe b
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 Int
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
/= Char
'>')
    openTag :: String -> String
openTag String
str = String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"="
    closeTag :: String -> String
closeTag String
str = String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
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 = (. filterOutWs ws) <$> ppSort pp }

-- | Settings to emulate dwm's statusbar, dzen only.
dzenPP :: PP
dzenPP :: PP
dzenPP = PP
forall a. Default a => a
def
  { ppCurrent         = dzenColor "white" "#2b4f98" . pad
  , ppVisible         = dzenColor "black" "#999999" . pad
  , ppHidden          = dzenColor "black" "#cccccc" . pad
  , ppHiddenNoWindows = const ""
  , ppUrgent          = dzenColor "red" "yellow" . pad
  , ppWsSep           = ""
  , ppSep             = ""
  , ppLayout          = dzenColor "black" "#cccccc"
                          . (\String
x -> String -> String
pad (String -> String) -> String -> String
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           = ("^bg(#324c80) " ++) . dzenEscape
  }

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