From 7dfbd2e4bc893f7527f9cc4ebf9c474ddfb0dc65 Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 22 Apr 2022 16:22:30 -0600
Subject: Some new styling and better logging capabilites

---
 src/Rahm/Desktop/Keys.hs      | 14 ++++++++++++++
 src/Rahm/Desktop/Logger.hs    | 37 ++++++++++++++++++++-----------------
 src/Rahm/Desktop/XMobarLog.hs | 43 ++++++++++++++++++++++++++++---------------
 3 files changed, 62 insertions(+), 32 deletions(-)

(limited to 'src/Rahm')

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
-- 
cgit