{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module EasyLogger.Logger
( LogDestination (..)
, LogLevel (..)
, initLogger
, initLoggerAllPackages
, setLoggingDestination
, setMinLogLevel
, logAll
, logPrintAll
, logDebug
, logPrintDebug
, logInfo
, logPrintInfo
, logWarning
, logPrintWarning
, logError
, logPrintError
, pureLogAll
, pureLogPrintAll
, pureLogDebug
, pureLogPrintDebug
, pureLogInfo
, pureLogPrintInfo
, pureLogWarning
, pureLogPrintWarning
, pureLogError
, pureLogPrintError
, finalizeAllLoggers
, finalizeLogger
, flushLoggers
) where
import Control.Applicative ((<|>))
import Control.Monad (join, when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Char8 as S8
import Data.IORef
import Data.List (find)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Language.Haskell.TH.Syntax as TH
import System.IO
import System.IO.Unsafe (unsafePerformIO)
import EasyLogger.Date
import EasyLogger.LogStr
import EasyLogger.LoggerSet
import EasyLogger.Push
import EasyLogger.Util (liftLoc)
import Debug.Trace
setLoggerSet :: String -> LoggerSet -> IO ()
setLoggerSet :: String -> LoggerSet -> IO ()
setLoggerSet String
pkgName LoggerSet
set = IORef (Map String LoggerSet)
-> (Map String LoggerSet -> Map String LoggerSet) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String LoggerSet)
loggerSets (String -> LoggerSet -> Map String LoggerSet -> Map String LoggerSet
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
pkgName LoggerSet
set)
loggerSets :: IORef (M.Map String LoggerSet)
loggerSets :: IORef (Map String LoggerSet)
loggerSets = IO (IORef (Map String LoggerSet)) -> IORef (Map String LoggerSet)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Map String LoggerSet)) -> IORef (Map String LoggerSet))
-> IO (IORef (Map String LoggerSet))
-> IORef (Map String LoggerSet)
forall a b. (a -> b) -> a -> b
$ Map String LoggerSet -> IO (IORef (Map String LoggerSet))
forall a. a -> IO (IORef a)
newIORef Map String LoggerSet
forall a. Monoid a => a
mempty
{-# NOINLINE loggerSets #-}
finalizeAllLoggers :: IO ()
finalizeAllLoggers :: IO ()
finalizeAllLoggers = do
[String]
pkgs <- ((String, LoggerSet) -> String)
-> [(String, LoggerSet)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, LoggerSet) -> String
forall a b. (a, b) -> a
fst ([(String, LoggerSet)] -> [String])
-> (Map String LoggerSet -> [(String, LoggerSet)])
-> Map String LoggerSet
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String LoggerSet -> [(String, LoggerSet)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String LoggerSet -> [String])
-> IO (Map String LoggerSet) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map String LoggerSet) -> IO (Map String LoggerSet)
forall a. IORef a -> IO a
readIORef IORef (Map String LoggerSet)
loggerSets
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
closeLoggerPkg [String]
pkgs
finalizeLogger :: Q Exp
finalizeLogger :: Q Exp
finalizeLogger = [| closeLogger $(qLocation >>= liftLoc)|]
flushLoggers :: IO ()
flushLoggers :: IO ()
flushLoggers = IORef (Map String LoggerSet) -> IO (Map String LoggerSet)
forall a. IORef a -> IO a
readIORef IORef (Map String LoggerSet)
loggerSets IO (Map String LoggerSet)
-> (Map String LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LoggerSet -> IO ()) -> Map String LoggerSet -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LoggerSet -> IO ()
flushLoggerSet
closeLogger :: Loc -> IO ()
closeLogger :: Loc -> IO ()
closeLogger (Loc String
_ String
pkgName String
_ CharPos
_ CharPos
_) = String -> IO ()
closeLoggerPkg String
pkgName
closeLoggerPkg :: String -> IO ()
closeLoggerPkg :: String -> IO ()
closeLoggerPkg String
pkgName = do
Map String LoggerSet
refs <- IORef (Map String LoggerSet) -> IO (Map String LoggerSet)
forall a. IORef a -> IO a
readIORef IORef (Map String LoggerSet)
loggerSets
case String -> Map String LoggerSet -> Maybe LoggerSet
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
pkgName Map String LoggerSet
refs of
Maybe LoggerSet
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just set :: LoggerSet
set@(LoggerSet Maybe String
Nothing IORef FD
_ Array Int Logger
_ IO ()
_) -> String -> IO ()
deletePackage String
pkgName IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LoggerSet -> IO ()
rmLoggerSet LoggerSet
set
Just set :: LoggerSet
set@(LoggerSet Maybe String
justFp IORef FD
_ Array Int Logger
_ IO ()
_) -> do
String -> IO ()
deletePackage String
pkgName
let nrFD :: Int
nrFD = [LoggerSet] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LoggerSet] -> Int) -> [LoggerSet] -> Int
forall a b. (a -> b) -> a -> b
$ (LoggerSet -> Bool) -> [LoggerSet] -> [LoggerSet]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(LoggerSet Maybe String
mFp IORef FD
_ Array Int Logger
_ IO ()
_) -> Maybe String
mFp Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
justFp) (Map String LoggerSet -> [LoggerSet]
forall k a. Map k a -> [a]
M.elems Map String LoggerSet
refs)
if Int
nrFD Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
then LoggerSet -> IO ()
rmLoggerSet LoggerSet
set
else LoggerSet -> IO ()
flushLoggerSet LoggerSet
set
deletePackage :: String -> IO ()
deletePackage :: String -> IO ()
deletePackage String
pkg = IORef (Map String LoggerSet)
-> (Map String LoggerSet -> Map String LoggerSet) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map String LoggerSet)
loggerSets (String -> Map String LoggerSet -> Map String LoggerSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
pkg)
data LogDestination
= LogStdErr
| LogStdOut
| LogFile FilePath
type LogFromAllPackages = Bool
initLoggerAllPackages :: Q Exp
initLoggerAllPackages :: Q Exp
initLoggerAllPackages = [| \dest logLevel logAllPkgs -> setMinLogLevel logLevel >> setLoggingDestination (loc_package $(qLocation >>= liftLoc)) dest logAllPkgs |]
initLogger :: Q Exp
initLogger :: Q Exp
initLogger = [| \dest logLevel -> setMinLogLevel logLevel >> setLoggingDestination (loc_package $(qLocation >>= liftLoc)) dest False |]
setLoggingDestination :: String -> LogDestination -> LogFromAllPackages -> IO ()
setLoggingDestination :: String -> LogDestination -> Bool -> IO ()
setLoggingDestination String
pkgName LogDestination
LogStdErr Bool
logAllPkgs = Int -> IO LoggerSet
newStderrLoggerSet Int
defaultBufSize IO LoggerSet -> (LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LoggerSet
ls -> String -> LoggerSet -> IO ()
setLoggerSet String
pkgName LoggerSet
ls IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
logAllPkgs (LoggerSet -> String -> LogDestination -> IO ()
setLoggingDestinationAllPkgs LoggerSet
ls String
defaultLogPkgName LogDestination
LogStdErr)
setLoggingDestination String
pkgName LogDestination
LogStdOut Bool
logAllPkgs = Int -> IO LoggerSet
newStdoutLoggerSet Int
defaultBufSize IO LoggerSet -> (LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LoggerSet
ls -> String -> LoggerSet -> IO ()
setLoggerSet String
pkgName LoggerSet
ls IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
logAllPkgs (LoggerSet -> String -> LogDestination -> IO ()
setLoggingDestinationAllPkgs LoggerSet
ls String
defaultLogPkgName LogDestination
LogStdOut)
setLoggingDestination String
pkgName (LogFile String
fp) Bool
logAllPkgs = do
[LoggerSet]
allLs <- Map String LoggerSet -> [LoggerSet]
forall k a. Map k a -> [a]
M.elems (Map String LoggerSet -> [LoggerSet])
-> IO (Map String LoggerSet) -> IO [LoggerSet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map String LoggerSet) -> IO (Map String LoggerSet)
forall a. IORef a -> IO a
readIORef IORef (Map String LoggerSet)
loggerSets
LoggerSet
ls <-
case (LoggerSet -> Bool) -> [LoggerSet] -> Maybe LoggerSet
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(LoggerSet Maybe String
mFp IORef FD
_ Array Int Logger
_ IO ()
_) -> Maybe String
mFp Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
fp) [LoggerSet]
allLs of
Maybe LoggerSet
Nothing -> Int -> String -> IO LoggerSet
newFileLoggerSet Int
defaultBufSize String
fp
Just LoggerSet
lsFile -> Int -> LoggerSet -> IO LoggerSet
newFileLoggerSetSameFile Int
defaultBufSize LoggerSet
lsFile
String -> LoggerSet -> IO ()
setLoggerSet String
pkgName LoggerSet
ls IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
logAllPkgs (LoggerSet -> String -> LogDestination -> IO ()
setLoggingDestinationAllPkgs LoggerSet
ls String
defaultLogPkgName (String -> LogDestination
LogFile String
fp))
setLoggingDestinationAllPkgs :: LoggerSet -> String -> LogDestination -> IO ()
setLoggingDestinationAllPkgs :: LoggerSet -> String -> LogDestination -> IO ()
setLoggingDestinationAllPkgs LoggerSet
_ String
pkgName LogDestination
LogStdErr = Int -> IO LoggerSet
newStderrLoggerSet Int
defaultBufSize IO LoggerSet -> (LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LoggerSet -> IO ()
setLoggerSet String
pkgName
setLoggingDestinationAllPkgs LoggerSet
_ String
pkgName LogDestination
LogStdOut = Int -> IO LoggerSet
newStdoutLoggerSet Int
defaultBufSize IO LoggerSet -> (LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LoggerSet -> IO ()
setLoggerSet String
pkgName
setLoggingDestinationAllPkgs LoggerSet
ls String
pkgName LogFile{} = Int -> LoggerSet -> IO LoggerSet
newFileLoggerSetSameFile Int
defaultBufSize LoggerSet
ls IO LoggerSet -> (LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> LoggerSet -> IO ()
setLoggerSet String
pkgName
defaultLogPkgName :: String
defaultLogPkgName :: String
defaultLogPkgName = String
"__default__"
mainLogPkgName :: String
mainLogPkgName :: String
mainLogPkgName = String
"main"
defaultBufSize :: BufSize
defaultBufSize :: Int
defaultBufSize = Int
4096
data LogLevel
= LogNone
| LogAll
| LogDebug
| LogInfo
| LogWarning
| LogError
deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLevel]
$creadListPrec :: ReadPrec [LogLevel]
readPrec :: ReadPrec LogLevel
$creadPrec :: ReadPrec LogLevel
readList :: ReadS [LogLevel]
$creadList :: ReadS [LogLevel]
readsPrec :: Int -> ReadS LogLevel
$creadsPrec :: Int -> ReadS LogLevel
Read, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord)
logLevelText :: LogLevel -> T.Text
logLevelText :: LogLevel -> Text
logLevelText LogLevel
LogNone = Text
forall a. Monoid a => a
mempty
logLevelText LogLevel
LogAll = Text
"ALL"
logLevelText LogLevel
LogDebug = Text
"DEBUG"
logLevelText LogLevel
LogInfo = Text
"INFO "
logLevelText LogLevel
LogWarning = Text
"WARN "
logLevelText LogLevel
LogError = Text
"ERROR"
logFun :: (ToLogStr msg) => Loc -> LogLevel -> msg -> IO ()
logFun :: Loc -> LogLevel -> msg -> IO ()
logFun Loc
_ LogLevel
LogNone msg
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logFun loc :: Loc
loc@(Loc String
_ String
pkg String
_ CharPos
_ CharPos
_) LogLevel
level msg
msg = do
LogLevel
minLevel <- IORef LogLevel -> IO LogLevel
forall a. IORef a -> IO a
readIORef IORef LogLevel
minLogLevel
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
minLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FormattedTime
now <- IO (IO FormattedTime) -> IO FormattedTime
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IORef (IO FormattedTime) -> IO (IO FormattedTime)
forall a. IORef a -> IO a
readIORef IORef (IO FormattedTime)
cachedTime)
IORef (Map String LoggerSet) -> IO (Map String LoggerSet)
forall a. IORef a -> IO a
readIORef IORef (Map String LoggerSet)
loggerSets IO (Map String LoggerSet)
-> (Map String LoggerSet -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map String LoggerSet
sets ->
case Map String LoggerSet -> Maybe LoggerSet
forall a. Map String a -> Maybe a
getLogger Map String LoggerSet
sets of
Maybe LoggerSet
Nothing
| Map String LoggerSet -> Bool
forall k a. Map k a -> Bool
M.null Map String LoggerSet
sets Bool -> Bool -> Bool
&& String
pkg String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
mainLogPkgName -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"You must call `initLogger` at the start of your application! See the documentation of `EasyLogger.Logger`."
Maybe LoggerSet
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just LoggerSet
set -> LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
set (Loc -> FormattedTime -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
loc FormattedTime
now LogLevel
level (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg))
where
getLogger :: Map String a -> Maybe a
getLogger Map String a
sets = String -> Map String a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
pkg Map String a
sets Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Map String a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
defaultLogPkgName Map String a
sets
cachedTime :: IORef (IO FormattedTime)
cachedTime :: IORef (IO FormattedTime)
cachedTime = IO (IORef (IO FormattedTime)) -> IORef (IO FormattedTime)
forall a. IO a -> a
unsafePerformIO (IO (IORef (IO FormattedTime)) -> IORef (IO FormattedTime))
-> IO (IORef (IO FormattedTime)) -> IORef (IO FormattedTime)
forall a b. (a -> b) -> a -> b
$ do
IO FormattedTime
cache <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
simpleTimeFormat'
IO FormattedTime -> IO (IORef (IO FormattedTime))
forall a. a -> IO (IORef a)
newIORef IO FormattedTime
cache
minLogLevel :: IORef LogLevel
minLogLevel :: IORef LogLevel
minLogLevel = IO (IORef LogLevel) -> IORef LogLevel
forall a. IO a -> a
unsafePerformIO (IO (IORef LogLevel) -> IORef LogLevel)
-> IO (IORef LogLevel) -> IORef LogLevel
forall a b. (a -> b) -> a -> b
$ LogLevel -> IO (IORef LogLevel)
forall a. a -> IO (IORef a)
newIORef LogLevel
LogAll
{-# NOINLINE minLogLevel #-}
setMinLogLevel :: LogLevel -> IO ()
setMinLogLevel :: LogLevel -> IO ()
setMinLogLevel = IORef LogLevel -> LogLevel -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef LogLevel
minLogLevel
logAll :: Q Exp
logAll :: Q Exp
logAll = [| liftIO . logFun $(qLocation >>= liftLoc) LogAll |]
pureLogAll :: Q Exp
pureLogAll :: Q Exp
pureLogAll = [| \txt a -> unsafePerformIO (logFun $(qLocation >>= liftLoc) LogAll txt >> return a) |]
logPrintAll :: Q Exp
logPrintAll :: Q Exp
logPrintAll = [| \txt -> liftIO (hPutStrLn stdout ("DEBUG: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogAll txt) |]
pureLogPrintAll :: Q Exp
pureLogPrintAll :: Q Exp
pureLogPrintAll = [| \txt a -> unsafePerformIO (hPutStrLn stdout ("DEBUG: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogAll txt >> return a) |]
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = [| liftIO . logFun $(qLocation >>= liftLoc) LogDebug |]
pureLogDebug :: Q Exp
pureLogDebug :: Q Exp
pureLogDebug = [| \txt a -> unsafePerformIO (logFun $(qLocation >>= liftLoc) LogDebug txt >> return a) |]
logPrintDebug :: Q Exp
logPrintDebug :: Q Exp
logPrintDebug = [| \txt -> hPutStrLn stdout ("DEBUG: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogDebug txt |]
pureLogPrintDebug :: Q Exp
pureLogPrintDebug :: Q Exp
pureLogPrintDebug = [| \txt a -> unsafePerformIO (hPutStrLn stdout ("DEBUG: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogDebug txt >> return a) |]
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = [| liftIO . logFun $(qLocation >>= liftLoc) LogInfo |]
pureLogInfo :: Q Exp
pureLogInfo :: Q Exp
pureLogInfo = [| \txt a -> unsafePerformIO (logFun $(qLocation >>= liftLoc) LogInfo txt >> return a) |]
logPrintInfo :: Q Exp
logPrintInfo :: Q Exp
logPrintInfo = [| \txt -> liftIO (hPutStrLn stdout ("INFO: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogInfo txt) |]
pureLogPrintInfo :: Q Exp
pureLogPrintInfo :: Q Exp
pureLogPrintInfo = [| \txt a -> unsafePerformIO (hPutStrLn stdout ("INFO: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogInfo txt >> return a) |]
logWarning :: Q Exp
logWarning :: Q Exp
logWarning = [| liftIO . logFun $(qLocation >>= liftLoc) LogWarning |]
pureLogWarning :: Q Exp
pureLogWarning :: Q Exp
pureLogWarning = [| \txt a -> unsafePerformIO (logFun $(qLocation >>= liftLoc) LogWarning txt >> return a) |]
logPrintWarning :: Q Exp
logPrintWarning :: Q Exp
logPrintWarning = [| \txt -> liftIO (hPutStrLn stdout ("WARNING: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogWarning txt) |]
pureLogPrintWarning :: Q Exp
pureLogPrintWarning :: Q Exp
pureLogPrintWarning = [| \txt a -> unsafePerformIO (hPutStrLn stdout ("WARNING: " ++ T.unpack txt) >> hFlush stdout >> logFun $(qLocation >>= liftLoc) LogWarning txt >> return a) |]
logError :: Q Exp
logError :: Q Exp
logError = [| liftIO . logFun $(qLocation >>= liftLoc) LogError |]
pureLogError :: Q Exp
pureLogError :: Q Exp
pureLogError = [| \txt a -> unsafePerformIO (logFun $(qLocation >>= liftLoc) LogError txt >> return a) |]
logPrintError :: Q Exp
logPrintError :: Q Exp
logPrintError = [| \txt -> liftIO (hPutStrLn stderr ("ERROR: " ++ T.unpack txt) >> hFlush stderr >> logFun $(qLocation >>= liftLoc) LogError txt) |]
pureLogPrintError :: Q Exp
pureLogPrintError :: Q Exp
pureLogPrintError = [| \txt a -> unsafePerformIO (hPutStrLn stderr ("ERROR: " ++ T.unpack txt) >> hFlush stderr >> logFun $(qLocation >>= liftLoc) LogError txt >> return a) |]
defaultLogStr :: Loc
-> FormattedTime
-> LogLevel
-> LogStr
-> LogStr
defaultLogStr :: Loc -> FormattedTime -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
loc FormattedTime
time LogLevel
level LogStr
msg =
LogStr
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (LogLevel -> Text
logLevelText LogLevel
level) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> (LogStr
"#" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> FormattedTime -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr FormattedTime
time) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"] " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr -> LogStr
mkTrailWs LogStr
msg LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
" @(" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> FormattedTime -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> FormattedTime
S8.pack String
fileLocStr) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
")\n"
where
mkTrailWs :: LogStr -> LogStr
mkTrailWs = Int -> LogStr -> LogStr
mkMinLogStrLen Int
defaultMinLogMsgLen
fileLocStr :: String
fileLocStr = Loc -> String
loc_package Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
loc_module Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
loc_filename Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
line Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
char Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
lineEnd Loc
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: Loc -> String
charEnd Loc
loc
line :: Loc -> String
line = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPos -> Int
forall a b. (a, b) -> a
fst (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> CharPos
loc_start
char :: Loc -> String
char = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPos -> Int
forall a b. (a, b) -> b
snd (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> CharPos
loc_start
lineEnd :: Loc -> String
lineEnd = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPos -> Int
forall a b. (a, b) -> a
fst (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> CharPos
loc_end
charEnd :: Loc -> String
charEnd = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPos -> Int
forall a b. (a, b) -> b
snd (CharPos -> Int) -> (Loc -> CharPos) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> CharPos
loc_end
defaultMinLogMsgLen :: Int
defaultMinLogMsgLen :: Int
defaultMinLogMsgLen = Int
60