{-# LANGUAGE FlexibleContexts, TypeApplications, TupleSections  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.StatusBar
-- Description :  Composable and dynamic status bars.
-- Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
-- 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 composable interface for (re)starting these status
-- bars and logging to them, either using pipes or X properties. There's also
-- "XMonad.Hooks.StatusBar.PP" which provides an abstraction and some
-- utilities for customization what is logged to a status bar. Together, these
-- are a modern replacement for "XMonad.Hooks.DynamicLog", which is now just a
-- compatibility wrapper.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.StatusBar (
  -- * Usage
  -- $usage
  StatusBarConfig(..),
  withSB,
  withEasySB,
  defToggleStrutsKey,

  -- * Available Configs
  -- $availableconfigs
  statusBarProp,
  statusBarPropTo,
  statusBarGeneric,
  statusBarPipe,

  -- * Multiple Status Bars
  -- $multiple

  -- * Dynamic Status Bars
  -- $dynamic
  dynamicSBs,
  dynamicEasySBs,

  -- * Property Logging utilities
  xmonadPropLog,
  xmonadPropLog',
  xmonadDefProp,

  -- * Managing status bar Processes
  -- $sbprocess
  spawnStatusBar,
  killStatusBar,
  killAllStatusBars,
  ) where

import Control.Exception (SomeException, try)
import Data.IORef (newIORef, readIORef, writeIORef)
import qualified Codec.Binary.UTF8.String as UTF8 (encode)
import qualified Data.Map as M
import System.IO (hClose)
import System.Posix.Signals (sigTERM, signalProcessGroup)
import System.Posix.Types (ProcessID)

import Foreign.C (CChar)

import XMonad
import XMonad.Prelude

import XMonad.Util.Run
import qualified XMonad.Util.ExtensibleState as XS

import XMonad.Layout.LayoutModifier
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.Rescreen
import XMonad.Hooks.StatusBar.PP
import qualified XMonad.StackSet as W

-- $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 easiest way to use this module with xmobar, as well as any other
-- status bar that supports property logging, is to use 'statusBarProp'
-- with 'withEasySB'; these take care of the necessary plumbing:
--
-- > mySB = statusBarProp "xmobar" (pure xmobarPP)
-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
--
-- 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
-- mentioned above.
--
-- Most users will, however, want to customize the logging and integrate it
-- into their existing custom xmonad configuration. The 'withSB'
-- function is more appropriate in this case: it doesn't touch your
-- keybindings, layout modifiers, or event hooks; instead, you're expected
-- to configure "XMonad.Hooks.ManageDocks" yourself. Here's what that might
-- look like:
--
-- > mySB = statusBarProp "xmobar" (pure myPP)
-- > main = xmonad . withSB 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 achieved by simply 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
-- workspace information 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 now
-- have to 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!
--
-- Also note that 'statusBarPipe' returns 'IO StatusBarConfig', so
-- you need to evaluate it before passing it to 'withSB' or 'withEasySB':
--
-- > main = do
-- >   mySB <- statusBarPipe "xmobar" (pure myPP)
-- >   xmonad $ withSB mySB myConf


-- $plumbing
-- 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
-- 'withSB' 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
-- 'spawnStatusBar' to start them and 'killStatusBar' to kill
-- previously started bars.
--
-- Even if you don't use a status bar, 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 >>= xmessage))
--
-- If you use a status bar that does not support reading from a property
-- (like dzen), and you don't want to use the 'statusBar' function, you can,
-- again, also manually add all of the required components, like this:
--
-- > 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; by default the status will be
-- printed to stdout rather than the pipe you create. This was meant to be
-- used together with running xmonad piped to a status bar like so: @xmonad |
-- dzen2@, and is what the old 'XMonad.Hooks.DynamicLog.dynamicLog' assumes,
-- but it isn't recommended in modern setups. Applications launched from
-- xmonad inherit its stdout and stderr, and will print their own garbage to
-- the status bar.


-- | 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 'withSB' or
-- 'withEasySB', which take care of the necessary plumbing.
data StatusBarConfig = StatusBarConfig  { StatusBarConfig -> X ()
sbLogHook     :: X ()
                                        -- ^ What and how to log to the status bar.
                                        , StatusBarConfig -> X ()
sbStartupHook :: X ()
                                        -- ^ How to start the status bar.
                                        , StatusBarConfig -> X ()
sbCleanupHook :: X ()
                                        -- ^ How to kill the status bar.
                                        }

instance Semigroup StatusBarConfig where
    StatusBarConfig X ()
l X ()
s X ()
c <> :: StatusBarConfig -> StatusBarConfig -> StatusBarConfig
<> StatusBarConfig X ()
l' X ()
s' X ()
c' =
      X () -> X () -> X () -> StatusBarConfig
StatusBarConfig (X ()
l X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
l') (X ()
s X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
s') (X ()
c X () -> X () -> X ()
forall a. Semigroup a => a -> a -> a
<> X ()
c')

instance Monoid StatusBarConfig where
    mempty :: StatusBarConfig
mempty = X () -> X () -> X () -> StatusBarConfig
StatusBarConfig X ()
forall a. Monoid a => a
mempty X ()
forall a. Monoid a => a
mempty X ()
forall a. Monoid a => a
mempty

-- | Per default, all the hooks do nothing.
instance Default StatusBarConfig where
    def :: StatusBarConfig
def = StatusBarConfig
forall a. Monoid a => a
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.
withSB :: LayoutClass l Window
       => StatusBarConfig    -- ^ The status bar config
       -> XConfig l          -- ^ The base config
       -> XConfig l
withSB :: StatusBarConfig -> XConfig l -> XConfig l
withSB (StatusBarConfig X ()
lh X ()
sh X ()
ch) XConfig l
conf = XConfig l
conf
    { logHook :: X ()
logHook     = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf X () -> X () -> X ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> X ()
lh
    , startupHook :: X ()
startupHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
conf X () -> X () -> X ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> X ()
ch X () -> X () -> X ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> X ()
sh
    }

-- | Like 'withSB', 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.
withEasySB :: LayoutClass l Window
           => StatusBarConfig -- ^ The status bar config
           -> (XConfig Layout -> (KeyMask, KeySym))
                              -- ^ The key binding
           -> XConfig l       -- ^ The base config
           -> XConfig (ModifiedLayout AvoidStruts l)
withEasySB :: StatusBarConfig
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig l
-> XConfig (ModifiedLayout AvoidStruts l)
withEasySB StatusBarConfig
sb XConfig Layout -> (KeyMask, KeySym)
k XConfig l
conf = XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall (a :: * -> *). XConfig a -> XConfig a
docks (XConfig (ModifiedLayout AvoidStruts l)
 -> XConfig (ModifiedLayout AvoidStruts l))
-> (XConfig (ModifiedLayout AvoidStruts l)
    -> XConfig (ModifiedLayout AvoidStruts l))
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBarConfig
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall (l :: * -> *).
LayoutClass l KeySym =>
StatusBarConfig -> XConfig l -> XConfig l
withSB StatusBarConfig
sb (XConfig (ModifiedLayout AvoidStruts l)
 -> XConfig (ModifiedLayout AvoidStruts l))
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall a b. (a -> b) -> a -> b
$ XConfig l
conf
    { layoutHook :: ModifiedLayout AvoidStruts l KeySym
layoutHook = l KeySym -> ModifiedLayout AvoidStruts l KeySym
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts (XConfig l -> l KeySym
forall (l :: * -> *). XConfig l -> l KeySym
layoutHook XConfig l
conf)
    , keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys       = Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall a. Semigroup a => a -> a -> a
(<>) (Map (KeyMask, KeySym) (X ())
 -> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys' (XConfig Layout
 -> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> Map (KeyMask, KeySym) (X ()))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf
    }
  where
    k' :: XConfig Layout -> (KeyMask, KeySym)
k' XConfig Layout
conf' = case XConfig Layout -> (KeyMask, KeySym)
k XConfig Layout
conf' of
        (KeyMask
0, KeySym
0) ->
            -- This usually means the user passed 'def' for the keybinding
            -- function, and is otherwise meaningless to harmful depending on
            -- whether 383ffb7 has been applied to xmonad or not. So do what
            -- they probably intend.
            --
            -- A user who wants no keybinding function should probably use
            -- 'withSB' instead, especially since NoSymbol didn't do anything
            -- sane before 383ffb7. ++bsa
            XConfig Layout -> (KeyMask, KeySym)
forall (t :: * -> *). XConfig t -> (KeyMask, KeySym)
defToggleStrutsKey XConfig Layout
conf'
        (KeyMask, KeySym)
key -> (KeyMask, KeySym)
key
    keys' :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys' = ((KeyMask, KeySym) -> X () -> Map (KeyMask, KeySym) (X ())
forall k a. k -> a -> Map k a
`M.singleton` ToggleStruts -> X ()
forall a. Message a => a -> X ()
sendMessage ToggleStruts
ToggleStruts) ((KeyMask, KeySym) -> Map (KeyMask, KeySym) (X ()))
-> (XConfig Layout -> (KeyMask, KeySym))
-> XConfig Layout
-> Map (KeyMask, KeySym) (X ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig Layout -> (KeyMask, KeySym)
k'

-- | Default @mod-b@ key binding for 'withEasySB'
defToggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
defToggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
defToggleStrutsKey XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask = KeyMask
modm} = (KeyMask
modm, KeySym
xK_b)

-- | 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
              -> StatusBarConfig
statusBarProp :: String -> X PP -> StatusBarConfig
statusBarProp = String -> String -> X PP -> StatusBarConfig
statusBarPropTo String
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
                -> StatusBarConfig
statusBarPropTo :: String -> String -> X PP -> StatusBarConfig
statusBarPropTo String
prop String
cmd X PP
pp = String -> X () -> StatusBarConfig
statusBarGeneric String
cmd (X () -> StatusBarConfig) -> X () -> StatusBarConfig
forall a b. (a -> b) -> a -> b
$
    String -> String -> X ()
xmonadPropLog' String
prop (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PP -> X String
dynamicLogString (PP -> X String) -> X PP -> X String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X PP
pp

-- | A generic 'StatusBarConfig' that launches a status bar but takes a
-- generic @X ()@ logging function instead of a 'PP'. This has several uses:
--
-- * With 'xmonadPropLog' or 'xmonadPropLog'' in the logging function, a
--   custom non-'PP'-based logger can be used for logging into an @xmobar@.
--
-- * With 'mempty' as the logging function, it's possible to manage a status
--   bar that reads information from EWMH properties like @taffybar@.
--
-- * With 'mempty' as the logging function, any other dock like @trayer@ or
--   @stalonetray@ can be managed by this module.
statusBarGeneric :: String -- ^ The command line to launch the status bar
                 -> X ()   -- ^ What and how to log to the status bar ('sbLogHook')
                 -> StatusBarConfig
statusBarGeneric :: String -> X () -> StatusBarConfig
statusBarGeneric String
cmd X ()
lh = StatusBarConfig
forall a. Default a => a
def
    { sbLogHook :: X ()
sbLogHook     = X ()
lh
    , sbStartupHook :: X ()
sbStartupHook = String -> X ()
spawnStatusBar String
cmd
    , sbCleanupHook :: X ()
sbCleanupHook = String -> X ()
killStatusBar String
cmd
    }

-- | 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 :: String -> X PP -> IO StatusBarConfig
statusBarPipe String
cmd X PP
xpp = do
    IORef (Maybe Handle)
hRef <- Maybe Handle -> IO (IORef (Maybe Handle))
forall a. a -> IO (IORef a)
newIORef Maybe Handle
forall a. Maybe a
Nothing
    StatusBarConfig -> IO StatusBarConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusBarConfig -> IO StatusBarConfig)
-> StatusBarConfig -> IO StatusBarConfig
forall a b. (a -> b) -> a -> b
$ StatusBarConfig
forall a. Default a => a
def
        { sbStartupHook :: X ()
sbStartupHook = IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Maybe Handle) -> Maybe Handle -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Handle)
hRef (Maybe Handle -> IO ())
-> (Handle -> Maybe Handle) -> Handle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Handle -> IO ()) -> IO Handle -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Handle
forall (m :: * -> *). MonadIO m => String -> m Handle
spawnPipe String
cmd)
        , sbLogHook :: X ()
