Split XMonad.Hooks.DynamicLog

- XMonad.Hooks.DynamicLog.PP: the pretty-printing abstracion, with the
corresponding utilities
- XMonad.Hooks.StatusBar: A new module to provide a better interface to
manage external status bars.

CHANGES.md

@@ -72,6 +72,17 @@
 
 ### New Modules
 
+  * `XMonad.Hooks.StatusBar.PP`
+
+    Originally contained inside `XMonad.Hooks.DynamicLog`, this module provides the
+    pretty-printing abstraction and utilities, used primarly with `logHook`.
+
+  * `XMonad.Hooks.StatusBar`
+
+    This module provides a new interface that replaces "XMonad.Hooks.DynamicLog",
+    by providing composoble status bars. Supports property-based as well
+    as pipe-based status bars.
+
   * `XMonad.Util.Hacks`
 
     Serves as a collection of hacks and fixes that should be easily acessible to users.
@@ -229,10 +240,6 @@
 
   * `XMonad.Hooks.DynamicLog`
 
-    - Added `statusBar'` function, like existing `statusBar` but accepts a pretty
-      printing options argument embedded in the X monad, to allow for dynamically
-      modified options such as `workspaceNamesPP`.
-
     - Added `shortenLeft` function, like existing `shorten` but shortens by
       truncating from left instead of right. Useful for showing directories.
 
@@ -242,16 +249,12 @@
     - Added `filterOutWsPP` for filtering out certain workspaces from being
       displayed.
 
-    - Added `xmobarProp`, `statusBarProp`, and `statusBarPropTo` for
-      property-based alternatives to `xmobar` and `statusBar` respectively.
+    - Added `xmobarProp`, for property-based alternative to `xmobar`.
 
     - Reworked the module documentation to suggest property-based logging
       instead of pipe-based logging, due to the various issues associated with
       the latter.
 
-    - Added `spawnStatusBarAndRemember` and `cleanupStatusBars` to provide
-      a way to safely restart status bars without relying on pipes.
-
     - Added `ppTitleUnfocused` to `PP` for showing unfocused windows on
       the current workspace in the status bar.
 
@@ -259,16 +262,6 @@
 
     - Add the -dock argument to the dzen spawn arguments
 
-    - Added `StatusBarConfig` and `makeStatusBar` and `makeStatusBar'` as
-      an abstraction for status bars; together with `statusBarPropConfig`,
-      `statusBarPropToConfig`, `statusBarHandleConfig` and `statusBarHandleConfig'`
-      to provide the configs for the already existing functionality. This provides
-      multiple status bars support.
-
-    - Added `ppRename` to `PP`, which makes it possible for extensions like
-      `workspaceNamesPP`, `marshallPP` and/or `clickablePP` to compose
-      intuitively.
-
   * `XMonad.Layout.BoringWindows`
 
     - Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions.

XMonad/Doc/Extending.hs

@@ -484,6 +484,10 @@ Here is a list of the modules found in @XMonad.Hooks@:
   putting in a status bar of some sort. See
   "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".
 
+* "XMonad.Hooks.StatusBar.PP": originally in "XMonad.Hooks.DynamicLog",
+   this module provides the pretty-printing abstraction 'PP' and a set of
+   functions to interact with it.
+
 * "XMonad.Hooks.EwmhDesktops":
     Makes xmonad use the EWMH hints to tell panel applications about its
     workspaces and the windows therein. It also allows the user to interact
@@ -559,6 +563,10 @@ Here is a list of the modules found in @XMonad.Hooks@:
     _NET_SUPPORTING_WM_CHECK protocol.  May be useful for making Java GUI
     programs work.
 
+* "XMonad.Hooks.StatusBar":
+   This module provides a new interface that replaces "XMonad.Hooks.DynamicLog",
+   by providing composoble and dynamic status bars.
+
 * "XMonad.Hooks.ToggleHook":
     Hook and keybindings for toggling hook behavior.
 
@@ -1735,7 +1743,8 @@ specifically for logging some of the most interesting information
 about the internal state of xmonad: "XMonad.Hooks.DynamicLog".  This
 module can be used with an external status bar to print the produced
 logs in a convenient way; the most commonly used status bars are dzen
