{-# 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)


-- | Add a @LoggerSet@ to the known loggers.
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)


-- | Set of loggers. We have one @LoggerSet@ for each package.
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  #-}


-- | Should be used to ensure all logs are completely written before the program exists. Cleans all the file descriptors. You (and also no other library) MUST NOT log after this command as all loggers
-- are deinitalized. However, you might initialize the loggers again and before restarting to log.
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


-- | Can be used to destroy your own logger (from your package) only. You MUST NOT log after this command.
finalizeLogger :: Q Exp
finalizeLogger :: Q Exp
finalizeLogger = [| closeLogger $(qLocation >>= liftLoc)|]


-- | Flush all loggers of all packages.
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


-- | Close logger of calling package.
closeLogger :: Loc -> IO ()
closeLogger :: Loc -> IO ()
closeLogger (Loc String
_ String
pkgName String
_ CharPos
_ CharPos
_) = String -> IO ()
closeLoggerPkg String
pkgName

-- | Close logger of package with provided package name.
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

-- | Delete a package from the logger sets and with this disable all logging. Ensure the LoggerSet is deleted in case this is the last FD before calling this function!
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)


-- | Logging destination. See also `setLoggingDestination`.
data LogDestination
  = LogStdErr
  | LogStdOut
  | LogFile FilePath

-- | Log messages from other packages that use this library too, even if they did not call @initLogger@?
type LogFromAllPackages = Bool

-- | Initialise the logger. MUST only be called in the executable code (not the exposed library code)! Takes a `Bool` that decides wether to log messages from other packages that use the same library
-- and did not initalize the Logger (which should be the case for all of them!).
initLoggerAllPackages :: Q Exp
initLoggerAllPackages :: Q Exp
initLoggerAllPackages = [| \dest logAllPkgs -> setLoggingDestination (loc_package $(qLocation >>= liftLoc)) dest logAllPkgs |]

-- | Initialise the logger. MUST only be called in the executable code (not the exposed library code)! Ignores the other packages logs, if the same packages is used for logging.
initLogger :: Q Exp
initLogger :: Q Exp
initLogger = [| \dest -> setLoggingDestination (loc_package $(qLocation >>= liftLoc)) dest False |]

-- | Set the destination for all consequitive for logging. You should only set this once, at the beginning of the program! The default is `LogStdOut`.
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"


-- | The default buffer size (4,096 bytes).
defaultBufSize :: BufSize
defaultBufSize :: Int
defaultBufSize = Int
4096


-- | Log Level. Levels are sorted. `All` < `Debug` < `Info` < `Warning` < `Error`. None disables all logging. Default: All
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)

-- | Log level text. Make sure you call @initLogger@, or logging will be disabled.
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"

-- | Generic log function. Use TH version, e.g. `logDebug`.
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 -- Check the package name of the caller, as otherwise any library logging would halt the process.
          | 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

-- | Min Log Level and whether to print location to console.
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  #-}

-- | Set the least logging level. Levels lower will not be logged. Log Level Order: `Debug` < `Info` < `Warning` < `Error`. `None` disables all logging. Note that the output to stderr using e.g. `logPrintError` will not
-- be affected!
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))

-- | Set the least logging level. Levels lower will not be logged. Log Level Order: `Debug` < `Info` < `Warning` < `Error`. `None` disables all logging. Note that the output to stderr using e.g. `logPrintError` will not
-- be affected!
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))


------------------------------ All ------------------------------

-- | Generates a function that takes a 'Text' and logs a 'LevelAll' message. Usage:
--
-- > $(logAll) ("This is a debug log message" :: T.Text)
logAll :: Q Exp
logAll :: Q Exp
logAll = [| liftIO . logFun False $(qLocation >>= liftLoc) LogAll |]

-- | Same as logAll, but with concrete type `Text` as message.
--
-- > $(logAll) "This is a debug log message"
--
logAllText :: Q Exp
logAllText :: Q Exp
logAllText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogAll . mkTxt |]


-- | Same as `logAll`, but for pure code. Uses @unsafePerformIO@.
--
-- > $(pureLogAll) "This is a debug log message" (3 * 3)
pureLogAll :: Q Exp
pureLogAll :: Q Exp
pureLogAll = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogAll txt >> return a) |]

-- | Same as `pureLogAll`, but with concrete type `Text` as message.
pureLogAllText :: Q Exp
pureLogAllText :: Q Exp
pureLogAllText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogAll (mkTxt txt) >> return a) |]


-- | Same as `logAll`, but also prints the message on `stdout`.
logPrintAll :: Q Exp
logPrintAll :: Q Exp
logPrintAll = [| liftIO . logFun True $(qLocation >>= liftLoc) LogAll |]