sbLogHook     = do
              Maybe Handle
h' <- IO (Maybe Handle) -> X (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Maybe Handle) -> IO (Maybe Handle)
forall a. IORef a -> IO a
readIORef IORef (Maybe Handle)
hRef)
              Maybe Handle -> (Handle -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Handle
h' ((Handle -> X ()) -> X ()) -> (Handle -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> 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
. Handle -> String -> IO ()
hPutStrLn Handle
h (String -> X ()) -> X String -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PP -> X String
dynamicLogString (PP -> X String) -> X PP -> X String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X PP
xpp
        , sbCleanupHook :: X ()
sbCleanupHook = IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io
                          (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$   IORef (Maybe Handle) -> IO (Maybe Handle)
forall a. IORef a -> IO a
readIORef IORef (Maybe Handle)
hRef
                          IO (Maybe Handle) -> (Maybe Handle -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Handle -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
`whenJust` Handle -> IO ()
hClose)
                          IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  IORef (Maybe Handle) -> Maybe Handle -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Handle)
hRef Maybe Handle
forall a. Maybe a
Nothing
        }


-- $multiple
-- 'StatusBarConfig' is a 'Monoid', which means that multiple status bars can
-- be combined together using '<>' or 'mconcat' and passed to 'withSB'.
--
-- Here's an example of what such declarative configuration of multiple status
-- bars may look like:
--
-- > -- Make sure to setup the xmobar configs accordingly
-- > xmobarTop    = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"    (pure ppTop)
-- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
-- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)
-- >
-- > main = xmonad $ withSB (xmobarTop <> xmobarBottom <> xmobar1) myConfig
--
-- And here is an example of the related xmobar configuration for the multiple
-- status bars mentioned above:
--
-- > xmobarrc_top
-- > Config { ...
-- >        , commands = [ Run XPropertyLog "_XMONAD_LOG_1", ... ]
-- >        , template = "%_XMONAD_LOG_1% }{ ..."
-- >        }
--
-- The above example also works if the different status bars support different
-- logging methods: you could mix property logging and logging via pipes.
-- One thing to keep in mind is that 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.
--
-- "XMonad.Util.Loggers" includes loggers that can be bound to specific screens,
-- like 'logCurrentOnScreen', that might be useful with multiple screens.
--
-- Long-time xmonad users will note that the above config is equivalent to
-- the following less robust and more verbose configuration that they might
-- find in their old configs:
--
-- > main = do
-- >   -- do not use this, this is an example of a deprecated config
-- >   xmproc0 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"
-- >   xmproc1 <- spawnPipe "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom"
-- >   xmproc2 <- spawnPipe "xmobar -x 1 ~/.config/xmobar/xmobarrc1"
-- >   xmonad $ def {
-- >     ...
-- >     , logHook = dynamicLogWithPP ppTop { ppOutput = hPutStrLn xmproc0 }
-- >              >> dynamicLogWithPP ppBottom { ppOutput = hPutStrLn xmproc1 }
-- >              >> dynamicLogWithPP pp1 { ppOutput = hPutStrLn xmproc2 }
-- >     ...
-- >   }
--
-- By using the new interface, the config becomes more declarative and there's
-- less room for errors.
--
-- The only *problem* now is that the status bars will not be updated when your screen
-- configuration changes (by plugging in a monitor, for example). Check the section
-- on dynamic status bars for how to do that.

