{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Loggers
-- Description :  A collection of simple logger functions and formatting utilities.
-- Copyright   :  (c) Brent Yorgey, Wirt Wolff
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <byorgey@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A collection of simple logger functions and formatting utilities
-- which can be used in the 'XMonad.Hooks.StatusBar.PP.ppExtras' field of
-- a pretty-printing status logger format. See "XMonad.Hooks.StatusBar.PP"
-- for more information.
-----------------------------------------------------------------------------

module XMonad.Util.Loggers (
    -- * Usage
    -- $usage

      Logger

    -- * System Loggers
    -- $system
    , aumixVolume
    , battery
    , date
    , loadAvg
    , maildirNew, maildirUnread
    , logCmd , logFileCount

    -- * XMonad Loggers
    -- $xmonad
    , logCurrent, logLayout
    , logTitle, logTitles, logTitles'
    , logClassname, logClassnames, logClassnames'
    , logConst, logDefault, (.|)
    -- * XMonad: Screen-specific Loggers
    -- $xmonad-screen
    , logCurrentOnScreen, logLayoutOnScreen
    , logTitleOnScreen, logClassnameOnScreen, logWhenActive
    , logTitlesOnScreen, logTitlesOnScreen'
    , logClassnamesOnScreen, logClassnamesOnScreen'
    , TitlesFormat(..)
    , ClassnamesFormat(..)
    -- * Formatting Utilities
    -- $format
    , onLogger
    , wrapL, fixedWidthL
    , logSp, padL
    , shortenL
    , dzenColorL, xmobarColorL

  ) where

import XMonad (Default, gets, liftIO, Window)
import XMonad.Core
import qualified XMonad.StackSet as W
import XMonad.Hooks.StatusBar.PP
import XMonad.Hooks.UrgencyHook (readUrgents)
import XMonad.Util.Font (Align (..))
import XMonad.Util.NamedWindows (getName, getNameWMClass)

import Control.Exception as E
import XMonad.Prelude (find, fromMaybe, isPrefixOf, isSuffixOf, WindowScreen)
import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
import System.Directory (getDirectoryContents)
import System.IO (hGetLine)
import System.Process (runInteractiveCommand)

econst :: Monad m => a -> IOException -> m a
econst :: forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- $usage
-- Use this module by importing it into your @xmonad.hs@:
--
-- > import XMonad.Util.Loggers
--
-- Then, add one or more loggers to the
-- 'XMonad.Hooks.StatusBar.PP.ppExtras' field of your
-- "XMonad.Hooks.StatusBar.PP", possibly with extra formatting .
-- For example:
--
-- > myPP = def {
-- >            ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ]
-- >         }
-- >   -- gives something like " 3.27 3.52 3.26 Drive defensively.  Buy a tank."
--
-- See the formatting section below for another example using
-- a @where@ block to define some formatted loggers for a top-level
-- @myPP@.
--
-- Loggers are named either for their function, as in 'battery',
-- 'aumixVolume', and 'maildirNew', or are prefixed with \"log\" when
-- making use of other functions or by analogy with the pp* functions.
-- For example, the logger version of 'XMonad.Hooks.StatusBar.PP.ppTitle'
-- is 'logTitle', and 'logFileCount' loggerizes the result of file
-- counting code.
--
-- Formatting utility names are generally as short as possible and
-- carry the suffix \"L\". For example, the logger version of
-- 'XMonad.Hooks.StatusBar.PP.shorten' is 'shortenL'.
--
-- Of course, there is nothing really special about these so-called
-- \"loggers\": they are just @X (Maybe String)@ actions.  So you can
-- use them anywhere you would use an @X (Maybe String)@, not just
-- with PP.
--
-- Additional loggers welcome!



-- | 'Logger' is just a convenient synonym for @X (Maybe String)@.
type Logger = X (Maybe String)

-- $system

-- | Get the current volume with @aumix@. <http://jpj.net/~trevor/aumix.html>
aumixVolume :: Logger
aumixVolume :: Logger
aumixVolume = String -> Logger
logCmd String
"aumix -vq"