-- | Same as `logAll`, but also prints the message on `stdout`. Only for `Text`.
logPrintAllText :: Q Exp
logPrintAllText :: Q Exp
logPrintAllText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogAll . mkTxt |]


-- | Same as `pureLogAll`, but also prints the message on `stdout`.
--
-- > $(pureLogPrintAll) "This is a debug log message" (3 * 3)
pureLogPrintAll :: Q Exp
pureLogPrintAll :: Q Exp
pureLogPrintAll = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogAll txt >> return a) |]


-- | Same as `pureLogPrintAll`, but with concrete type `Text` as log message.
pureLogPrintAllText :: Q Exp
pureLogPrintAllText :: Q Exp
pureLogPrintAllText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogAll (mkTxt txt) >> return a) |]


------------------------------ Debug ------------------------------

-- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
--
-- > $(logDebug) "This is a debug log message"
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = [| liftIO . logFun False $(qLocation >>= liftLoc) LogDebug |]

-- | Same as `logDebug` but with `Text` as fixed message type.
logDebugText :: Q Exp
logDebugText :: Q Exp
logDebugText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogDebug . mkTxt |]


-- | Same as `logDebug`, but for pure code. Uses @unsafePerformIO@
--
-- > $(pureLogDebug) "This is a debug log message" defaultValue
pureLogDebug :: Q Exp
pureLogDebug :: Q Exp
pureLogDebug = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogDebug txt >> return a) |]


-- | Same as `pureLogDebug`, but with concrete type `Text` as message.
pureLogDebugText :: Q Exp
pureLogDebugText :: Q Exp
pureLogDebugText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogDebug (mkTxt txt) >> return a) |]


-- | Same as `logDebug`, but also prints the message on `stdout`.
logPrintDebug :: Q Exp
logPrintDebug :: Q Exp
logPrintDebug = [| liftIO . logFun True $(qLocation >>= liftLoc) LogDebug |]

-- | Same as `logDebug`, but also prints the message on `stdout`. Only for Text.
logPrintDebugText :: Q Exp
logPrintDebugText :: Q Exp
logPrintDebugText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogDebug . mkTxt |]


-- | Same as `pureLogDebug`, but also prints the message on `stdout`.
--
-- > $(purePrintLogDebug) "This is a debug log message" defaultValue
pureLogPrintDebug :: Q Exp
pureLogPrintDebug :: Q Exp
pureLogPrintDebug = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogDebug txt >> return a) |]


-- | Same as `pureLogPrintDebug`, but with concrete type `Text` as log message.
pureLogPrintDebugText :: Q Exp
pureLogPrintDebugText :: Q Exp
pureLogPrintDebugText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogDebug (mkTxt txt) >> return a) |]


------------------------------ Info ------------------------------

-- | Generates a function that takes a 'Text' and logs a 'LevelInfo' message. Usage:
--
-- > $(logInfo) "This is a info log message"
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = [| liftIO . logFun False $(qLocation >>= liftLoc) LogInfo |]


-- | Same as `logInfo` but with `Text` as fixed message type.
logInfoText :: Q Exp
logInfoText :: Q Exp
logInfoText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogInfo . mkTxt |]


-- | Same as `logInfo`, but for pure code. Uses @unsafePerformIO@.
--
-- > $(pureLogInfo) "This is a warning log message" (funcX 10)
pureLogInfo :: Q Exp
pureLogInfo :: Q Exp
pureLogInfo = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogInfo txt >> return a) |]


-- | Same as `pureLogInfo`, but with concrete type `Text` as message.
pureLogInfoText :: Q Exp
pureLogInfoText :: Q Exp
pureLogInfoText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogInfo (mkTxt txt) >> return a) |]


-- | Same as `logInfo`, but also prints the message on `stdout`.
logPrintInfo :: Q Exp
logPrintInfo :: Q Exp
logPrintInfo = [| liftIO . logFun True $(qLocation >>= liftLoc) LogInfo |]

-- | Same as `logInfo`, but also prints the message on `stdout`.
logPrintInfoText :: Q Exp
logPrintInfoText :: Q Exp
logPrintInfoText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogInfo . mkTxt |]


-- | Same as `pureLogInfo`, but also prints the message on `stdout`.
--
-- > $(pureLogPrintInfo) "This is a warning log message" (funcX 10)
pureLogPrintInfo :: Q Exp
pureLogPrintInfo :: Q Exp
pureLogPrintInfo = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogInfo txt >> return a) |]