-- $dynamic
-- Using multiple status bars by just combining them with '<>' works well
-- as long as the screen configuration does not change often. If it does,
-- you should use 'dynamicSBs': by providing a function that creates
-- status bars, it takes care of setting up the event hook, the log hook
-- and the startup hook necessary to make the status bars, well, dynamic.
--
-- > xmobarTop    = statusBarPropTo "_XMONAD_LOG_1" "xmobar -x 0 ~/.config/xmobar/xmobarrc_top"    (pure ppTop)
-- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
-- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)
-- >
-- > barSpawner :: ScreenId -> IO StatusBarConfig
-- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen
-- > barSpawner 1 = pure $ xmobar1
-- > barSpawner _ = mempty -- nothing on the rest of the screens
-- >
-- > main = xmonad $ dynamicSBs barSpawner (def { ... })
--
-- Make sure you specify which screen to place the status bar on (in xmobar,
-- this is achieved by the @-x@ argument). In addition to making sure that your
-- status bar lands where you intended it to land, the commands are used
-- internally to keep track of the status bars.
--
-- Note also that this interface can be used with one screen, or if
-- the screen configuration doesn't change.

newtype ActiveSBs = ASB {ActiveSBs -> [(ScreenId, StatusBarConfig)]
getASBs :: [(ScreenId,  StatusBarConfig)]}

