{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module EasyLogger.Logger
( LogDestination (..)
, LogLevel (..)
, initLogger
, initLoggerAllPackages
, setLoggingDestination
, setMinLogLevel
, setPrintLocationToConsole
, logAll
, logPrintAll
, logDebug
, logPrintDebug
, logInfo
, logPrintInfo
, logWarning
, logPrintWarning
, logError
, logPrintError
, pureLogAll
, pureLogPrintAll
, pureLogDebug
, pureLogPrintDebug
, pureLogInfo
, pureLogPrintInfo
, pureLogWarning
, pureLogPrintWarning
, pureLogError
, pureLogPrintError
, logAllText
, logPrintAllText
, logDebugText
, logPrintDebugText
, logInfoText
, logPrintInfoText
, logWarningText
, logPrintWarningText
, logErrorText
, logPrintErrorText
, pureLogAllText
, pureLogPrintAllText
, pureLogDebugText
, pureLogPrintDebugText
, pureLogInfoText
, pureLogPrintInfoText
, pureLogWarningText
, pureLogPrintWarningText
, pureLogErrorText
, pureLogPrintErrorText
, 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)
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 logAllPkgs -> setLoggingDestination (loc_package $(qLocation >>= liftLoc)) dest logAllPkgs |]
initLogger :: Q Exp
initLogger :: Q Exp
initLogger = [| \dest -> 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) => Bool -> Loc -> LogLevel -> msg -> IO ()
logFun :: Bool -> Loc -> LogLevel -> msg -> IO ()
logFun Bool
_ Loc
_ LogLevel
LogNone msg
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
logFun Bool
printMsg loc :: Loc
loc@(Loc String
_ String
pkg String
_ CharPos
_ CharPos
_) LogLevel
level msg
msg = do
(LogLevel
minLevel, Bool
printLoc) <- IORef (LogLevel, Bool) -> IO (LogLevel, Bool)
forall a. IORef a -> IO a
readIORef IORef (LogLevel, Bool)
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 -> do
let logStr :: LogStr
logStr = Bool -> Loc -> FormattedTime -> LogLevel -> LogStr -> LogStr
defaultLogStr Bool
True Loc
loc FormattedTime
now LogLevel
level (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg)
logStrPrint :: LogStr
logStrPrint | Bool
printLoc = LogStr
logStr
| Bool
otherwise = Bool -> Loc -> FormattedTime -> LogLevel -> LogStr -> LogStr
defaultLogStr Bool
False Loc
loc FormattedTime
now LogLevel
level (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
printMsg (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FormattedTime -> IO ()
S8.hPutStr Handle
handle (LogStr -> FormattedTime
fromLogStr LogStr
logStrPrint) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
handle
LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
set LogStr
logStr
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
handle :: Handle
handle = case LogLevel
level of
LogLevel
LogError -> Handle
stderr
LogLevel
_ -> Handle
stdout
mkTxt :: T.Text -> T.Text
mkTxt :: Text -> Text
mkTxt = Text -> Text
forall a. a -> a
id
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, Bool)
minLogLevel :: IORef (LogLevel, Bool)
minLogLevel = IO (IORef (LogLevel, Bool)) -> IORef (LogLevel, Bool)
forall a. IO a -> a
unsafePerformIO (IO (IORef (LogLevel, Bool)) -> IORef (LogLevel, Bool))
-> IO (IORef (LogLevel, Bool)) -> IORef (LogLevel, Bool)
forall a b. (a -> b) -> a -> b
$ (LogLevel, Bool) -> IO (IORef (LogLevel, Bool))
forall a. a -> IO (IORef a)
newIORef (LogLevel
LogAll, Bool
False)
{-# NOINLINE minLogLevel #-}
setMinLogLevel :: LogLevel -> IO ()
setMinLogLevel :: LogLevel -> IO ()
setMinLogLevel LogLevel
x = IORef (LogLevel, Bool)
-> ((LogLevel, Bool) -> (LogLevel, Bool)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (LogLevel, Bool)
minLogLevel (\(LogLevel
_, Bool
b) -> (LogLevel
x, Bool
b))
setPrintLocationToConsole :: Bool -> IO ()
setPrintLocationToConsole :: Bool -> IO ()
setPrintLocationToConsole Bool
x = IORef (LogLevel, Bool)
-> ((LogLevel, Bool) -> (LogLevel, Bool)) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (LogLevel, Bool)
minLogLevel (\(LogLevel
l, Bool
_) -> (LogLevel
l, Bool
x))
logAll :: Q Exp
logAll :: Q Exp
logAll = [| liftIO . logFun False $(qLocation >>= liftLoc) LogAll |]
logAllText :: Q Exp
logAllText :: Q Exp
logAllText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogAll . mkTxt |]
pureLogAll :: Q Exp
pureLogAll :: Q Exp
pureLogAll = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogAll txt >> return a) |]
pureLogAllText :: Q Exp
pureLogAllText :: Q Exp
pureLogAllText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogAll (mkTxt txt) >> return a) |]
logPrintAll :: Q Exp
logPrintAll :: Q Exp
logPrintAll = [| liftIO . logFun True $(qLocation >>= liftLoc) LogAll |]
logPrintAllText :: Q Exp
logPrintAllText :: Q Exp
logPrintAllText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogAll . mkTxt |]
pureLogPrintAll :: Q Exp
pureLogPrintAll :: Q Exp
pureLogPrintAll = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogAll txt >> return a) |]
pureLogPrintAllText :: Q Exp
pureLogPrintAllText :: Q Exp
pureLogPrintAllText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogAll (mkTxt txt) >> return a) |]
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = [| liftIO . logFun False $(qLocation >>= liftLoc) LogDebug |]
logDebugText :: Q Exp
logDebugText :: Q Exp
logDebugText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogDebug . mkTxt |]
pureLogDebug :: Q Exp
pureLogDebug :: Q Exp
pureLogDebug = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogDebug txt >> return a) |]
pureLogDebugText :: Q Exp
pureLogDebugText :: Q Exp
pureLogDebugText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogDebug (mkTxt txt) >> return a) |]
logPrintDebug :: Q Exp
logPrintDebug :: Q Exp
logPrintDebug = [| liftIO . logFun True $(qLocation >>= liftLoc) LogDebug |]
logPrintDebugText :: Q Exp
logPrintDebugText :: Q Exp
logPrintDebugText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogDebug . mkTxt |]
pureLogPrintDebug :: Q Exp
pureLogPrintDebug :: Q Exp
pureLogPrintDebug = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogDebug txt >> return a) |]
pureLogPrintDebugText :: Q Exp
pureLogPrintDebugText :: Q Exp
pureLogPrintDebugText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogDebug (mkTxt txt) >> return a) |]
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = [| liftIO . logFun False $(qLocation >>= liftLoc) LogInfo |]
logInfoText :: Q Exp
logInfoText :: Q Exp
logInfoText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogInfo . mkTxt |]
pureLogInfo :: Q Exp
pureLogInfo :: Q Exp
pureLogInfo = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogInfo txt >> return a) |]
pureLogInfoText :: Q Exp
pureLogInfoText :: Q Exp
pureLogInfoText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogInfo (mkTxt txt) >> return a) |]
logPrintInfo :: Q Exp
logPrintInfo :: Q Exp
logPrintInfo = [| liftIO . logFun True $(qLocation >>= liftLoc) LogInfo |]
logPrintInfoText :: Q Exp
logPrintInfoText :: Q Exp
logPrintInfoText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogInfo . mkTxt |]
pureLogPrintInfo :: Q Exp
pureLogPrintInfo :: Q Exp
pureLogPrintInfo = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogInfo txt >> return a) |]
pureLogPrintInfoText :: Q Exp
pureLogPrintInfoText :: Q Exp
pureLogPrintInfoText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogInfo (mkTxt txt) >> return a) |]
logWarning :: Q Exp
logWarning :: Q Exp
logWarning = [| liftIO . logFun False $(qLocation >>= liftLoc) LogWarning |]
logWarningText :: Q Exp
logWarningText :: Q Exp
logWarningText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogWarning . mkTxt |]
pureLogWarning :: Q Exp
pureLogWarning :: Q Exp
pureLogWarning = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogWarning txt >> return a) |]
pureLogWarningText :: Q Exp
pureLogWarningText :: Q Exp
pureLogWarningText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogWarning (mkTxt txt) >> return a) |]
logPrintWarning :: Q Exp
logPrintWarning :: Q Exp
logPrintWarning = [| liftIO . logFun True $(qLocation >>= liftLoc) LogWarning |]
logPrintWarningText :: Q Exp
logPrintWarningText :: Q Exp
logPrintWarningText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogWarning . mkTxt |]
pureLogPrintWarning :: Q Exp
pureLogPrintWarning :: Q Exp
pureLogPrintWarning = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogWarning txt >> return a) |]
pureLogPrintWarningText :: Q Exp
pureLogPrintWarningText :: Q Exp
pureLogPrintWarningText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogWarning (mkTxt txt) >> return a) |]
logError :: Q Exp
logError :: Q Exp
logError = [| liftIO . logFun False $(qLocation >>= liftLoc) LogError |]
logErrorText :: Q Exp
logErrorText :: Q Exp
logErrorText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogError . mkTxt |]
pureLogError :: Q Exp
pureLogError :: Q Exp
pureLogError = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogError txt >> return a) |]
pureLogErrorText :: Q Exp
pureLogErrorText :: Q Exp
pureLogErrorText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogError (mkTxt txt) >> return a) |]
logPrintError :: Q Exp
logPrintError :: Q Exp
logPrintError = [| liftIO . logFun True $(qLocation >>= liftLoc) LogError |]
logPrintErrorText :: Q Exp
logPrintErrorText :: Q Exp
logPrintErrorText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogError . mkTxt |]
pureLogPrintError :: Q Exp
pureLogPrintError :: Q Exp
pureLogPrintError = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogError txt >> return a) |]
pureLogPrintErrorText :: Q Exp
pureLogPrintErrorText :: Q Exp
pureLogPrintErrorText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogError (mkTxt txt) >> return a) |]
defaultLogStr :: Bool
-> Loc
-> FormattedTime
-> LogLevel
-> LogStr
-> LogStr
defaultLogStr :: Bool -> Loc -> FormattedTime -> LogLevel -> LogStr -> LogStr
defaultLogStr Bool
prLoc 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
<> (if Bool
prLoc then 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" else 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