-- | Same as `pureLogPrintInfo`, but with concrete type `Text` as log message.
pureLogPrintInfoText :: Q Exp
pureLogPrintInfoText :: Q Exp
pureLogPrintInfoText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogInfo (mkTxt txt) >> return a) |]


------------------------------ Warning ------------------------------

-- | Generates a function that takes a 'Text' and logs a 'LevelWarning' message. Usage:
--
-- > $(logWarning) "This is a warning log message"
logWarning :: Q Exp
logWarning :: Q Exp
logWarning = [| liftIO . logFun False $(qLocation >>= liftLoc) LogWarning |]

-- | Same as `logWarning` but with `Text` as fixed message type.
logWarningText :: Q Exp
logWarningText :: Q Exp
logWarningText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogWarning . mkTxt |]


-- | Same as `logWarning`, but for pure code. Uses @unsafePerformIO@.
--
-- > $(pureLogWarning) "This is a warning log message" "myresult"
pureLogWarning :: Q Exp
pureLogWarning :: Q Exp
pureLogWarning = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogWarning txt >> return a) |]

-- | Same as `pureLogWarning`, but with concrete type `Text` as message.
pureLogWarningText :: Q Exp
pureLogWarningText :: Q Exp
pureLogWarningText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogWarning (mkTxt txt) >> return a) |]


-- | Same as `logWarning`, but also prints the message on `stdout`.
logPrintWarning :: Q Exp
logPrintWarning :: Q Exp
logPrintWarning = [| liftIO . logFun True $(qLocation >>= liftLoc) LogWarning |]


-- | Same as `logWarning`, but also prints the message on `stdout`.
logPrintWarningText :: Q Exp
logPrintWarningText :: Q Exp
logPrintWarningText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogWarning . mkTxt |]


-- | Same as `pureLogWarning`, but also prints the warning.
--
-- > $(pureLogPrintWarning) "This is a error log message" (4 + 4)
pureLogPrintWarning :: Q Exp
pureLogPrintWarning :: Q Exp
pureLogPrintWarning = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogWarning txt >> return a)  |]


-- | Same as `pureLogPrintWarning`, but with concrete type `Text` as log message.
pureLogPrintWarningText :: Q Exp
pureLogPrintWarningText :: Q Exp
pureLogPrintWarningText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogWarning (mkTxt txt) >> return a) |]


------------------------------ Error ------------------------------

-- | Generates a function that takes a 'Text' and logs a 'LevelError' message. Usage:
--
-- > $(logError) "This is a error log message"
logError :: Q Exp
logError :: Q Exp
logError = [| liftIO . logFun False $(qLocation >>= liftLoc) LogError |]

-- | Same as `logError` but with `Text` as fixed message type.
logErrorText :: Q Exp
logErrorText :: Q Exp
logErrorText = [| liftIO . logFun False $(qLocation >>= liftLoc) LogError . mkTxt |]

-- | Same as `logError`, but for pure code. Uses @unsafePerformIO@.
--
-- > $(pureLogError) "This is a error log message" (4 + 4)
pureLogError :: Q Exp
pureLogError :: Q Exp
pureLogError = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogError txt >> return a) |]


-- | Same as `pureLogError`, but with concrete type `Text` as message.
pureLogErrorText :: Q Exp
pureLogErrorText :: Q Exp
pureLogErrorText = [| \txt a -> unsafePerformIO (logFun False $(qLocation >>= liftLoc) LogError (mkTxt txt) >> return a) |]


-- | Same as `logError`, but also prints the message on `stderr`.
logPrintError :: Q Exp
logPrintError :: Q Exp
logPrintError = [| liftIO . logFun True $(qLocation >>= liftLoc) LogError |]


-- | Same as `logError`, but also prints the message on `stderr`.
logPrintErrorText :: Q Exp
logPrintErrorText :: Q Exp
logPrintErrorText = [| liftIO . logFun True $(qLocation >>= liftLoc) LogError . mkTxt |]


-- | Same as `pureLogError`, but also prints the message on `stderr`.
--
-- > $(pureLogPrintError) "This is a error log message" (4 + 4)
pureLogPrintError :: Q Exp
pureLogPrintError :: Q Exp
pureLogPrintError = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogError txt >> return a) |]

-- | Same as `pureLogPrintError`, but with concrete type `Text` as log message.
pureLogPrintErrorText :: Q Exp
pureLogPrintErrorText :: Q Exp
pureLogPrintErrorText = [| \txt a -> unsafePerformIO (logFun True $(qLocation >>= liftLoc) LogError (mkTxt txt) >> return a) |]


---- Helpers:

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