instance ExtensionClass ActiveSBs where
  initialValue :: ActiveSBs
initialValue = [(ScreenId, StatusBarConfig)] -> ActiveSBs
ASB []

-- | Given a function to create status bars, 'dynamicSBs'
-- adds the dynamic status bar capabilities to the config.
-- For a version of this function that applies 'docks' and
-- 'avoidStruts', check 'dynamicEasySBs'.
--
-- Heavily inspired by "XMonad.Hooks.DynamicBars"
dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs ScreenId -> IO StatusBarConfig
f XConfig l
conf = X () -> XConfig l -> XConfig l
forall (l :: * -> *). X () -> XConfig l -> XConfig l
addAfterRescreenHook ((ScreenId -> IO StatusBarConfig) -> X ()
updateSBs ScreenId -> IO StatusBarConfig
f) (XConfig l -> XConfig l) -> XConfig l -> XConfig l
forall a b. (a -> b) -> a -> b
$ XConfig l
conf
  { startupHook :: X ()
startupHook = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig l
conf X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
killAllStatusBars X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ScreenId -> IO StatusBarConfig) -> X ()
updateSBs ScreenId -> IO StatusBarConfig
f
  , logHook :: X ()
logHook     = XConfig l -> X ()
forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
logSBs
  }

-- | Like 'dynamicSBs', but applies 'docks' to the
-- resulting config and adds 'avoidStruts' to the
-- layout.
dynamicEasySBs :: LayoutClass l Window
               => (ScreenId -> IO StatusBarConfig)
               -> XConfig l
               -> XConfig (ModifiedLayout AvoidStruts l)
