diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 14 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Logger.hs | 37 | ||||
| -rw-r--r-- | src/Rahm/Desktop/XMobarLog.hs | 43 |
3 files changed, 62 insertions, 32 deletions
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index c8abbf0..d0305b3 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -73,6 +73,9 @@ type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) spawnX :: String -> X () spawnX = spawn +safeSpawnX :: String -> [String] -> X () +safeSpawnX = safeSpawn + noWindow :: b -> Window -> b noWindow = const @@ -600,6 +603,17 @@ keymap = runKeys $ do doc "Toggle zoom on the current window." $ sendMessage togglePop + bind xK_F8 $ do + justMod $ do + ll <- getLogLevel + let next = if minBound == ll then maxBound else pred ll + + safeSpawnX "notify-send" + ["-t", "2000", printf "LogLevel set to %s" (show next)] + setLogLevel next + logs next "LogLevel set to %s." (show next) + + bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs index 3da70d1..95a65ca 100644 --- a/src/Rahm/Desktop/Logger.hs +++ b/src/Rahm/Desktop/Logger.hs @@ -1,15 +1,16 @@ module Rahm.Desktop.Logger where -import Control.Monad (when) +import Control.Monad (when, forM_, join) import XMonad import qualified XMonad.Util.ExtensibleState as XS import System.IO +import Data.Time.LocalTime (getZonedTime) import Rahm.Desktop.NoPersist import Text.Printf data LogLevel = Trace | Debug | Info | Warn | Error | Fatal - deriving (Show, Read, Ord, Eq, Enum) + deriving (Show, Read, Ord, Eq, Enum, Bounded) newtype LoggerState = LoggerState { @@ -21,28 +22,30 @@ instance ExtensionClass LoggerState where extensionType = PersistentExtension class (PrintfType (Printf t)) => LoggerType t where - type EndResult t :: * type Printf t :: * - - gp :: (String -> EndResult t) -> Printf t -> t + gp :: Printf t -> (String -> X ()) -> t instance (PrintfArg a, LoggerType b) => LoggerType (a -> b) where - type EndResult (a -> b) = EndResult b type Printf (a -> b) = a -> Printf b - - gp f g a = gp f (g a) + gp g f a = gp (g a) f instance (a ~ ()) => LoggerType (X a) where - type EndResult (X a) = X () type Printf (X a) = String + gp str fn = fn str - gp fn str = fn str +getLogLevel :: X LogLevel +getLogLevel = logLevel <$> XS.get -logs :: (LoggerType r, EndResult r ~ X ()) => LogLevel -> String -> r -logs ll fmt = gp (\s -> do - LoggerState ll' <- XS.get - when (ll >= ll') $ - io $ putStrLn ("[" ++ show ll ++ "] " ++ s)) (printf fmt) +setLogLevel :: LogLevel -> X () +setLogLevel ll = do + XS.put $ LoggerState ll + join $ asks (logHook . config) -test :: X () -test = logs Info "Test %s" +logs :: (LoggerType r) => LogLevel -> String -> r +logs ll fmt = gp (printf fmt) $ \ss -> do + LoggerState ll' <- XS.get + io $ do + zoneTime <- getZonedTime + when (ll >= ll') $ + forM_ (lines ss) $ \s -> + putStrLn (printf "[%s %s] - %s" (take 23 $ show zoneTime) (show ll) s) diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index d0dcc4f..6ec4ac7 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -13,6 +13,7 @@ import XMonad.Util.Run (spawnPipe) import XMonad (X) import Rahm.Desktop.Workspaces (getPopulatedWorkspaces, WorkspaceState(..)) import Text.Printf +import Rahm.Desktop.Logger import qualified XMonad as X import qualified XMonad.StackSet as S @@ -38,28 +39,33 @@ xMobarLogHook :: XMobarLog -> X () xMobarLogHook (XMobarLog xmproc) = do (_, _, layoutXpm) <- drawLayout + loglevel <- getLogLevel + winset <- X.gets X.windowset title <- maybe (pure "") (fmap show . getName) . S.peek $ winset let wss = getPopulatedWorkspaces winset - X.liftIO $ do - hPutStrLn xmproc $ trunc 80 $ execWriter $ do - tell " " - tell layoutXpm - tell $ " " + let log = trunc 80 $ execWriter $ do + tell " " + tell layoutXpm + tell $ " " + tell $ logLevelToXMobar loglevel + + 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>" - 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 $ toAction $ S.tag ws - tell " </fc></fn>" + tell $ " <fc=#ff8888><fn=3>" + tell $ title + tell $ "</fn></fc>" - tell $ " <fc=#ff8888><fn=3>" - tell $ title - tell $ "</fn></fc>" + logs Trace "XMobar: %s" log + X.io $ hPutStrLn xmproc log where toAction [ch] | (ch >= 'A' && ch <= 'Z') || @@ -68,6 +74,13 @@ xMobarLogHook (XMobarLog xmproc) = do 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 + 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 Error = "<fn=3><fc=#ff8888>[Error]</fc></fn> " + logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn> " + logLevelToXMobar _ = "" + -- Truncate an XMobar string to the provided number of _visible_ characters. -- This is to keep long window titles from overrunning the whole bar. trunc :: Int -> String -> String |