-and xmobar.
+and xmobar. The module "XMonad.Hooks.StatusBar" offers another interface
+to interact with status bars, that might be more convenient to use.
 
 By default the 'XMonad.Core.logHook' doesn't produce anything. To
 enable it you need first to import "XMonad.Hooks.DynamicLog":

XMonad/Hooks/StatusBar.hs

@@ -0,0 +1,420 @@
+{-# LANGUAGE FlexibleContexts, TypeApplications #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.StatusBar
+-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module provides a new interface that replaces "XMonad.Hooks.DynamicLog",
+-- by providing composoble and dynamic status bars. Supports property-based as well
+-- as pipe-based status bars.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.StatusBar (
+  -- * Usage
+  -- $usage
+  StatusBarConfig(..),
+  makeStatusBar,
+  makeStatusBar',
+
+  -- * Available Configs
+  -- $availableconfigs
+  statusBarPipe,
+  statusBarProp,
+  statusBarPropTo,
+
+  -- * Multiple Status Bars
+  -- $multiple
+
+  -- * Property Logging utilities
+  xmonadPropLog,
+  xmonadPropLog',
+  xmonadDefProp,
+
+  -- * Managing Status Bar Processes
+  spawnStatusBarAndRemember,
+  cleanupStatusBars,
+  ) where
+
+import Control.Exception (SomeException, try)
+import Control.Monad (void)
+import qualified Codec.Binary.UTF8.String as UTF8 (encode)
+import System.Posix.Signals (sigTERM, signalProcessGroup)
+import System.Posix.Types (ProcessID)
+
+import qualified Data.Map        as M
+
+import Foreign.C (CChar)
+
+import XMonad
+
+import XMonad.Util.Run
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Layout.LayoutModifier
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.StatusBar.PP
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad
+-- >    import XMonad.Hooks.StatusBar
+-- >    import XMonad.Hooks.StatusBar.PP
+--
+-- The recommended way to use this module with xmobar, as well as any other
+-- status bar that supports property logging (you can read more about X11
+-- properties
+-- [here](https://en.wikipedia.org/wiki/X_Window_System_core_protocol#Properties)
+-- or
+-- [here](https://tronche.com/gui/x/xlib/window-information/properties-and-atoms.html),
+-- although you don't have to understand them in order to use the functions
+-- below), is to use 'statusBarProp' with 'makeStatusBar', which takes care of
+-- the necessary plumbing-no shell scripting required!
+--
+-- > main = do
+-- >   mySB <- statusBarProp "xmobar" (pure myPP)
+-- >   xmonad =<< makeStatusBar mySB myConf
+--
+-- which plays nice with other combinators that you might have already
+-- in your config:
+--
+-- > main = do
+-- >   mySB <- statusBarProp "xmobar" (pure myPP)
+-- >   xmonad =<< (makeStatusBar mySB . ewmh . docks $ def {...})
+--
+-- You then have to tell your status bar to read from the @_XMONAD_LOG@ property
+-- of the root window.  In the case of xmobar, this is simply achieved by using
+-- the @XMonadLog@ plugin instead of @StdinReader@ in your @.xmobarrc@:
+--
+-- > Config { ...
+-- >        , commands = [ Run XMonadLog, ... ]
+-- >        , template = "%XMonadLog% }{ ..."
+-- >        }
+--
+-- If you don't have an @.xmobarrc@, create it; the @XMonadLog@ plugin is not
+-- part of the default xmobar configuration and your status bar will not show
+-- otherwise!
+--
+-- With 'statusBarProp', you need to use property logging. Make sure the
+-- status bar you use supports reading a property string from the root window,
+-- or use some kind of wrapper that reads the property and pipes it into the
+-- bar (e.g. @xmonadpropread | dzen2@, see @scripts/xmonadpropread.hs@). The
+-- default property is @_XMONAD_LOG@, which is conveniently saved in 'xmonadDefProp'.
+-- You can use another property by using the function 'statusBarPropTo'.
+--
+-- If your status bar does not support property-based logging, you may also try
+-- 'statusBarPipe'.
+-- It can be used in the same way as 'statusBarProp' above (for xmobar, you will now
+-- use the @StdinReader@ plugin in your @.xmobarrc@).  Instead of writing to
+-- a property, this function opens a pipe and makes the given status bar read
+-- from that pipe.
+-- Please be aware that this kind of setup is very bug-prone and hence is
+-- discouraged: if anything goes wrong with the bar, xmonad will freeze.
+--
+-- If you do not want to use any of the "batteries included" functions above,
+-- you can also add all of the necessary plumbing yourself (the source of
+-- 'makeStatusBar' might come in handy here).
+--
+-- 'xmonadPropLog' allows you to write a string to the @_XMONAD_LOG@ property of
+-- the root window.  Together with 'dynamicLogString', you can now simply set
+-- your 'logHook' to the appropriate function, for instance
+--
+-- > main = xmonad $ def {
+-- >    ...
+-- >    , logHook = xmonadPropLog =<< dynamicLogString myPP
+-- >    ...
+-- >    }
+--
+-- If you want to define your own property name, use 'xmonadPropLog'' instead of
+-- 'xmonadPropLog'.
+--
+-- If you just want to use the default pretty-printing format, you can replace
+-- @myPP@ with 'def' in the above 'logHook'.
+--
+-- Note that setting 'logHook' only sets up xmonad's output; you are
+-- responsible for starting your own status bar program and making sure it reads
+-- from the property that xmonad writes to.  To start your bar, simply put it
+-- into your 'startupHook'.  You will also have also have to add 'docks' and
+-- 'avoidStruts' to your config.  Putting all of this together would look
+-- something like
+--
+-- > import XMonad.Util.SpawnOnce (spawnOnce)
+-- > import XMonad.Hooks.ManageDocks (avoidStruts, docks)
+-- >
+-- > main = do
+-- >     xmonad $ docks $ def {
+-- >       ...
+-- >       , logHook     = xmonadPropLog =<< dynamicLogString myPP
+-- >       , startupHook = spawnOnce "xmobar"
+-- >       , layoutHook  = avoidStruts myLayout
+-- >       ...
+-- >       }
+-- > myPP = def { ... }
+-- > myLayout = ...
+--
+-- If you want a keybinding to toggle your bar, you will also need to add this
+-- to the rest of your keybindings.
+--
+-- The above has the problem that xmobar will not get restarted whenever you
+-- restart xmonad ('XMonad.Util.SpawnOnce.spawnOnce' will simply prevent your
+-- chosen status bar from spawning again). Using 'statusBarProp', however, takes
+-- care of the necessary plumbing /and/ keeps track of the started status bars, so
+-- they can be correctly restarted with xmonad. This is achieved using
+-- 'spawnStatusBarAndRemember' to start them and 'cleanupStatusBars' to kill
+-- previously started ones.
+--
+-- 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))
+--
+-- If you use a status bar that does not support reading from a property log
+-- (like dzen), and you don't want to use the 'statusBar' function, you can,
+-- again, also manually add all of the required components.
+--
+-- This works much like the property based solution above, just that you will
+-- want to use 'dynamicLog' or 'dynamicLogXinerama' in place of 'xmonadPropLog'.
+--
+-- > 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 }
+--
+-- Again, you will have to do all the necessary plumbing yourself.  In addition,
+-- you are also responsible for creating a pipe for you status bar to read from:
+--
+-- > import XMonad.Util.Run (hPutStrLn, spawnPipe)
+-- >
+-- > main = do
+-- >     h <- spawnPipe "dzen2 -options -foo -bar"
+-- >     xmonad $ def {
+-- >       ...
+-- >       , logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }
+-- >       ...
+-- >       }
+--
+-- In the above, note that if you use @spawnPipe@ you need to redefine the
+-- 'ppOutput' field of your pretty-printer, as was done in the example above; by
+-- default the status will be printed to stdout rather than the pipe you create.
+--
+-- The status bars are managed through the 'StatusBarConfig', which provides
+-- a convenient abstraction over what a status bar is and how to manage it.
+-- This modules provides how to create these status bar configs, and how to
+-- incorporate them in your xmonad config: using 'makeStatusBar'
+-- or 'makeStatusBar''.
+--
+-- The difference between 'makeStatusBar' and 'makeStatusBar'' is that 'makeStatusBar'
+-- tries to stay out of your way, whereas 'makeStatusBar'' configures an
+-- extra keybinding to toggle the status bars, and also applies the
+-- 'avoidStruts' layout modifier as well as the 'docks' combinator.
+
+-- | This datataype abstracts a status bar to provide a common interface
+-- functions like 'statusBarPipe' or 'statusBarProp'. Once defined, a status
+-- bar can be incorporated in 'XConfig' by using 'makeStatusBar' or
+-- 'makeStatusBar'', which take care of the necessary plumbing.
+data StatusBarConfig = StatusBarConfig  { sbLogHook     :: X ()
+                                        -- ^ What and how to log to the status bar.
+                                        , sbStartupHook :: X ()
+                                        -- ^ How to start the status bar.
+                                        , sbCleanupHook :: X ()
+                                        -- ^ How to kill the status bar when xmonad is restarted.
+                                        -- This is useful when the status bar is not started
+                                        -- with a pipe.
+                                        }
+
+instance Semigroup StatusBarConfig where
+    StatusBarConfig l s c <> StatusBarConfig l' s' c' =
+      StatusBarConfig (l <> l') (s <> s') (c <> c')
+
+instance Monoid StatusBarConfig where
+    mempty = StatusBarConfig mempty mempty mempty
+
+-- | Per default, all the hooks do nothing.
+instance Default StatusBarConfig where
+    def = mempty
+
+-- | Incorporates a 'StatusBarConfig' into an 'XConfig' by taking care of the
+-- necessary plumbing (starting, restarting and logging to it).
+--
+-- Using this function multiple times to combine status bars may result in
+-- only one status bar working properly. See the section on using multiple
+-- status bars for more details.
+makeStatusBar :: LayoutClass l Window
+              => StatusBarConfig    -- ^ The status bar config
+              -> XConfig l          -- ^ The base config
+              -> IO (XConfig l)
+makeStatusBar (StatusBarConfig lh sh ch) conf =
+  return $ conf
+    { logHook     = logHook conf *> lh
+    , startupHook = startupHook conf *> ch *> sh
+    }
+
+-- | Like 'makeStatusBar', but takes an extra key to toggle struts. It also
+-- applies the 'avoidStruts' layout modifier and the 'docks' combinator.
+--
+-- Using this function multiple times to combine status bars may result in
+-- only one status bar working properly. See the section on using multiple
+-- status bars for more details.
+makeStatusBar' :: LayoutClass l Window
+               => StatusBarConfig -- ^ The status bar config
+               -> (XConfig Layout -> (KeyMask, KeySym))
+                                  -- ^ The key binding
+               -> XConfig l       -- ^ The base config
+               -> IO (XConfig (ModifiedLayout AvoidStruts l))
+makeStatusBar' sb k conf = do
+  conf' <- makeStatusBar sb conf
+  return $ docks $ conf' { layoutHook = avoidStruts (layoutHook conf')
+                         , keys       = (<>) <$> keys' <*> keys conf'
+                         }
+  where keys' = (`M.singleton` sendMessage ToggleStruts) . k
+
+-- | Creates a 'StatusBarConfig' that uses property logging to @_XMONAD_LOG@, which
+-- is set in 'xmonadDefProp'
+statusBarProp :: String -- ^ The command line to launch the status bar
+                    -> X PP   -- ^ The pretty printing options
+                    -> IO StatusBarConfig
+statusBarProp = statusBarPropTo xmonadDefProp
+
+-- | Like 'statusBarProp', but lets you define the property
+statusBarPropTo :: String -- ^ Property to write the string to
+                      -> String -- ^ The command line to launch the status bar
+                      -> X PP   -- ^ The pretty printing options
+                      -> IO StatusBarConfig
+statusBarPropTo prop cmd pp = pure def
+    { sbLogHook     = xmonadPropLog' prop =<< dynamicLogString =<< pp
+    , sbStartupHook = spawnStatusBarAndRemember cmd
+    , sbCleanupHook = cleanupStatusBars
+    }
+
+-- | Like 'statusBarProp', but uses pipe-based logging instead.
+statusBarPipe :: String -- ^ The command line to launch the status bar
+                      -> X PP   -- ^ The pretty printing options
+                      -> IO StatusBarConfig
+statusBarPipe cmd xpp  = do
+    h <- spawnPipe cmd
+    return $ def { sbLogHook = xpp >>= \pp -> dynamicLogWithPP pp { ppOutput = hPutStrLn h } }
+
+-- $multiple
+-- A pattern that is often found in a lot of configs that want multiple status bars,
+-- generally goes something like this:
+--
+-- > main = do
+-- >   xmproc0 <- spawnPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top"
+-- >   xmproc1 <- spawnPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom"
+-- >   xmproc2 <- spawnPipe "xmobar -x 1 $HOME/.config/xmobar/xmobarrc1"
+-- >   xmonad $ def {
+-- >     ...
+-- >     , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 }
+-- >              >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 }
+-- >              >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 }
+-- >     ...
+-- >   }
+--
+-- Which has a lot of boilerplate and is error-prone. By using the new interface, the
+-- config becomes more declarative and there's much less room for errors. You use it
+-- by creating the suitable status bar configs and combining them with '<>':
+--
+-- > main = do
+-- >   xmobarTop    <- statusBarPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top"    (pure ppTop)
+-- >   xmobarBottom <- statusBarPipe "xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
+-- >   xmobar1      <- statusBarPipe "xmobar -x 1 $HOME/.config/xmobar/xmobarrc1"       (pure pp1)
+-- >   xmonad =<< makeStatusBar (xmobarTop <> xmobarBottom <> xmobar1) myConfig
+--
+-- Or if you're feeling adventurous:
+--
+-- > myBars = map (uncurry statusBarPipe) [ ("xmobar -x 0 $HOME/.config/xmobar/xmobarrc_top",    pure ppTop)
+-- >                                              , ("xmobar -x 0 $HOME/.config/xmobar/xmobarrc_bottom", pure ppBottom)
+-- >                                              , ("xmobar -x 1 $HOME/.config/xmobar/xmobarrc1",       pure pp1) ]
+-- > main = do
+-- >   sbs <- sequence myBars
+-- >   xmonad =<< makeStatusBar (mconcat sbs) myConfig
+--
+-- The above examples also work if the different status bars support different
+-- logging methods: you could do mix property logging and logging via standard input.
+-- One thing to keep in mind: if multiple bars read from the same property, their content
+-- will be the same. If you want to use property-based logging with multiple bars,
+-- they should read from different properties.
+
+
+-- | The default property xmonad writes to. (@_XMONAD_LOG@).
+xmonadDefProp :: String
+xmonadDefProp = "_XMONAD_LOG"
+
+-- | Write a string to the @_XMONAD_LOG@ property on the root window.
+xmonadPropLog :: String -> X ()
+xmonadPropLog = xmonadPropLog' xmonadDefProp
+
+-- | 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  -- ^ Property name
+               -> String  -- ^ Message to be written to the property
+               -> X ()
+xmonadPropLog' prop msg = do
+    d <- asks display
+    r <- asks theRoot
+    xlog <- getAtom prop
+    ustring <- getAtom "UTF8_STRING"
+    io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)
+ where
+    encodeCChar :: String -> [CChar]
+    encodeCChar = map fromIntegral . UTF8.encode
+
+
+-- This newtype wrapper, together with the ExtensionClass instance make use of
+-- the extensible state to save the PIDs bewteen xmonad restarts.
+newtype StatusBarPIDs = StatusBarPIDs { getPIDs :: [ProcessID] }
+  deriving (Show, Read)
+
+instance ExtensionClass StatusBarPIDs where
+  initialValue = StatusBarPIDs []
+  extensionType = PersistentExtension
+
+-- | Kills the status bars started with 'spawnStatusBarAndRemember', and resets
+-- the state. This could go for example at the beginning of the startupHook.
+--
+-- Concretely, this function sends a 'sigTERM' to the saved PIDs using
+-- 'signalProcessGroup' to effectively terminate all processes, regardless
+-- of how many were started by using  'spawnStatusBarAndRemember'.
+--
+-- There is one caveat to keep in mind: to keep the implementation simple;
+-- no checks are executed before terminating the processes. This means: if the
+-- started process dies for some reason, and enough time passes for the PIDs
+-- to wrap around, this function might terminate another process that happens
+-- to have the same PID. However, this isn't a typical usage scenario.
+cleanupStatusBars :: X ()
+cleanupStatusBars =
+    getPIDs <$> XS.get
+    >>= (io . mapM_ killPid)
+    >> XS.put (StatusBarPIDs [])
+   where
+    killPid :: ProcessID -> IO ()
+    killPid pidToKill = void $ try @SomeException (signalProcessGroup sigTERM pidToKill)
+
+-- | Spawns a status bar and saves its PID. This is useful when the status bars
+-- should be restarted with xmonad. Use this in combination with 'cleanupStatusBars'.
+--
+-- Note: in some systems, multiple processes might start, even though one command is
+-- provided. This means the first PID, of the group leader, is saved.
+spawnStatusBarAndRemember :: String -- ^ The command used to spawn the status bar
+                          -> X ()
+spawnStatusBarAndRemember cmd = do
+  newPid <- spawnPID cmd
+  XS.modify (StatusBarPIDs . (newPid :) . getPIDs)