dynamicEasySBs :: (ScreenId -> IO StatusBarConfig)
-> XConfig l -> XConfig (ModifiedLayout AvoidStruts l)
dynamicEasySBs ScreenId -> IO StatusBarConfig
f XConfig l
conf =
  XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall (a :: * -> *). XConfig a -> XConfig a
docks (XConfig (ModifiedLayout AvoidStruts l)
 -> XConfig (ModifiedLayout AvoidStruts l))
-> (XConfig (ModifiedLayout AvoidStruts l)
    -> XConfig (ModifiedLayout AvoidStruts l))
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId -> IO StatusBarConfig)
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall (l :: * -> *).
(ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
dynamicSBs ScreenId -> IO StatusBarConfig
f (XConfig (ModifiedLayout AvoidStruts l)
 -> XConfig (ModifiedLayout AvoidStruts l))
-> XConfig (ModifiedLayout AvoidStruts l)
-> XConfig (ModifiedLayout AvoidStruts l)
forall a b. (a -> b) -> a -> b
$ XConfig l
conf { layoutHook :: ModifiedLayout AvoidStruts l KeySym
layoutHook = l KeySym -> ModifiedLayout AvoidStruts l KeySym
forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts (XConfig l -> l KeySym
forall (l :: * -> *). XConfig l -> l KeySym
layoutHook XConfig l
conf) }

-- | Given the function to create status bars, update
-- the status bars by killing those that shouldn't be
-- visible anymore and creates any missing status bars
updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()
updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()
updateSBs ScreenId -> IO StatusBarConfig
f = do
  [ScreenId]
actualScreens    <- (WindowSet -> X [ScreenId]) -> X [ScreenId]
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X [ScreenId]) -> X [ScreenId])
-> (WindowSet -> X [ScreenId]) -> X [ScreenId]
forall a b. (a -> b) -> a -> b
$ [ScreenId] -> X [ScreenId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ScreenId] -> X [ScreenId])
-> (WindowSet -> [ScreenId]) -> WindowSet -> X [ScreenId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
 -> ScreenId)
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [ScreenId]
forall a b. (a -> b) -> [a] -> [b]
map Screen String (Layout KeySym) KeySym ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen ([Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
 -> [ScreenId])
-> (WindowSet
    -> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail])