-- | Get the battery status (percent charge and charging\/discharging
--   status). This is an ugly hack and may not work for some people.
--   At some point it would be nice to make this more general\/have
--   fewer dependencies (assumes @acpi@ and @sed@ are installed.)
battery :: Logger
battery :: Logger
battery = String -> Logger
logCmd String
"acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'"

-- | Get the current date and time, and format them via the
--   given format string.  The format used is the same as that used
--   by the C library function strftime; for example,
--   @date \"%a %b %d\"@ might display something like @Tue Feb 19@.
--   For more information see something like
--   <http://www.cplusplus.com/reference/clibrary/ctime/strftime.html>.
date :: String -> Logger
date :: String -> Logger
date String
fmt = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

-- | Get the load average.  This assumes that you have a
--   utility called @uptime@ and that you have @sed@
--   installed; these are fairly common on GNU\/Linux systems but it
--   would be nice to make this more general.
loadAvg :: Logger
loadAvg :: Logger
loadAvg = String -> Logger
logCmd String
"uptime | sed 's/.*: //; s/,//g'"

-- | Create a 'Logger' from an arbitrary shell command.
logCmd :: String -> Logger
logCmd :: String -> Logger
logCmd String
c = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do (Handle
_, Handle
out, Handle
_, ProcessHandle
_) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
c
                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (Handle -> IO String
hGetLine Handle
out) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst forall a. Maybe a
Nothing
                   -- no need to waitForProcess, we ignore SIGCHLD

-- | Get a count of filtered files in a directory.
-- See 'maildirUnread' and 'maildirNew' source for usage examples.
logFileCount :: FilePath          -- ^ directory in which to count files
             -> (String -> Bool)  -- ^ predicate to match if file should be counted
             -> Logger
logFileCount :: String -> (String -> Bool) -> Logger
logFileCount String
d String -> Bool
p = do
    [String]
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ( String -> IO [String]
getDirectoryContents String
d)
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter String -> Bool
p [String]
c
    case Int
n of
        Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
n

-- | Get a count of unread mails in a maildir. For maildir format
-- details, to write loggers for other classes of mail, see
-- <http://cr.yp.to/proto/maildir.html> and 'logFileCount'.
maildirUnread :: FilePath -> Logger
maildirUnread :: String -> Logger
maildirUnread String
mdir = String -> (String -> Bool) -> Logger
logFileCount (String
mdir forall a. [a] -> [a] -> [a]
++ String
"/cur/") (forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
",")

-- | Get a count of new mails in a maildir.
maildirNew :: FilePath -> Logger
maildirNew :: String -> Logger
maildirNew String
mdir = String -> (String -> Bool) -> Logger
logFileCount (String
mdir forall a. [a] -> [a] -> [a]
++ String
"/new/") (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
".")

-- $xmonad
--
-- A very small sample of what you can log since you have access to X. For
-- example you can loggerize the number of windows on each workspace, or
-- titles on other workspaces, or the id of the previously focused workspace....

-- | Internal function to get a wrapped title string from a window
fetchWindowTitle :: Window -> X String
fetchWindowTitle :: Window -> X String
fetchWindowTitle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X NamedWindow
getName

-- | Get the title (name) of the focused window.
logTitle :: Logger
logTitle :: Logger
logTitle = (Window -> X String) -> Logger
logWindowInfoFocusedWindow Window -> X String
fetchWindowTitle

-- | Get the titles of all windows on the visible workspace of the given
-- screen and format them according to the given functions.
--
-- ==== __Example__
--
-- > myXmobarPP :: X PP
-- > myXmobarPP = pure $ def
-- >   { ppOrder  = [ws, l, _, wins] -> [ws, l, wins]
-- >   , ppExtras = [logTitles formatFocused formatUnfocused]
-- >   }
-- >  where
-- >   formatFocused   = wrap "[" "]" . xmobarColor "#ff79c6" "" . shorten 50 . xmobarStrip
-- >   formatUnfocused = wrap "(" ")" . xmobarColor "#bd93f9" "" . shorten 30 . xmobarStrip
--
logTitlesOnScreen
  :: ScreenId           -- ^ Screen to log the titles on
  -> (String -> String) -- ^ Formatting for the focused   window
  -> (String -> String) -- ^ Formatting for the unfocused window
  -> Logger
