module Rahm.Desktop.Logger where

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, Bounded)

newtype LoggerState =
  LoggerState {
    logLevel :: LogLevel
  } deriving (Show, Read, Eq)

instance ExtensionClass LoggerState where
  initialValue = LoggerState Info
  extensionType = PersistentExtension

class (PrintfType (Printf t)) => LoggerType t where
  type Printf t :: *
  gp :: Printf t -> (String -> X ()) -> t

instance (PrintfArg a, LoggerType b) => LoggerType (a -> b) where
  type Printf (a -> b) = a -> Printf b
  gp g f a = gp (g a) f

instance (a ~ ()) => LoggerType (X a) where
  type Printf (X a) = String
  gp str fn = fn str

getLogLevel :: X LogLevel
getLogLevel = logLevel <$> XS.get

setLogLevel :: LogLevel -> X ()
setLogLevel ll = do
  XS.put $ LoggerState ll
  join $ asks (logHook . config)

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)