-> WindowSet
-> [ScreenId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen String (Layout KeySym) KeySym ScreenId ScreenDetail]
forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens
  ([(ScreenId, StatusBarConfig)]
toKeep, [(ScreenId, StatusBarConfig)]
toKill) <-
    ((ScreenId, StatusBarConfig) -> Bool)
-> [(ScreenId, StatusBarConfig)]
-> ([(ScreenId, StatusBarConfig)], [(ScreenId, StatusBarConfig)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ScreenId -> [ScreenId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScreenId]
actualScreens) (ScreenId -> Bool)
-> ((ScreenId, StatusBarConfig) -> ScreenId)
-> (ScreenId, StatusBarConfig)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, StatusBarConfig) -> ScreenId
forall a b. (a, b) -> a
fst) ([(ScreenId, StatusBarConfig)]
 -> ([(ScreenId, StatusBarConfig)], [(ScreenId, StatusBarConfig)]))
-> (ActiveSBs -> [(ScreenId, StatusBarConfig)])
-> ActiveSBs
-> ([(ScreenId, StatusBarConfig)], [(ScreenId, StatusBarConfig)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveSBs -> [(ScreenId, StatusBarConfig)]
getASBs (ActiveSBs
 -> ([(ScreenId, StatusBarConfig)], [(ScreenId, StatusBarConfig)]))
-> X ActiveSBs
-> X ([(ScreenId, StatusBarConfig)], [(ScreenId, StatusBarConfig)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ActiveSBs
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  -- Kill the status bars
  [StatusBarConfig] -> X ()
cleanSBs (((ScreenId, StatusBarConfig) -> StatusBarConfig)
-> [(ScreenId, StatusBarConfig)] -> [StatusBarConfig]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId, StatusBarConfig) -> StatusBarConfig
forall a b. (a, b) -> b
snd [(ScreenId, StatusBarConfig)]
toKill)
  -- Create new status bars if needed
  let missing :: [ScreenId]
missing = [ScreenId]
actualScreens [ScreenId] -> [ScreenId] -> [ScreenId]
forall a. Eq a => [a] -> [a] -> [a]
\\ ((ScreenId, StatusBarConfig) -> ScreenId)
-> [(ScreenId, StatusBarConfig)] -> [ScreenId]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId, StatusBarConfig) -> ScreenId
forall a b. (a, b) -> a
fst [(ScreenId, StatusBarConfig)]
toKeep
  [(ScreenId, StatusBarConfig)]
added <- IO [(ScreenId, StatusBarConfig)] -> X [(ScreenId, StatusBarConfig)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [(ScreenId, StatusBarConfig)]
 -> X [(ScreenId, StatusBarConfig)])
-> IO [(ScreenId, StatusBarConfig)]
-> X [(ScreenId, StatusBarConfig)]
forall a b. (a -> b) -> a -> b
$ (ScreenId -> IO (ScreenId, StatusBarConfig))
-> [ScreenId] -> IO [(ScreenId, StatusBarConfig)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ScreenId
s -> (ScreenId
s,) (StatusBarConfig -> (ScreenId, StatusBarConfig))
-> IO StatusBarConfig -> IO (ScreenId, StatusBarConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenId -> IO StatusBarConfig
f ScreenId
s) [ScreenId]
missing
  ((ScreenId, StatusBarConfig) -> X ())
-> [(ScreenId, StatusBarConfig)] -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (StatusBarConfig -> X ()
sbStartupHook (StatusBarConfig -> X ())
-> ((ScreenId, StatusBarConfig) -> StatusBarConfig)
-> (ScreenId, StatusBarConfig)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, StatusBarConfig) -> StatusBarConfig
forall a b. (a, b) -> b
snd) [(ScreenId, StatusBarConfig)]
added
  ActiveSBs -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put ([(ScreenId, StatusBarConfig)] -> ActiveSBs
ASB ([(ScreenId, StatusBarConfig)]
toKeep [(ScreenId, StatusBarConfig)]
-> [(ScreenId, StatusBarConfig)] -> [(ScreenId, StatusBarConfig)]
forall a. [a] -> [a] -> [a]
++ [(ScreenId, StatusBarConfig)]
added))

-- | Run 'sbLogHook' for the saved 'StatusBarConfig's
logSBs :: X ()
logSBs :: X ()
logSBs = X ActiveSBs
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X ActiveSBs -> (ActiveSBs -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ScreenId, StatusBarConfig) -> X ())
-> [(ScreenId, StatusBarConfig)] -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (StatusBarConfig -> X ()
sbLogHook (StatusBarConfig -> X ())
-> ((ScreenId, StatusBarConfig) -> StatusBarConfig)
-> (ScreenId, StatusBarConfig)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, StatusBarConfig) -> StatusBarConfig
forall a b. (a, b) -> b
snd) ([(ScreenId, StatusBarConfig)] -> X ())
-> (ActiveSBs -> [(ScreenId, StatusBarConfig)])
-> ActiveSBs
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveSBs -> [(ScreenId, StatusBarConfig)]
getASBs

