aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Logger.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Logger.hs')
-rw-r--r--src/Rahm/Desktop/Logger.hs37
1 files changed, 20 insertions, 17 deletions
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)