From 691e08015abb10b059477ba4c35f254e7a1f59be Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Fri, 22 Apr 2022 00:27:36 -0600
Subject: Infrastructure for better logging, finally!

Right now all existing logs are logged at Info, but this will
change. This should make it significantly easier to debug
things wit log levels like Trace. I may at some point define more
log level endpoints or come up with a more expressive logging
system, but this is a good start.
---
 src/Rahm/Desktop/Logger.hs | 48 ++++++++++++++++++++++++++++++----------------
 1 file changed, 32 insertions(+), 16 deletions(-)

(limited to 'src/Rahm/Desktop/Logger.hs')

diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs
index c73942f..3da70d1 100644
--- a/src/Rahm/Desktop/Logger.hs
+++ b/src/Rahm/Desktop/Logger.hs
@@ -1,32 +1,48 @@
 module Rahm.Desktop.Logger where
 
+import Control.Monad (when)
 import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 import System.IO
 
 import Rahm.Desktop.NoPersist
+import Text.Printf
+
+data LogLevel = Trace | Debug | Info | Warn | Error | Fatal
+  deriving (Show, Read, Ord, Eq, Enum)
 
 newtype LoggerState =
   LoggerState {
-    logHandle :: Maybe (NoPersist Handle)
-  }
+    logLevel :: LogLevel
+  } deriving (Show, Read, Eq)
 
 instance ExtensionClass LoggerState where
-  initialValue = LoggerState Nothing
+  initialValue = LoggerState Info
+  extensionType = PersistentExtension
+
+class (PrintfType (Printf t)) => LoggerType t where
+  type EndResult t :: *
+  type Printf t :: *
+
+  gp :: (String -> EndResult t) -> Printf t -> 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)
 
-logs :: String -> X ()
-logs s = do
-  LoggerState handle' <- XS.get
+instance (a ~ ()) => LoggerType (X a) where
+  type EndResult (X a) = X ()
+  type Printf (X a) = String
 
-  handle <-
-    case handle' of
-      Nothing -> do
-        handle <- io $ openFile "/tmp/xmonad.log" AppendMode
-        XS.put $ LoggerState $ Just $ NoPersist handle
-        return handle
+  gp fn str = fn str
 
-      Just (NoPersist h) -> return h
+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)
 
-  io $ do
-    hPutStrLn handle s
-    hFlush handle
+test :: X ()
+test = logs Info "Test %s"
-- 
cgit