-- | Kill the given 'StatusBarConfig's from the given
-- list
cleanSBs :: [StatusBarConfig] -> X ()
cleanSBs :: [StatusBarConfig] -> X ()
cleanSBs = (StatusBarConfig -> X ()) -> [StatusBarConfig] -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ StatusBarConfig -> X ()
sbCleanupHook

-- | The default property xmonad writes to. (@_XMONAD_LOG@).
xmonadDefProp :: String
xmonadDefProp :: String
xmonadDefProp = String
"_XMONAD_LOG"

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

-- | Write a string to a property on the root window.  This property is of type
-- @UTF8_STRING@.
xmonadPropLog' :: String  -- ^ Property name
               -> String  -- ^ Message to be written to the property
               -> X ()
xmonadPropLog' :: String -> String -> X ()
xmonadPropLog' String
prop String
msg = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    KeySym
r <- (XConf -> KeySym) -> X KeySym
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> KeySym
theRoot
    KeySym
xlog <- String -> X KeySym
getAtom String
prop
    KeySym
ustring <- String -> X KeySym
getAtom String
"UTF8_STRING"
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> KeySym -> KeySym -> CInt -> [CChar] -> IO ()
changeProperty8 Display
d KeySym
r KeySym
xlog KeySym
ustring CInt
propModeReplace (String -> [CChar]
encodeCChar String
msg)
 where
    encodeCChar :: String -> [CChar]
    encodeCChar :: String -> [CChar]
encodeCChar = (Word8 -> CChar) -> [Word8] -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> [CChar]) -> (String -> [Word8]) -> String -> [CChar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word8]
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 { StatusBarPIDs -> Map String ProcessID
getPIDs :: M.Map String ProcessID }
  deriving (Int -> StatusBarPIDs -> ShowS
[StatusBarPIDs] -> ShowS
StatusBarPIDs -> String
(Int -> StatusBarPIDs -> ShowS)
-> (StatusBarPIDs -> String)
-> ([StatusBarPIDs] -> ShowS)
-> Show StatusBarPIDs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusBarPIDs] -> ShowS
$cshowList :: [StatusBarPIDs] -> ShowS
show :: StatusBarPIDs -> String
$cshow :: StatusBarPIDs -> String
showsPrec :: Int -> StatusBarPIDs -> ShowS
$cshowsPrec :: Int -> StatusBarPIDs -> ShowS
Show, ReadPrec [StatusBarPIDs]
ReadPrec StatusBarPIDs
Int -> ReadS StatusBarPIDs
ReadS [StatusBarPIDs]
(Int -> ReadS StatusBarPIDs)
-> ReadS [StatusBarPIDs]
-> ReadPrec StatusBarPIDs
-> ReadPrec [StatusBarPIDs]
-> Read StatusBarPIDs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StatusBarPIDs]
$creadListPrec :: ReadPrec [StatusBarPIDs]
readPrec :: ReadPrec StatusBarPIDs
$creadPrec :: ReadPrec StatusBarPIDs
readList :: ReadS [StatusBarPIDs]
$creadList :: ReadS [StatusBarPIDs]
readsPrec :: Int -> ReadS StatusBarPIDs
$creadsPrec :: Int -> ReadS StatusBarPIDs
Read)

