diff options
Diffstat (limited to 'XMonad/Util')
| -rw-r--r-- | XMonad/Util/Loggers.hs | 265 |
1 files changed, 238 insertions, 27 deletions
diff --git a/XMonad/Util/Loggers.hs b/XMonad/Util/Loggers.hs index 4c879a7..f8aef65 100644 --- a/XMonad/Util/Loggers.hs +++ b/XMonad/Util/Loggers.hs @@ -1,61 +1,123 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Loggers --- Copyright : (c) Brent Yorgey +-- 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 which can be used in the --- 'XMonad.Hooks.DynamicLog.ppExtras' field of a pretty-printing status --- logger format. See "XMonad.Hooks.DynamicLog" for more information. +-- A collection of simple logger functions and formatting utilities +-- which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of +-- a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog" +-- for more information. ----------------------------------------------------------------------------- module XMonad.Util.Loggers ( - -- * Usage - -- $usage + -- * Usage + -- $usage - Logger + Logger - , date - , loadAvg - , battery - , logCmd + -- * System Loggers + -- $system + , aumixVolume + , battery + , date + , loadAvg + , maildirNew, maildirUnread + , logCmd , logFileCount - ) where + -- * XMonad Loggers + -- $xmonad + , logCurrent, logLayout, logTitle + -- * Formatting Utilities + -- $format + , onLogger + , wrapL, fixedWidthL + , logSp, padL + , shortenL + , dzenColorL, xmobarColorL + + , (<$>) + + ) where + +import XMonad (liftIO) import XMonad.Core +import qualified XMonad.StackSet as W +import XMonad.Hooks.DynamicLog +import XMonad.Util.Font (Align (..)) +import XMonad.Util.NamedWindows (getName) -import System.Time +import Control.Applicative ((<$>)) +import Data.List (isPrefixOf, isSuffixOf) +import Data.Maybe (fromMaybe) +import Data.Traversable (traverse) +import System.Directory (getDirectoryContents) import System.IO -import System.Process (runInteractiveCommand) import System.Locale +import System.Process (runInteractiveCommand) +import System.Time -- $usage --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@: +-- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Util.Loggers -- -- Then, add one or more loggers to the -- 'XMonad.Hooks.DynamicLog.ppExtras' field of your --- 'XMonad.Hooks.DynamicLoc.PP' format. For example: +-- 'XMonad.Hooks.DynamicLoc.PP', possibly with extra formatting . +-- For example: +-- +-- > -- display load averages and a pithy quote along with xmonad status. +-- > , logHook = dynamicLogWithPP $ defaultPP { +-- > ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ] +-- > } +-- > -- gives something like " 3.27 3.52 3.26 Drive defensively. Buy a tank." -- --- > -- display load averages and a pithy quote along with xmonad status. --- > , logHook = dynamicLogWithPP $ defaultPP { ppExtras = [ loadAvg, logCmd "fortune -n 40 -s" ] } +-- See the formatting section below for another example using +-- a @where@ block to define some formatted loggers for a top-level +-- @myLogHook@. +-- +-- 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.DynamicLog.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.DynamicLog.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 +-- \"loggers\": they are just @X (Maybe String)@ actions. So you can -- use them anywhere you would use an @X (Maybe String)@, not just -- with DynamicLog. -- -- 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 = logCmd "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 @\/usr\/bin\/acpi@ and @sed@ are installed.) +battery :: Logger +battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" + -- | 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, @@ -73,15 +135,164 @@ date fmt = io $ do cal <- (getClockTime >>= toCalendarTime) loadAvg :: Logger loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'" --- | 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. -battery :: Logger -battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" - -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c fmap Just (hGetLine out) `catch` (const $ return 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 d p = do + c <- liftIO ( getDirectoryContents d) + let n = length $ Prelude.filter p c + case n of + 0 -> return Nothing + _ -> return $ Just $ show 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 mdir = logFileCount (mdir ++ "/cur/") (isSuffixOf ",") + +-- | Get a count of new mails in a maildir. +maildirNew :: FilePath -> Logger +maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".") + +-- $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.... + +-- | Get the title (name) of the focused window. +logTitle :: Logger +logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek + +-- | Get the name of the current layout. +logLayout :: Logger +logLayout = withWindowSet $ return . Just . ld + where ld = description . W.layout . W.workspace . W.current + +-- | Get the name of the current workspace. +logCurrent :: Logger +logCurrent = withWindowSet $ return . Just . W.currentTag + +-- $format +-- Combine logger formatting functions to make your +-- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable. +-- (For convenience this module exports 'Control.Applicative.<$>' to +-- use instead of \'.\' or \'$\' in hard to read formatting lines. +-- For example: +-- +-- > myLogHook = dynamicLogWithPP defaultPP { +-- > -- 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)" +-- +-- 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 = fmap . 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 l r = onLogger $ wrap l 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 a str n logger = do + mbl <- logger + let l = fromMaybe "" mbl + case a of + AlignCenter -> toL (take n $ padhalf l ++ l ++ cs) + AlignRight -> toL (reverse (take n $ reverse l ++ cs)) + AlignLeft -> toL (take n $ l ++ cs) + where + toL = return . Just + cs = cycle str + padhalf x = reverse $ take ((n - length x) `div` 2) cs + +-- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \' \'@. +-- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@. +logSp :: Int -> Logger +logSp n = return . Just . take n $ cycle " " + +-- | Pad a logger's output with a leading and trailing space, unless it +-- is @X (Nothing)@ or @X (Just \"\")@. +padL :: Logger -> Logger +padL = onLogger pad + +-- | Limit a logger's length, adding \"...\" if truncated. +shortenL :: Int -> Logger -> Logger +shortenL = onLogger . shorten + +-- | Color a logger's output with dzen foreground and background colors. +-- +-- > dzenColorL "green" "#2A4C3F" battery +dzenColorL :: String -> String -> Logger -> Logger +dzenColorL fg bg = onLogger $ dzenColor fg bg + +-- | Color a logger's output with xmobar foreground and background colors. +-- +-- > xmobarColorL "#6A5ACD" "gray6" loadAverage +xmobarColorL :: String -> String -> Logger -> Logger +xmobarColorL fg bg = onLogger $ xmobarColor fg 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? |