diff options
| author | Josh Rahm <rahm@google.com> | 2022-11-21 12:05:03 -0700 |
|---|---|---|
| committer | Josh Rahm <rahm@google.com> | 2022-11-21 12:05:03 -0700 |
| commit | ee9be16599f20aef6d1d3fd15666c00452f85aba (patch) | |
| tree | 1aed66c1de2ce201463e3becc2d452d4a8aa2992 /src/Rahm/Desktop/XMobarLog.hs | |
| parent | a1636c65e05d02f7d4fc408137e1d37b412ce890 (diff) | |
| download | rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.gz rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.tar.bz2 rde-ee9be16599f20aef6d1d3fd15666c00452f85aba.zip | |
Format with ormolu.
Diffstat (limited to 'src/Rahm/Desktop/XMobarLog.hs')
| -rw-r--r-- | src/Rahm/Desktop/XMobarLog.hs | 119 |
1 files changed, 58 insertions, 61 deletions
diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index e419739..5969044 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -1,24 +1,23 @@ -module Rahm.Desktop.XMobarLog ( XMobarLog, spawnXMobar, xMobarLogHook ) where +module Rahm.Desktop.XMobarLog (XMobarLog, spawnXMobar, xMobarLogHook) where import Control.Arrow (second) import Control.Monad (forM_) -import Control.Monad.Writer (tell, execWriter) +import Control.Monad.Writer (execWriter, tell) +import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.List (sortBy) -import Data.Maybe (mapMaybe, isJust) +import Data.Maybe (isJust, mapMaybe) import Data.Ord (comparing) -import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Rahm.Desktop.Layout.Draw (drawLayout) -import System.IO (Handle, hSetEncoding, hPutStrLn, utf8) -import XMonad.Util.NamedWindows (getName) -import XMonad.Util.Run (spawnPipe) -import XMonad (X) -import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..)) -import Text.Printf import Rahm.Desktop.Logger +import qualified Rahm.Desktop.StackSet as S import Rahm.Desktop.Theater (getTheaters) - +import Rahm.Desktop.Workspaces (WorkspaceState (..), getPopulatedWorkspaces) +import System.IO (Handle, hPutStrLn, hSetEncoding, utf8) +import Text.Printf +import XMonad (X) import qualified XMonad as X -import qualified Rahm.Desktop.StackSet as S +import XMonad.Util.NamedWindows (getName) +import XMonad.Util.Run (spawnPipe) data XMobarLog = XMobarLog Handle @@ -35,7 +34,6 @@ spawnXMobar = do hSetEncoding pipe utf8 return (XMobarLog pipe) - -- XMonad Log Hook meant to be used with the XMonad config logHook. xMobarLogHook :: XMobarLog -> X () xMobarLogHook (XMobarLog xmproc) = do @@ -48,60 +46,60 @@ xMobarLogHook (XMobarLog xmproc) = do title <- maybe (pure "") (fmap show . getName) . S.peek $ winset let wss = getPopulatedWorkspaces winset - let log = trunc 80 $ execWriter $ do - tell " " - tell (toChangeLayoutAction layoutXpm) - tell " " - tell $ logLevelToXMobar loglevel - - forM_ theaters $ \theater -> case theater of - (Just n, _, True) -> do - tell "<fn=1><fc=#ffffff>" - tell n - tell " </fc></fn>" - - (Just n, _, False) -> do - tell "<fn=2><fc=#888888>" - tell n - tell " </fc></fn>" - - _ -> return () - - if not (null theaters) - then tell "| " - else return () - - forM_ wss $ \(t, ws) -> do - case t of - Current -> tell "<fn=1><fc=#ff8888>" - Visible -> tell "<fn=6><fc=#8888ff>" - Hidden -> tell "<fn=2><fc=#888888>" - - tell $ toAction $ S.tag ws - tell " </fc></fn>" - - tell " <fc=#ff8888><fn=3>" - tell title - tell "</fn></fc>" + let log = trunc 80 $ + execWriter $ do + tell " " + tell (toChangeLayoutAction layoutXpm) + tell " " + tell $ logLevelToXMobar loglevel + + forM_ theaters $ \theater -> case theater of + (Just n, _, True) -> do + tell "<fn=1><fc=#ffffff>" + tell n + tell " </fc></fn>" + (Just n, _, False) -> do + tell "<fn=2><fc=#888888>" + tell n + tell " </fc></fn>" + _ -> return () + + if not (null theaters) + then tell "| " + else return () + + forM_ wss $ \(t, ws) -> do + case t of + Current -> tell "<fn=1><fc=#ff8888>" + Visible -> tell "<fn=6><fc=#8888ff>" + Hidden -> tell "<fn=2><fc=#888888>" + + tell $ toAction $ S.tag ws + tell " </fc></fn>" + + tell " <fc=#ff8888><fn=3>" + tell title + tell "</fn></fc>" logs Trace "XMobar: %s" log X.io $ hPutStrLn xmproc log - where - toAction [ch] | isAsciiUpper ch || - isAsciiLower ch || - isDigit ch = - printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch] + toAction [ch] + | isAsciiUpper ch + || isAsciiLower ch + || isDigit ch = + printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch] toAction ch = ch toChangeLayoutAction :: String -> String toChangeLayoutAction = - printf "<action=`xdotool key Hyper_L+space n` button=1>\ + printf + "<action=`xdotool key Hyper_L+space n` button=1>\ \<action=`xdotool key p` button=3>%s</action></action>" logLevelToXMobar Trace = "<fn=3><fc=#88ffff>[Trace]</fc></fn> " logLevelToXMobar Debug = "<fn=3><fc=#ff88ff>[Debug]</fc></fn> " - logLevelToXMobar Warn = "<fn=3><fc=#ffff88>[Warn] </fc></fn> " + logLevelToXMobar Warn = "<fn=3><fc=#ffff88>[Warn] </fc></fn> " logLevelToXMobar Error = "<fn=3><fc=#ff8888>[Error]</fc></fn> " logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn> " logLevelToXMobar _ = "" @@ -112,15 +110,14 @@ trunc :: Int -> String -> String trunc amt str = reverse $ trunc' False amt str [] where trunc' _ _ [] acc = acc - trunc' ignore amt (a:as) acc = + trunc' ignore amt (a : as) acc = case a of '<' -> trunc' True amt as (a : acc) '>' -> trunc' False amt as (a : acc) _ -> if ignore then trunc' True amt as (a : acc) - else - case amt of - 0 -> trunc' False 0 as acc - 3 -> trunc' False 0 as ("..." ++ acc) - _ -> trunc' False (amt - 1) as (a : acc) + else case amt of + 0 -> trunc' False 0 as acc + 3 -> trunc' False 0 as ("..." ++ acc) + _ -> trunc' False (amt - 1) as (a : acc) |