logTitlesOnScreen :: ScreenId -> (String -> String) -> (String -> String) -> Logger
logTitlesOnScreen ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc =
  (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
fetchWindowTitle ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUnfoc

-- | Like 'logTitlesOnScreen' but with support for urgent windows.  To
-- be used with "XMonad.Hooks.UrgencyHook".
logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger
logTitlesOnScreen' :: ScreenId -> TitlesFormat -> Logger
logTitlesOnScreen' ScreenId
sid (TitlesFormat String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg) =
  (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
fetchWindowTitle ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg

-- | Like 'logTitlesOnScreen', but directly use the "focused" screen
-- (the one with the currently focused workspace).
logTitles :: (String -> String) -> (String -> String) -> Logger
logTitles :: (String -> String) -> (String -> String) -> Logger
logTitles String -> String
formatFoc String -> String
formatUnfoc =
  (Window -> X String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoFocusedScreen Window -> X String
fetchWindowTitle String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUnfoc

-- | Variant of 'logTitles', but with support for urgent windows.
logTitles' :: TitlesFormat -> Logger
logTitles' :: TitlesFormat -> Logger
logTitles' (TitlesFormat String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg) =
  (Window -> X String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoFocusedScreen Window -> X String
fetchWindowTitle String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg

-- | Formatting applied to the titles of certain windows.
data TitlesFormat = TitlesFormat
  { TitlesFormat -> String -> String
focusedFormat   :: String -> String  -- ^ Focused formatting.
  , TitlesFormat -> String -> String
unfocusedFormat :: String -> String  -- ^ Unfocused formatting.
  , TitlesFormat -> String -> String
urgentFormat    :: String -> String  -- ^ Formatting when urgent.
  }

-- | How to format these titles by default when using 'logTitles'' and
-- 'logTitlesOnScreen''.
instance Default TitlesFormat where
  def :: TitlesFormat
def = TitlesFormat
    { focusedFormat :: String -> String
focusedFormat   = String -> String
xmobarFocusedFormat
    , unfocusedFormat :: String -> String
unfocusedFormat = String -> String
xmobarWsFormat
    , urgentFormat :: String -> String
urgentFormat    = String -> String
xmobarUrgentFormat
    }

-- | Internal function to get a wrapped classname string from a window
fetchWindowClassname :: Window -> X String
fetchWindowClassname :: Window -> X String
fetchWindowClassname = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X NamedWindow
getNameWMClass

-- | Get the classname of the focused window.
logClassname :: Logger
logClassname :: Logger
logClassname = (Window -> X String) -> Logger
logWindowInfoFocusedWindow Window -> X String
fetchWindowClassname

-- | Get the classnames of all windows on the visible workspace of the given
-- screen and format them according to the given functions.
logClassnamesOnScreen
  :: ScreenId           -- ^ Screen to log the classnames on
  -> (String -> String) -- ^ Formatting for the focused window
  -> (String -> String) -- ^ Formatting for the unfocused window
  -> Logger
logClassnamesOnScreen :: ScreenId -> (String -> String) -> (String -> String) -> Logger
logClassnamesOnScreen ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc =
  (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
fetchWindowClassname ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUnfoc

-- | Like 'logClassnamesOnScreen' but with support for urgent windows.  To
-- be used with "XMonad.Hooks.UrgencyHook".
logClassnamesOnScreen' :: ScreenId -> ClassnamesFormat -> Logger
logClassnamesOnScreen' :: ScreenId -> ClassnamesFormat -> Logger
logClassnamesOnScreen' ScreenId
sid (ClassnamesFormat String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg) =
  (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
fetchWindowClassname ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg

-- | Like 'logClassnamesOnScreen', but directly use the "focused" screen
-- (the one with the currently focused workspace).
logClassnames :: (String -> String) -> (String -> String) -> Logger
logClassnames :: (String -> String) -> (String -> String) -> Logger
logClassnames String -> String
formatFoc String -> String
formatUnfoc =
  (Window -> X String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoFocusedScreen Window -> X String
fetchWindowClassname String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUnfoc

-- | Variant of 'logClassnames', but with support for urgent windows.
logClassnames' :: ClassnamesFormat -> Logger
logClassnames' :: ClassnamesFormat -> Logger
logClassnames' (ClassnamesFormat String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg) =
  (Window -> X String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoFocusedScreen Window -> X String
fetchWindowClassname String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg

-- | Formatting applied to the classnames of certain windows.
data ClassnamesFormat = ClassnamesFormat
  { ClassnamesFormat -> String -> String
focusedFormatClassname   :: String -> String  -- ^ Focused formatting.
  , ClassnamesFormat -> String -> String
unfocusedFormatClassname :: String -> String  -- ^ Unfocused formatting.
  , ClassnamesFormat -> String -> String
urgentFormatClassname    :: String -> String  -- ^ Formatting when urgent.
  }

-- | How to format these classnames by default when using 'logClassnames'' and
-- 'logClassnamesOnScreen''.
instance Default ClassnamesFormat where
  def :: ClassnamesFormat
def = ClassnamesFormat
    { focusedFormatClassname :: String -> String
focusedFormatClassname   = String -> String
xmobarFocusedFormat
    , unfocusedFormatClassname :: String -> String
unfocusedFormatClassname = String -> String
xmobarWsFormat
    , urgentFormatClassname :: String -> String
urgentFormatClassname    = String -> String
xmobarUrgentFormat
    }

-- | Internal function to get the specified window information for all windows on
-- the visible workspace of the given screen and format them according to the
-- given functions.
logWindowInfoOnScreen
  :: (Window -> X String)
  -> ScreenId
  -> (String -> String)
  -> (String -> String)
  -> (String -> String)
  -> Logger
logWindowInfoOnScreen :: (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
getWindowInfo ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg =
  ((WindowScreen -> Logger) -> ScreenId -> Logger
`withScreen` ScreenId
sid) forall a b. (a -> b) -> a -> b
$ \WindowScreen
screen -> do
    let focWin :: Maybe Window
focWin = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ WindowScreen
screen
    [Window]
urgWins <- X [Window]
readUrgents
    (Window -> X String)
-> WindowScreen -> (Window -> String -> String) -> Logger
logWindowInfoOnScreenWorker Window -> X String
getWindowInfo WindowScreen
screen forall a b. (a -> b) -> a -> b
$ \Window
win String
name ->
      if | forall a. a -> Maybe a
Just Window
win forall a. Eq a => a -> a -> Bool
== Maybe Window
focWin -> String -> String
formatFoc   String
name
         | Window
win forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
urgWins -> String -> String
formatUrg   String
name
         | Bool
otherwise          -> String -> String
formatUnfoc String
name

-- | Internal helper function for 'logWindowInfoOnScreen'.
logWindowInfoOnScreenWorker
  :: (Window -> X String)
  -> WindowScreen
  -> (Window -> String -> String)
  -> Logger
logWindowInfoOnScreenWorker :: (Window -> X String)
-> WindowScreen -> (Window -> String -> String) -> Logger
logWindowInfoOnScreenWorker Window -> X String
getWindowInfo WindowScreen
screen Window -> String -> String
logger = do
  let wins :: [Window]
wins = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. Stack a -> [a]
W.integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ WindowScreen
screen
  [String]
winNames <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Window -> X String
getWindowInfo [Window]
wins
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Window -> String -> String
logger [Window]
wins [String]
winNames

-- | Internal. Like 'logWindowInfoOnScreen', but directly use the "focused" screen
-- (the one with the currently focused workspace).
logWindowInfoFocusedScreen
  :: (Window -> X String)
  -> (String -> String)
  -> (String -> String)
  -> (String -> String)
  -> Logger
logWindowInfoFocusedScreen :: (Window -> X String)
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoFocusedScreen Window -> X String
getWindowInfo String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg = do
  ScreenId
sid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  (Window -> X String)
-> ScreenId
-> (String -> String)
-> (String -> String)
-> (String -> String)
-> Logger
logWindowInfoOnScreen Window -> X String
getWindowInfo ScreenId
sid String -> String
formatFoc String -> String
formatUnfoc String -> String
formatUrg

-- | Internal function to get the specified information for the currently focused window
logWindowInfoFocusedWindow :: (Window -> X String) -> Logger
logWindowInfoFocusedWindow :: (Window -> X String) -> Logger
logWindowInfoFocusedWindow Window -> X String
getWindowInfo = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Window -> X String
getWindowInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek

-- | Internal formatting helpers
xmobarWsFormat, xmobarFocusedFormat, xmobarUrgentFormat :: String -> String
xmobarWsFormat :: String -> String
xmobarWsFormat      = String -> String
xmobarRaw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten Int
30 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
xmobarStrip
xmobarFocusedFormat :: String -> String
xmobarFocusedFormat = String -> String -> String -> String
wrap String
"[" String
"]" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
xmobarWsFormat
xmobarUrgentFormat :: String -> String
xmobarUrgentFormat  = String -> String -> String -> String
wrap String
"!" String
"!" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
xmobarWsFormat

-- | Get the name of the current layout.
logLayout :: Logger
logLayout :: Logger
logLayout = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {i} {a} {sid} {sd}.
StackSet i (Layout Window) a sid sd -> String
ld
  where ld :: StackSet i (Layout Window) a sid sd -> String
ld = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current

-- | Get the name of the current workspace.
logCurrent :: Logger
logCurrent :: Logger
logCurrent = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag

-- | Log the given string, as is.
logConst :: String -> Logger
logConst :: String -> Logger
logConst = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

-- | If the first logger returns @Nothing@, the default logger is used.
-- For example, to display a quote when no windows are on the screen,
-- you can do:
--
-- > logDefault logTitle (logConst "Hey, you, you're finally awake.")
logDefault :: Logger -> Logger -> Logger
logDefault :: Logger -> Logger -> Logger
logDefault Logger
l Logger
d = Logger
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Logger
d String -> Logger
logConst

-- | An infix operator for 'logDefault', which can be more convenient to
-- combine multiple loggers.
--
-- > logTitle .| logWhenActive 0 (logConst "*") .| logConst "There's nothing here"
(.|) :: Logger -> Logger -> Logger
.| :: Logger -> Logger -> Logger
(.|) = Logger -> Logger -> Logger
logDefault

-- $xmonad-screen
-- It is also possible to bind loggers like 'logTitle' to a specific screen. For
-- example, using @logTitleOnScreen 1@ will log the title of the focused window
-- on screen 1, even if screen 1 is not currently active.

-- | Only display the 'Logger' if the screen with the given 'ScreenId' is
-- active.
-- For example, this can be used to create a marker that is only displayed
-- when the primary screen is active.
--
-- > logWhenActive 0 (logConst "*")
logWhenActive :: ScreenId -> Logger -> Logger
logWhenActive :: ScreenId -> Logger -> Logger
logWhenActive ScreenId
n Logger
l = do
  ScreenId
c <- forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current
  if ScreenId
n forall a. Eq a => a -> a -> Bool
== ScreenId
c then Logger
l else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Get the title (name) of the focused window, on the given screen.
logTitleOnScreen :: ScreenId -> Logger
logTitleOnScreen :: ScreenId -> Logger
logTitleOnScreen = (Window -> X String) -> ScreenId -> Logger
logWindowInfoFocusedWindowOnScreen Window -> X String
fetchWindowTitle

-- | Get the classname of the focused window, on the given screen.
logClassnameOnScreen :: ScreenId -> Logger
logClassnameOnScreen :: ScreenId -> Logger
logClassnameOnScreen = (Window -> X String) -> ScreenId -> Logger
logWindowInfoFocusedWindowOnScreen Window -> X String
fetchWindowClassname

-- | Internal function to get the specified information for the focused window,
-- on the given screen.
logWindowInfoFocusedWindowOnScreen :: (Window -> X String) -> ScreenId -> Logger
logWindowInfoFocusedWindowOnScreen :: (Window -> X String) -> ScreenId -> Logger
logWindowInfoFocusedWindowOnScreen Window -> X String
getWindowInfo =
  (WindowScreen -> Logger) -> ScreenId -> Logger
withScreen
    forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Window -> X String
getWindowInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Stack a -> a
W.focus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace

-- | Get the name of the visible workspace on the given screen.
logCurrentOnScreen :: ScreenId -> Logger
logCurrentOnScreen :: ScreenId -> Logger
logCurrentOnScreen = (WindowScreen -> Logger) -> ScreenId -> Logger
withScreen forall a b. (a -> b) -> a -> b
$ String -> Logger
logConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace

-- | Get the name of the current layout on the given screen.
logLayoutOnScreen :: ScreenId -> Logger
logLayoutOnScreen :: ScreenId -> Logger
logLayoutOnScreen =
  (WindowScreen -> Logger) -> ScreenId -> Logger
withScreen forall a b. (a -> b) -> a -> b
$ String -> Logger
logConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace

-- | A helper function to create screen-specific loggers.
withScreen :: (WindowScreen -> Logger) -> ScreenId -> Logger
withScreen :: (WindowScreen -> Logger) -> ScreenId -> Logger
withScreen WindowScreen -> Logger
f ScreenId
n = do
  [WindowScreen]
ss <- forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== ScreenId
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) [WindowScreen]
ss of
    Just WindowScreen
s  -> WindowScreen -> Logger
f WindowScreen
s
    Maybe WindowScreen
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

-- $format
-- Combine logger formatting functions to make your
-- 'XMonad.Hooks.StatusBar.PP.ppExtras' more colorful and readable.
-- (For convenience, you can use '<$>' instead of \'.\' or \'$\' in hard to read
-- formatting lines.
-- For example:
--
-- > myPP = def {
-- >     -- skipped
-- >     , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"]
-- >     , ppOrder = \(ws:l:_:xs) -> [l,ws] ++ xs
-- >     }
-- >   where
-- >     -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle
-- >     -- or something like:
-- >     lTitle = fixedWidthL AlignCenter "." 99 <$> dzenColorL "cornsilk3" "" <$> padL . shortenL 80 $ logTitle
-- >
-- >     lLoad = dzenColorL "#6A5ACD" "" . wrapL loadIcon "   " . padL $ loadAvg
-- >     loadIcon = " ^i(/home/me/.dzen/icons/load.xbm)"
--
-- For more information on how to add the pretty-printer to your status bar, please
-- check "XMonad.Hooks.StatusBar".
--
-- Note: When applying 'shortenL' or 'fixedWidthL' to logger strings
-- containing colors or other formatting commands, apply the formatting
-- /after/ the length adjustment, or include \"invisible\" characters
-- in the length specification, e.g. in the above \'^fg(cornsilk3)\' and
-- \'^fg()' yields 19 invisible and 80 visible characters.

-- | Use a string formatting function to edit a 'Logger' string.
-- For example, to create a tag function to prefix or label loggers,
-- as in \'tag: output\', use:
--
-- > tagL l = onLogger $ wrap (l ++ ": ") ""
-- >
-- >    tagL "bat" battery
-- >    tagL "load" loadAvg
--
-- If you already have a (String -> String) function you want to
-- apply to a logger:
--
-- > revL = onLogger trim
--
-- See formatting utility source code for more 'onLogger' usage examples.
onLogger :: (String -> String) -> Logger -> Logger
onLogger :: (String -> String) -> Logger -> Logger
onLogger = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | Wrap a logger's output in delimiters, unless it is @X (Nothing)@
-- or @X (Just \"\")@. Some examples:
--
-- >    wrapL " | " " | " (date "%a %d %b") -- ' | Tue 19 Feb | '
-- >
-- >    wrapL "bat: " "" battery            -- ' bat: battery_logger_output'
wrapL :: String -> String -> Logger -> Logger
wrapL :: String -> String -> Logger -> Logger
wrapL String
l String
r = (String -> String) -> Logger -> Logger
onLogger forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
wrap String
l String
r

-- | Make a logger's output constant width by padding with the given string,
-- /even if the logger is/ @X (Nothing)@ /or/ @X (Just \"\")@. Useful to
-- reduce visual noise as a title logger shrinks and grows, to use a fixed
-- width for a logger that sometimes becomes Nothing, or even to create
-- fancy spacers or character based art effects.
--
-- It fills missing logger output with a repeated character like \".\",
-- \":\" or pattern, like \" -.-\". The cycling padding string is reversed on
-- the left of the logger output. This is mainly useful with AlignCenter.
fixedWidthL :: Align  -- ^ AlignCenter, AlignRight, or AlignLeft
            -> String -- ^ String to cycle to pad missing logger output
            -> Int    -- ^ Fixed length to output (including invisible formatting characters)
            -> Logger -> Logger
fixedWidthL :: Align -> String -> Int -> Logger -> Logger
fixedWidthL Align
a String
str Int
n Logger
logger = do
    Maybe String
mbl <- Logger
logger
    let l :: String
l = forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mbl
    case Align
a of
       Align
AlignCenter -> forall {a}. a -> X (Maybe a)
toL (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {a}. Foldable t => t a -> String
padhalf String
l forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ String
cs)
       Align
AlignRight -> forall {a}. a -> X (Maybe a)
toL (forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
l forall a. [a] -> [a] -> [a]
++ String
cs))
       Align
_ -> forall {a}. a -> X (Maybe a)
toL (forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ String
l forall a. [a] -> [a] -> [a]
++ String
cs)
  where
    toL :: a -> X (Maybe a)
toL = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
    cs :: String
cs  = forall a. [a] -> [a]
cycle String
str
    padhalf :: t a -> String
padhalf t a
x = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take ((Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x) forall a. Integral a => a -> a -> a
`div` Int
2) String
cs

-- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \'   \'@.
-- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@.
logSp :: Int -> Logger
logSp :: Int -> Logger
logSp Int
n = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle String
" "

-- | Pad a logger's output with a leading and trailing space, unless it
-- is @X (Nothing)@ or @X (Just \"\")@.
padL :: Logger -> Logger
padL :: Logger -> Logger
padL = (String -> String) -> Logger -> Logger
onLogger String -> String
pad

-- | Limit a logger's length, adding \"...\" if truncated.
shortenL :: Int -> Logger -> Logger
shortenL :: Int -> Logger -> Logger
shortenL = (String -> String) -> Logger -> Logger
onLogger forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten

-- | Color a logger's output with dzen foreground and background colors.
--
-- >  dzenColorL "green" "#2A4C3F" battery
dzenColorL :: String -> String -> Logger -> Logger
dzenColorL :: String -> String -> Logger -> Logger
dzenColorL String
fg String
bg = (String -> String) -> Logger -> Logger
onLogger forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
dzenColor String
fg String
bg

-- | Color a logger's output with xmobar foreground and background colors.
--
-- >  xmobarColorL "#6A5ACD" "gray6" loadAverage
xmobarColorL :: String -> String -> Logger -> Logger
xmobarColorL :: String -> String -> Logger -> Logger
xmobarColorL String
fg String
bg = (String -> String) -> Logger -> Logger
onLogger forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
xmobarColor String
fg String
bg

-- todo
-- * dynamicLogXinerama logger? Or sorted onscreen Id's with "current" indicator?
-- is logCurrent really useful at all?
--
-- * ppVisible, etc. Resolve code dup. somehow. Refactor DynamicLog so can
-- be used for regular PP stuff /and/ loggers?
--
-- * fns for "ppExtras as a whole", combine loggers more nicely.
--
-- * parsers  to use with fixedWidthL to be smarter about invisible characters?