XMonad/Hooks/StatusBar/PP.hs

@@ -0,0 +1,441 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.StatusBar.PP
+-- 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
+--
+-- This module provides the pretty-printing abstraction and utilities that
+-- can be used inside the 'logHook'.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.StatusBar.PP (
+    -- * Usage
+    -- $usage
+
+    -- * Build your own formatter
+    PP(..), def,
+    dynamicLog,
+    dynamicLogString,
+    dynamicLogWithPP,
+
+    -- * Example formatters
+    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
+
+    -- * Formatting utilities
+    wrap, pad, trim, shorten, shorten', shortenLeft, shortenLeft',
+    xmobarColor, xmobarAction, xmobarBorder,
+    xmobarRaw, xmobarStrip, xmobarStripTags,
+    dzenColor, dzenEscape, dzenStrip, filterOutWsPP,
+
+    -- * Internal formatting functions
+    pprWindowSet,
+    pprWindowSetXinerama
+
+    ) where
+
+import Control.Applicative (liftA2)
+import Control.Monad (msum)
+import Data.Bool (bool)
+import Data.Char (isSpace)
+import Data.List (intercalate, isPrefixOf, sortOn, stripPrefix)
+import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
+
+import qualified XMonad.StackSet as S
+
+import XMonad
+
+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.DynamicLog
+-- >
+-- > myPP = def { ppCurrent = xmobarColor "black" "white" }
+-- > main = xmonad =<< statusBar "xmobar" myPP myToggleStrutsKey myConfig
+--
+-- Check "XMonad.Hooks.StatusBar" for how to use with status bars.
+--
+
+-- | The 'PP' type allows the user to customize the formatting of
+--   status information.
+data PP = PP { ppCurrent :: WorkspaceId -> String
+               -- ^ how to print the tag of the currently focused
+               -- workspace
+             , ppVisible :: WorkspaceId -> String
+               -- ^ how to print tags of visible but not focused
+               -- workspaces (xinerama only)
+             , ppHidden  :: WorkspaceId -> String
+               -- ^ how to print tags of hidden workspaces which
+               -- contain windows
+             , ppHiddenNoWindows :: WorkspaceId -> String
+               -- ^ how to print tags of empty hidden workspaces
+             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
+               -- ^ how to print tags of empty visible workspaces
+             , ppUrgent :: WorkspaceId -> String
+               -- ^ format to be applied to tags of urgent workspaces.
+             , ppRename :: String -> WindowSpace -> String
+               -- ^ rename/augment the workspace tag
+               --   (note that @WindowSpace -> …@ acts as a Reader monad)
+             , ppSep :: String
+               -- ^ separator to use between different log sections
+               -- (window name, layout, workspaces)
+             , ppWsSep :: String
+               -- ^ separator to use between workspace tags
+             , ppTitle :: String -> String
+               -- ^ window title format for the focused window
+             , ppTitleUnfocused :: String -> String
+               -- ^ window title format for unfocused windows
+             , ppTitleSanitize :: String -> String
+              -- ^ escape / sanitizes input to 'ppTitle' and
+              --   'ppTitleUnfocused'
+             , ppLayout :: String -> String
+               -- ^ layout name format
+             , 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.
+             , ppSort :: X ([WindowSpace] -> [WindowSpace])
+               -- ^ how to sort the workspaces.  See
+               -- "XMonad.Util.WorkspaceCompare" for some useful
+               -- sorts.
+             , 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!
+             , 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'.
+instance Default PP where
+  def = PP { ppCurrent          = wrap "[" "]"
+           , ppVisible          = wrap "<" ">"
+           , ppHidden           = id
+           , ppHiddenNoWindows  = const ""
+           , ppVisibleNoWindows = Nothing
+           , ppUrgent           = id
+           , ppRename           = pure
+           , ppSep              = " : "
+           , ppWsSep            = " "
+           , ppTitle            = shorten 80
+           , ppTitleUnfocused   = const ""
+           , ppTitleSanitize    = xmobarStrip . dzenEscape
+           , ppLayout           = id
+           , ppOrder            = id
+           , ppOutput           = putStrLn
+           , ppSort             = getSortByIndex
+           , ppExtras           = []
+           }
+-- | 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 = dynamicLogWithPP def
+
+-- | Format the current status using the supplied pretty-printing format,
+--   and write it to stdout.
+dynamicLogWithPP :: PP -> X ()
+dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput 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 = do
+
+    winset <- gets windowset
+    urgents <- readUrgents
+    sort' <- ppSort pp
+
+    -- layout description
+    let ld = description . S.layout . S.workspace . S.current $ winset
+
+    -- workspace list
+    let ws = pprWindowSet sort' urgents pp winset
+
+    -- window titles
+    let stack  = S.index winset
+        focWin = S.peek  winset
+        ppWin :: Window -> String -> String  -- pretty print a window title
+            = bool (ppTitleUnfocused pp) (ppTitle pp) . (focWin ==) . Just
+    winNames <- traverse (fmap show . getName) stack
+    let ppNames = unwords . filter (not . null) $
+            zipWith (\w n -> ppWin w $ ppTitleSanitize pp n) stack winNames
+
+    -- run extra loggers, ignoring any that generate errors.
+    extras <- mapM (`catchX` return Nothing) $ ppExtras pp
+
+    return $ sepBy (ppSep pp) . ppOrder pp $
+                        [ ws
+                        , ppLayout pp ld
+                        , ppNames
+                        ]
+                        ++ catMaybes 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 sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
+            map S.workspace (S.current s : S.visible s) ++ S.hidden s
+  where
+    this     = S.currentTag s
+    visibles = map (S.tag . S.workspace) (S.visible s)
+
+    fmt w = printer pp (ppRename pp (S.tag w) w)
+      where
+        printer | any (\x -> (== Just (S.tag w)) (S.findTag x s)) urgents = ppUrgent
+                | S.tag w == this                                         = ppCurrent
+                | S.tag w `elem` visibles && isJust (S.stack w)           = ppVisible
+                | S.tag w `elem` visibles                                 = liftA2 fromMaybe ppVisible ppVisibleNoWindows
+                | isJust (S.stack w)                                      = ppHidden
+                | otherwise                                               = ppHiddenNoWindows
+
+pprWindowSetXinerama :: WindowSet -> String
+pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
+  where onscreen  = map (S.tag . S.workspace)
+                        . sortOn S.screen $ S.current ws : S.visible ws
+        offscreen = map S.tag . filter (isJust . S.stack)
+                        . sortOn S.tag $ S.hidden ws
+
+-- | Wrap a string in delimiters, unless it is empty.
+wrap :: String  -- ^ left delimiter
+     -> String  -- ^ right delimiter
+     -> String  -- ^ output string
+     -> String
+wrap _ _ "" = ""
+wrap l r m  = l ++ m ++ r
+
+-- | Pad a string with a leading and trailing space.
+pad :: String -> String
+pad = wrap " " " "
+
+-- | Trim leading and trailing whitespace from a string.
+trim :: String -> String
+trim = f . f
+    where f = reverse . dropWhile isSpace
+
+-- | Limit a string to a certain length, adding "..." if truncated.
+shorten :: Int -> String -> String
+shorten = shorten' "..."
+
+-- | Limit a string to a certain length, adding @end@ if truncated.
+shorten' :: String -> Int -> String -> String
+shorten' end n xs | length xs < n = xs
+                  | otherwise     = take (n - length end) xs ++ end
+
+-- | Like 'shorten', but truncate from the left instead of right.
+shortenLeft :: Int -> String -> String
+shortenLeft = shortenLeft' "..."
+
+-- | Like 'shorten'', but truncate from the left instead of right.
+shortenLeft' :: String -> Int -> String -> String
+shortenLeft' end n xs | l < n     = xs
+                      | otherwise = end ++ drop (l - n + length end) xs
+ where l = length 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 sep = intercalate sep . filter (not . 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 fg bg = wrap (fg1++bg1) (fg2++bg2)
+ where (fg1,fg2) | null fg = ("","")
+                 | otherwise = ("^fg(" ++ fg ++ ")","^fg()")
+       (bg1,bg2) | null bg = ("","")
+                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")
+
+-- | Escape any dzen metacharacters.
+dzenEscape :: String -> String
+dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
+
+-- | Strip dzen formatting or commands.
+dzenStrip :: String -> String
+dzenStrip = strip [] where
+    strip keep x
+      | null x              = keep
+      | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)
+      | '^' == head x       = strip keep (drop 1 . dropWhile (/= ')') $ x)
+      | otherwise           = let (good,x') = span (/= '^') x
+                              in strip (keep ++ good) 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 fg bg = wrap t "</fc>"
+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ 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 command button = wrap l r
+    where
+        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
+        r = "</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 border color width = wrap prefix "</box>"
+  where
+    prefix = "<box type=" ++ border ++ " width=" ++ show width ++ " color="
+      ++ color ++ ">"
+
+-- | 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 "" = ""
+xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]
+
+-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
+-- the matching tags like </fc>.
+xmobarStrip :: String -> String
+xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])
+
+converge :: (Eq a) => (a -> a) -> a -> a
+converge f a = let xs = iterate f a
+    in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs
+
+xmobarStripTags :: [String] -- ^ tags
+        -> String -> String -- ^ with all <tag>...</tag> removed
+xmobarStripTags tags = strip [] where
+    strip keep [] = keep
+    strip keep x
+        | rest: _ <- mapMaybe dropTag tags = strip keep rest
+
+
+        | '<':xs <- x = strip (keep ++ "<") xs
+        | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags
+      where dropTag :: String -> Maybe String
+            dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),
+                                                   closeTag tag `stripPrefix` x]
+
+    dropTilClose, openTag, closeTag :: String -> String
+    dropTilClose = drop 1 . dropWhile (/= '>')
+    openTag str = "<" ++ str ++ "="
+    closeTag str = "</" ++ str ++ ">"
+
+-- | 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 ws pp = pp { ppSort = (. filterOutWs ws) <$> ppSort pp }
+
+-- | Settings to emulate dwm's statusbar, dzen only.
+dzenPP :: PP
+dzenPP = 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"
+                          . (\x -> pad $ case x of
+                              "TilePrime Horizontal" -> "TTT"
+                              "TilePrime Vertical"   -> "[]="
+                              "Hinted Full"          -> "[ ]"
+                              _                      -> x
+                            )
+  , ppTitle           = ("^bg(#324c80) " ++) . dzenEscape
+  }
+
+-- | Some nice xmobar defaults.
+xmobarPP :: PP
+xmobarPP = 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 = 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 = 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 wsId =
+    if any (`elem` wsId) ['a' .. 'z'] then pad wsId else ""

xmonad-contrib.cabal

@@ -186,6 +186,8 @@ library
                         XMonad.Hooks.Script
                         XMonad.Hooks.ServerMode
                         XMonad.Hooks.SetWMName
+                        XMonad.Hooks.StatusBar
+                        XMonad.Hooks.StatusBar.PP
                         XMonad.Hooks.ToggleHook
                         XMonad.Hooks.UrgencyHook
                         XMonad.Hooks.WallpaperSetter