instance ExtensionClass StatusBarPIDs where
  initialValue :: StatusBarPIDs
initialValue = Map String ProcessID -> StatusBarPIDs
StatusBarPIDs Map String ProcessID
forall a. Monoid a => a
mempty
  extensionType :: StatusBarPIDs -> StateExtension
extensionType = StatusBarPIDs -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Kills the status bar started with 'spawnStatusBar' using the given command
-- and resets the state. This could go for example at the beginning of the
-- startupHook, to kill the status bars that need to be restarted.
--
-- 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  'spawnStatusBar'.
--
-- 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.
killStatusBar :: String -- ^ The command used to start the status bar
                 -> X ()
killStatusBar :: String -> X ()
killStatusBar String
cmd = do
    (StatusBarPIDs -> Maybe ProcessID) -> X (Maybe ProcessID)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (String -> Map String ProcessID -> Maybe ProcessID
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
cmd (Map String ProcessID -> Maybe ProcessID)
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> Maybe ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBarPIDs -> Map String ProcessID
getPIDs) X (Maybe ProcessID) -> (Maybe ProcessID -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe ProcessID -> (ProcessID -> X ()) -> X ())
-> (ProcessID -> X ()) -> Maybe ProcessID -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe ProcessID -> (ProcessID -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (ProcessID -> IO ()) -> ProcessID -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> IO ()
killPid)
    (StatusBarPIDs -> StatusBarPIDs) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Map String ProcessID -> StatusBarPIDs
StatusBarPIDs (Map String ProcessID -> StatusBarPIDs)
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> StatusBarPIDs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String ProcessID -> Map String ProcessID
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
cmd (Map String ProcessID -> Map String ProcessID)
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> Map String ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBarPIDs -> Map String ProcessID
getPIDs)

killPid :: ProcessID -> IO ()
killPid :: ProcessID -> IO ()
killPid ProcessID
pidToKill = IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> IO (Either SomeException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (CInt -> ProcessID -> IO ()
signalProcessGroup CInt
sigTERM ProcessID
pidToKill)

-- | Spawns a status bar and saves its PID together with the commands that was
-- used to start it. This is useful when the status bars should be restarted
-- with xmonad. Use this in combination with 'killStatusBar'.
--
-- 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.
spawnStatusBar :: String -- ^ The command used to spawn the status bar
               -> X ()
spawnStatusBar :: String -> X ()
spawnStatusBar String
cmd = do
  ProcessID
newPid <- String -> X ProcessID
forall (m :: * -> *). MonadIO m => String -> m ProcessID
spawnPID String
cmd
  (StatusBarPIDs -> StatusBarPIDs) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Map String ProcessID -> StatusBarPIDs
StatusBarPIDs (Map String ProcessID -> StatusBarPIDs)
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> StatusBarPIDs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ProcessID -> Map String ProcessID -> Map String ProcessID
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
cmd ProcessID
newPid (Map String ProcessID -> Map String ProcessID)
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> Map String ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBarPIDs -> Map String ProcessID
getPIDs)

-- | Kill all status bars started with 'spawnStatusBar'. Note the
-- caveats in 'cleanupStatusBar'
killAllStatusBars :: X ()
killAllStatusBars :: X ()
killAllStatusBars =
  (StatusBarPIDs -> [ProcessID]) -> X [ProcessID]
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets (Map String ProcessID -> [ProcessID]
forall k a. Map k a -> [a]
M.elems (Map String ProcessID -> [ProcessID])
-> (StatusBarPIDs -> Map String ProcessID)
-> StatusBarPIDs
-> [ProcessID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBarPIDs -> Map String ProcessID
getPIDs) X [ProcessID] -> ([ProcessID] -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> ([ProcessID] -> IO ()) -> [ProcessID] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessID -> IO ()) -> [ProcessID] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ProcessID -> IO ()
killPid X () -> X () -> X ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusBarPIDs -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Map String ProcessID -> StatusBarPIDs
StatusBarPIDs Map String ProcessID
forall a. Monoid a => a
mempty)