{-# LANGUAGE TemplateHaskell #-}
module System.Log.Heavy.TH
(putMessage,
trace, debug, info, warning, reportError, fatal,
here, thisModule
) where
import Control.Monad.Logger (liftLoc)
import Language.Haskell.TH.Syntax hiding (reportError)
import Language.Haskell.TH.Lift
import Instances.TH.Lift ()
import qualified System.Posix.Syslog as Syslog
import System.Log.Heavy.Types
import System.Log.Heavy.Level
deriveLift ''Syslog.Priority
deriveLift ''Level
putMessage :: Level -> Q Exp
putMessage :: Level -> Q Exp
putMessage Level
level = [| \msg vars -> do
let loc = $(qLocation >>= liftLoc)
src = splitDots (loc_module loc)
message = LogMessage $(lift level) src loc msg vars []
logMessage message
|]
here :: Q Exp
here :: Q Exp
here = Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc
thisModule :: Q Exp
thisModule :: Q Exp
thisModule = do
Loc
loc <- Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation
[String] -> Q Exp
forall t. Lift t => t -> Q Exp
lift ([String] -> Q Exp) -> [String] -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDots (Loc -> String
loc_module Loc
loc)
trace :: Q Exp
trace :: Q Exp
trace = Level -> Q Exp
putMessage Level
trace_level
debug :: Q Exp
debug :: Q Exp
debug = Level -> Q Exp
putMessage Level
debug_level
info :: Q Exp
info :: Q Exp
info = Level -> Q Exp
putMessage Level
info_level
warning :: Q Exp
warning :: Q Exp
warning = Level -> Q Exp
putMessage Level
warn_level
reportError :: Q Exp
reportError :: Q Exp
reportError = Level -> Q Exp
putMessage Level
error_level
fatal :: Q Exp
fatal :: Q Exp
fatal = Level -> Q Exp
putMessage Level
fatal_level