diff options
Diffstat (limited to 'src/Rahm/Desktop/Logger.hs')
| -rw-r--r-- | src/Rahm/Desktop/Logger.hs | 37 |
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) |