{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Dynamic effect for "Control.Monad.Logger".
--
-- @since 0.1
module Effectful.Logger.Dynamic
  ( -- * Effect
    Logger (..),
    loggerLog,

    -- * Types
    LogLevel (..),
    LogLine,
    LogSource,

    -- * Re-export from fast-logger
    LogStr,
    ToLogStr (..),
    fromLogStr,

    -- * TH logging
    logTrace,
    logDebug,
    logInfo,
    logWarn,
    logError,
    logFatal,
    logOther,

    -- * TH logging of showable values
    logTraceSH,
    logDebugSH,
    logInfoSH,
    logWarnSH,
    logErrorSH,
    logFatalSH,
    logOtherSH,

    -- * TH logging with source
    logTraceS,
    logDebugS,
    logInfoS,
    logWarnS,
    logErrorS,
    logFatalS,
    logOtherS,

    -- * TH util
    liftLoc,

    -- * Non-TH logging
    logTraceN,
    logDebugN,
    logInfoN,
    logWarnN,
    logErrorN,
    logFatalN,
    logOtherN,

    -- * Non-TH logging with source
    logWithoutLoc,
    logTraceNS,
    logDebugNS,
    logInfoNS,
    logWarnNS,
    logErrorNS,
    logFatalNS,
    logOtherNS,

    -- * Callstack logging
    logTraceCS,
    logDebugCS,
    logInfoCS,
    logWarnCS,
    logErrorCS,
    logFatalCS,
    logOtherCS,

    -- * utilities for defining your own loggers
    defaultLogStr,
    Loc (..),
    defaultLoc,
    defaultOutput,

    -- * Level checks
    guardLevel,
    shouldLog,

    -- * Formatting
    LogFormatter (..),
    Utils.defaultLogFormatter,
    LocStrategy (..),
    formatLog,

    -- * Optics
    _LevelTrace,
    _LevelInfo,
    _LevelDebug,
    _LevelWarn,
    _LevelError,
    _LevelOther,
    _LevelFatal,
  )
where

import Control.Monad (when)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as S8
import Data.Text (Text, pack)
import Data.Text qualified as T
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    type (:>),
  )
import Effectful.Concurrent (Concurrent)
import Effectful.Dispatch.Dynamic (HasCallStack, send)
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Logger.Utils
  ( LocStrategy (LocNone, LocPartial, LocStable),
    LogFormatter (MkLogFormatter, locStrategy, newline, threadLabel, timezone),
    LogLevel
      ( LevelDebug,
        LevelError,
        LevelFatal,
        LevelInfo,
        LevelOther,
        LevelTrace,
        LevelWarn
      ),
  )
import Effectful.Logger.Utils qualified as Utils
import Effectful.Time.Dynamic (Time)
import GHC.Stack
  ( CallStack,
    SrcLoc
      ( srcLocEndCol,
        srcLocEndLine,
        srcLocFile,
        srcLocModule,
        srcLocPackage,
        srcLocStartCol,
        srcLocStartLine
      ),
    getCallStack,
  )
import Language.Haskell.TH.Syntax
  ( Exp,
    Lift (lift),
    Loc
      ( Loc,
        loc_end,
        loc_filename,
        loc_module,
        loc_package,
        loc_start
      ),
    Q,
    qLocation,
  )
import Optics.Core (Prism')
import Optics.Prism (prism)
import System.IO (Handle)
import System.Log.FastLogger (LogStr, ToLogStr (toLogStr), fromLogStr)

-- | Dynamic logging effect for "Control.Monad.Logger".
--
-- @since 0.1
data Logger :: Effect where
  LoggerLog ::
    (ToLogStr msg) =>
    Loc ->
    LogSource ->
    LogLevel ->
    msg ->
    Logger m ()

-- | @since 0.1
type instance DispatchOf Logger = Dynamic

-- | @since 0.1
instance ShowEffect Logger where
  showEffectCons :: forall (m :: * -> *) a. Logger m a -> String
showEffectCons = \case
    LoggerLog Loc
_ Text
_ LogLevel
_ msg
_ -> String
"LoggerLog"

-- | Writes a log.
--
-- @since 0.1
loggerLog ::
  ( HasCallStack,
    Logger :> es,
    ToLogStr msg
  ) =>
  Loc ->
  LogSource ->
  LogLevel ->
  msg ->
  Eff es ()
loggerLog :: forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> Eff es ()
loggerLog Loc
loc Text
src LogLevel
lvl = Logger (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Logger (Eff es) () -> Eff es ())
-> (msg -> Logger (Eff es) ()) -> msg -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Text -> LogLevel -> msg -> Logger (Eff es) ()
forall msg (m :: * -> *).
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> Logger m ()
LoggerLog Loc
loc Text
src LogLevel
lvl

-- | @since 0.1
type LogSource = Text

-- | Produces a formatted 'LogStr' in terms of:
--
-- - Static Concurrent.
-- - Dynamic Time.
--
-- __Example__
--
-- @
-- -- [timestamp][thread_label][code_loc][level] msg
-- [2022-02-08 10:20:05][thread-label][filename:1:2][Warn] msg
-- @
--
-- @since 0.1
formatLog ::
  forall msg es.
  ( Concurrent :> es,
    HasCallStack,
    Time :> es,
    ToLogStr msg
  ) =>
  -- | Formatter to use.
  LogFormatter ->
  -- | The level in which to log.
  LogLevel ->
  -- | Message.
  msg ->
  -- | Formatted LogStr.
  Eff es LogStr
formatLog :: forall msg (es :: [(* -> *) -> * -> *]).
(Concurrent :> es, HasCallStack, Time :> es, ToLogStr msg) =>
LogFormatter -> LogLevel -> msg -> Eff es LogStr
formatLog = Maybe Namespace -> LogFormatter -> LogLevel -> msg -> Eff es LogStr
forall (es :: [(* -> *) -> * -> *]) msg.
(Concurrent :> es, HasCallStack, Time :> es, ToLogStr msg) =>
Maybe Namespace -> LogFormatter -> LogLevel -> msg -> Eff es LogStr
Utils.formatLog Maybe Namespace
forall a. Maybe a
Nothing

-- | @since 0.1
logTH :: LogLevel -> Q Exp
logTH :: LogLevel -> Q Exp
logTH LogLevel
level =
  [|
    loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) (pack "") $(LogLevel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => LogLevel -> m Exp
lift LogLevel
level)
      . (id :: Text -> Text)
    |]

-- | Generates a function that takes a 'LogLevel' and a 'Show a => a'.
--
-- @since 0.1
logTHShow :: LogLevel -> Q Exp
logTHShow :: LogLevel -> Q Exp
logTHShow LogLevel
level =
  [|
    loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) (pack "") $(LogLevel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => LogLevel -> m Exp
lift LogLevel
level)
      . ((pack . show) :: (Show a) => a -> Text)
    |]

-- | See 'logDebug'
--
-- @since 0.1
logTrace :: Q Exp
logTrace :: Q Exp
logTrace = LogLevel -> Q Exp
logTH LogLevel
LevelTrace

-- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message.
-- Usage:
--
-- > $(logDebug) "This is a debug log message"
--
-- @since 0.1
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = LogLevel -> Q Exp
logTH LogLevel
LevelDebug

-- | See 'logDebug'
--
-- @since 0.1
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = LogLevel -> Q Exp
logTH LogLevel
LevelInfo

-- | See 'logDebug'
--
-- @since 0.1
logWarn :: Q Exp
logWarn :: Q Exp
logWarn = LogLevel -> Q Exp
logTH LogLevel
LevelWarn

-- | See 'logDebug'
--
-- @since 0.1
logError :: Q Exp
logError :: Q Exp
logError = LogLevel -> Q Exp
logTH LogLevel
LevelError

-- | See 'logDebug'
--
-- @since 0.1
logFatal :: Q Exp
logFatal :: Q Exp
logFatal = LogLevel -> Q Exp
logTH LogLevel
LevelFatal

-- | Generates a function that takes a 'Text' and logs a 'LevelOther' message.
-- Usage:
--
-- > $(logOther "My new level") "This is a log message"
--
-- @since 0.1
logOther :: Text -> Q Exp
logOther :: Text -> Q Exp
logOther = LogLevel -> Q Exp
logTH (LogLevel -> Q Exp) -> (Text -> LogLevel) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogLevel
LevelOther

-- | See 'logDebugSH'
--
-- @since 0.1
logTraceSH :: Q Exp
logTraceSH :: Q Exp
logTraceSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelTrace

-- | Generates a function that takes a 'Show a => a' and logs a 'LevelDebug'
-- message. Usage:
--
-- > $(logDebugSH) (Just "This is a debug log message")
--
-- @since 0.1
logDebugSH :: Q Exp
logDebugSH :: Q Exp
logDebugSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelDebug

-- | See 'logDebugSH'
--
-- @since 0.1
logInfoSH :: Q Exp
logInfoSH :: Q Exp
logInfoSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelInfo

-- | See 'logDebugSH'
--
-- @since 0.1
logWarnSH :: Q Exp
logWarnSH :: Q Exp
logWarnSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelWarn

-- | See 'logDebugSH'
--
-- @since 0.1
logErrorSH :: Q Exp
logErrorSH :: Q Exp
logErrorSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelError

-- | See 'logDebugSH'
--
-- @since 0.1
logFatalSH :: Q Exp
logFatalSH :: Q Exp
logFatalSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelFatal

-- | Generates a function that takes a 'Show a => a' and logs a 'LevelOther'
-- message. Usage:
--
-- > $(logOtherSH "My new level") "This is a log message"
--
-- @since 0.1
logOtherSH :: Text -> Q Exp
logOtherSH :: Text -> Q Exp
logOtherSH = LogLevel -> Q Exp
logTHShow (LogLevel -> Q Exp) -> (Text -> LogLevel) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogLevel
LevelOther

-- | Lift a location into an Exp.
--
-- @since 0.1
liftLoc :: Loc -> Q Exp
liftLoc :: Loc -> Q Exp
liftLoc (Loc String
a String
b String
c (Int
d1, Int
d2) (Int
e1, Int
e2)) =
  [|
    Loc
      $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
a)
      $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
b)
      $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
c)
      ($(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
d1), $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
d2))
      ($(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
e1), $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
e2))
    |]

-- | See 'logDebugS'
--
-- @since 0.1
logTraceS :: Q Exp
logTraceS :: Q Exp
logTraceS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelTrace (b :: Text)|]

-- | Generates a function that takes a 'LogSource' and 'Text' and logs a
-- 'LevelDebug' message. Usage:
--
-- > $logDebugS "SomeSource" "This is a debug log message"
--
-- @since 0.1
logDebugS :: Q Exp
logDebugS :: Q Exp
logDebugS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelDebug (b :: Text)|]

-- | See 'logDebugS'
--
-- @since 0.1
logInfoS :: Q Exp
logInfoS :: Q Exp
logInfoS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelInfo (b :: Text)|]

-- | See 'logDebugS'
--
-- @since 0.1
logWarnS :: Q Exp
logWarnS :: Q Exp
logWarnS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelWarn (b :: Text)|]

-- | See 'logDebugS'
--
-- @since 0.1
logErrorS :: Q Exp
logErrorS :: Q Exp
logErrorS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelError (b :: Text)|]

-- | See 'logDebugS'
--
-- @since 0.1
logFatalS :: Q Exp
logFatalS :: Q Exp
logFatalS =
  [|\a b -> loggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelFatal (b :: Text)|]

-- | Generates a function that takes a 'LogSource', a level name and a 'Text'
-- and logs a 'LevelOther' message. Usage:
--
-- > $logOtherS "SomeSource" "My new level" "This is a log message"
--
-- @since 0.1
logOtherS :: Q Exp
logOtherS :: Q Exp
logOtherS =
  [|
    \src level msg ->
      loggerLog
        $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc)
        src
        (LevelOther level)
        (msg :: Text)
    |]

-- | @since 0.1
type LogLine = (Loc, LogSource, LogLevel, LogStr)

-- | A default implementation of 'loggerLog' that accepts a file
-- handle as the first argument.
--
-- This is used in the definition of 'runStdoutLoggingT':
--
-- @
-- 'runStdoutLoggingT' :: 'MonadIO' m => 'LoggingT' m a -> m a
-- 'runStdoutLoggingT' action =
--     'runLoggingT' action ('defaultOutput' 'stdout')
-- @
--
-- @since 0.1
defaultOutput ::
  (HasCallStack) =>
  Handle ->
  Loc ->
  LogSource ->
  LogLevel ->
  LogStr ->
  IO ()
defaultOutput :: HasCallStack =>
Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
h Loc
loc Text
src LogLevel
level LogStr
msg =
  Handle -> ByteString -> IO ()
S8.hPutStr Handle
h ByteString
ls
  where
    ls :: ByteString
ls = Loc -> Text -> LogLevel -> LogStr -> ByteString
defaultLogStrBS Loc
loc Text
src LogLevel
level LogStr
msg

-- | @since 0.1
defaultLogStrBS ::
  Loc ->
  LogSource ->
  LogLevel ->
  LogStr ->
  ByteString
defaultLogStrBS :: Loc -> Text -> LogLevel -> LogStr -> ByteString
defaultLogStrBS Loc
a Text
b LogLevel
c LogStr
d = LogStr -> ByteString
fromLogStr (LogStr -> ByteString) -> LogStr -> ByteString
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
a Text
b LogLevel
c LogStr
d

-- | @since 0.1
defaultLogLevelStr :: LogLevel -> LogStr
defaultLogLevelStr :: LogLevel -> LogStr
defaultLogLevelStr LogLevel
level = case LogLevel
level of
  LevelOther Text
t -> Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
t
  LogLevel
_ -> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr) -> ByteString -> LogStr
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ LogLevel -> String
forall a. Show a => a -> String
show LogLevel
level

-- | @since 0.1
defaultLogStr ::
  Loc ->
  LogSource ->
  LogLevel ->
  LogStr ->
  LogStr
defaultLogStr :: Loc -> Text -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
loc Text
src LogLevel
level LogStr
msg =
  LogStr
"["
    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogLevel -> LogStr
defaultLogLevelStr LogLevel
level
    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ( if Text -> Bool
T.null Text
src
           then LogStr
forall a. Monoid a => a
mempty
           else LogStr
"#" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
src
       )
    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"] "
    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg
    LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ( if Loc -> Bool
isDefaultLoc Loc
loc
           then LogStr
"\n"
           else
             LogStr
" @("
               LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> ByteString
S8.pack String
fileLocStr)
               LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
")\n"
       )
  where
    -- taken from file-location package
    -- turn the TH Loc loaction information into a human readable string
    -- leaving out the loc_end parameter
    fileLocStr :: String
fileLocStr =
      Loc -> String
loc_package Loc
loc
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'
        Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
loc_module Loc
loc
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
' '
        Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
loc_filename Loc
loc
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'
        Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
line Loc
loc
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'
        Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
char Loc
loc
      where
        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
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
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
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start

-- | dummy location, used with 'logWithoutLoc'
--
-- @since 0.1
defaultLoc :: Loc
defaultLoc :: Loc
defaultLoc = String -> String -> String -> (Int, Int) -> (Int, Int) -> Loc
Loc String
"<unknown>" String
"<unknown>" String
"<unknown>" (Int
0, Int
0) (Int
0, Int
0)

-- | @since 0.1
isDefaultLoc :: Loc -> Bool
isDefaultLoc :: Loc -> Bool
isDefaultLoc (Loc String
"<unknown>" String
"<unknown>" String
"<unknown>" (Int
0, Int
0) (Int
0, Int
0)) = Bool
True
isDefaultLoc Loc
_ = Bool
False

-- | @since 0.1
logWithoutLoc ::
  ( HasCallStack,
    Logger :> es,
    ToLogStr msg
  ) =>
  LogSource ->
  LogLevel ->
  msg ->
  Eff es ()
logWithoutLoc :: forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc = Loc -> Text -> LogLevel -> msg -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> Eff es ()
loggerLog Loc
defaultLoc

-- | @since 0.1
logTraceN :: (Logger :> es) => Text -> Eff es ()
logTraceN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logTraceN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelTrace

-- | @since 0.1
logDebugN :: (Logger :> es) => Text -> Eff es ()
logDebugN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logDebugN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelDebug

-- | @since 0.1
logInfoN :: (Logger :> es) => Text -> Eff es ()
logInfoN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logInfoN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelInfo

-- | @since 0.1
logWarnN :: (Logger :> es) => Text -> Eff es ()
logWarnN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logWarnN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelWarn

-- | @since 0.1
logErrorN :: (Logger :> es) => Text -> Eff es ()
logErrorN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logErrorN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelError

-- | @since 0.1
logFatalN :: (Logger :> es) => Text -> Eff es ()
logFatalN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Eff es ()
logFatalN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
"" LogLevel
LevelFatal

-- | @since 0.1
logOtherN :: (Logger :> es) => LogLevel -> Text -> Eff es ()
logOtherN :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
LogLevel -> Text -> Eff es ()
logOtherN = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
""

-- | @since 0.1
logTraceNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logTraceNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logTraceNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelTrace

-- | @since 0.1
logDebugNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logDebugNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logDebugNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelDebug

-- | @since 0.1
logInfoNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logInfoNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logInfoNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelInfo

-- | @since 0.1
logWarnNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logWarnNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logWarnNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelWarn

-- | @since 0.1
logErrorNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logErrorNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logErrorNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelError

-- | @since 0.1
logFatalNS :: (Logger :> es) => LogSource -> Text -> Eff es ()
logFatalNS :: forall (es :: [(* -> *) -> * -> *]).
(Logger :> es) =>
Text -> Text -> Eff es ()
logFatalNS Text
src = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc Text
src LogLevel
LevelFatal

-- | @since 0.1
logOtherNS ::
  (HasCallStack, Logger :> es) =>
  LogSource ->
  LogLevel ->
  Text ->
  Eff es ()
logOtherNS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
Text -> LogLevel -> Text -> Eff es ()
logOtherNS = Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Text -> LogLevel -> msg -> Eff es ()
logWithoutLoc

-- | @since 0.1
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc =
  Loc
    { loc_filename :: String
loc_filename = SrcLoc -> String
srcLocFile SrcLoc
loc,
      loc_package :: String
loc_package = SrcLoc -> String
srcLocPackage SrcLoc
loc,
      loc_module :: String
loc_module = SrcLoc -> String
srcLocModule SrcLoc
loc,
      loc_start :: (Int, Int)
loc_start =
        ( SrcLoc -> Int
srcLocStartLine SrcLoc
loc,
          SrcLoc -> Int
srcLocStartCol SrcLoc
loc
        ),
      loc_end :: (Int, Int)
loc_end =
        ( SrcLoc -> Int
srcLocEndLine SrcLoc
loc,
          SrcLoc -> Int
srcLocEndCol SrcLoc
loc
        )
    }

-- | @since 0.1
locFromCS :: CallStack -> Loc
locFromCS :: CallStack -> Loc
locFromCS CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
  ((String
_, SrcLoc
loc) : [(String, SrcLoc)]
_) -> SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc
  [(String, SrcLoc)]
_ -> Loc
defaultLoc

-- | @since 0.1
logCS ::
  (HasCallStack, Logger :> es, ToLogStr msg) =>
  CallStack ->
  LogSource ->
  LogLevel ->
  msg ->
  Eff es ()
logCS :: forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs = Loc -> Text -> LogLevel -> msg -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> Eff es ()
loggerLog (CallStack -> Loc
locFromCS CallStack
cs)

-- | See 'logDebugCS'
--
-- @since 0.1
logTraceCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logTraceCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logTraceCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelTrace

-- | Logs a message with location given by 'CallStack'.
-- See 'Control.Monad.Logger.CallStack' for more convenient
-- functions for 'CallStack' based logging.
--
-- @since 0.1
logDebugCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logDebugCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logDebugCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelDebug

-- | See 'logDebugCS'
--
-- @since 0.1
logInfoCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logInfoCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logInfoCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelInfo

-- | See 'logDebugCS'
--
-- @since 0.1
logWarnCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logWarnCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logWarnCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelWarn

-- | See 'logDebugCS'
--
-- @since 0.1
logErrorCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logErrorCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logErrorCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelError

-- | See 'logDebugCS'
--
-- @since 0.1
logFatalCS :: (HasCallStack, Logger :> es) => CallStack -> Text -> Eff es ()
logFatalCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> Text -> Eff es ()
logFatalCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
"" LogLevel
LevelFatal

-- | See 'logDebugCS'
--
-- @since 0.1
logOtherCS ::
  (HasCallStack, Logger :> es) =>
  CallStack ->
  LogLevel ->
  Text ->
  Eff es ()
logOtherCS :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, Logger :> es) =>
CallStack -> LogLevel -> Text -> Eff es ()
logOtherCS CallStack
cs = CallStack -> Text -> LogLevel -> Text -> Eff es ()
forall (es :: [(* -> *) -> * -> *]) msg.
(HasCallStack, Logger :> es, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> Eff es ()
logCS CallStack
cs Text
""

{- HLINT ignore "Eta reduce" -}

-- | @guardLevel configLvl lvl m@ runs @m@ iff @'shouldLog' configLvl lvl@.
--
-- @since 0.1
guardLevel ::
  (Applicative f, HasCallStack) =>
  -- | The configured log level to check against.
  LogLevel ->
  -- | The log level for this action.
  LogLevel ->
  -- | The logging action to run if the level passes.
  ((HasCallStack) => f ()) ->
  f ()
guardLevel :: forall (f :: * -> *).
(Applicative f, HasCallStack) =>
LogLevel -> LogLevel -> (HasCallStack => f ()) -> f ()
guardLevel LogLevel
configLvl LogLevel
lvl HasCallStack => f ()
logAction =
  -- NOTE: No eta reduction, presumably related to DeepSubsumption
  Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel -> LogLevel -> Bool
shouldLog LogLevel
configLvl LogLevel
lvl) f ()
HasCallStack => f ()
logAction

-- | @shouldLog configLvl lvl@ returns true iff @configLvl <= lvl@. Uses
-- LogLevel's built-in ordering. The ordering is thus:
--
-- @
--   LevelTrace
--     < LevelDebug
--     < LevelInfo
--     < LevelWarn
--     < LevelError
--     < LevelFatal
--     < LevelOther \"\<any\>\"
-- @
--
-- In other words, 'LogLevel''s usual 'Ord' is respected. Note that
-- @LevelOther "custom"@ sits at the the highest level and compares via
-- Text's 'Ord', just like 'LogLevel''s usual 'Ord'.
--
-- @since 0.1
shouldLog ::
  -- | The configured log level to check against.
  LogLevel ->
  -- | Level for this log
  LogLevel ->
  -- | Whether we should log
  Bool
shouldLog :: LogLevel -> LogLevel -> Bool
shouldLog = LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

-- | @since 0.1
_LevelTrace :: Prism' LogLevel ()
_LevelTrace :: Prism' LogLevel ()
_LevelTrace =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelTrace)
    ( \case
        LogLevel
LevelTrace -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelTrace #-}

-- | @since 0.1
_LevelDebug :: Prism' LogLevel ()
_LevelDebug :: Prism' LogLevel ()
_LevelDebug =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelDebug)
    ( \case
        LogLevel
LevelDebug -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelDebug #-}

-- | @since 0.1
_LevelInfo :: Prism' LogLevel ()
_LevelInfo :: Prism' LogLevel ()
_LevelInfo =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelInfo)
    ( \case
        LogLevel
LevelInfo -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelInfo #-}

-- | @since 0.1
_LevelWarn :: Prism' LogLevel ()
_LevelWarn :: Prism' LogLevel ()
_LevelWarn =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelWarn)
    ( \case
        LogLevel
LevelWarn -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelWarn #-}

-- | @since 0.1
_LevelError :: Prism' LogLevel ()
_LevelError :: Prism' LogLevel ()
_LevelError =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelError)
    ( \case
        LogLevel
LevelError -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelError #-}

-- | @since 0.1
_LevelOther :: Prism' LogLevel Text
_LevelOther :: Prism' LogLevel Text
_LevelOther =
  (Text -> LogLevel)
-> (LogLevel -> Either LogLevel Text) -> Prism' LogLevel Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    Text -> LogLevel
LevelOther
    ( \case
        LevelOther Text
l -> Text -> Either LogLevel Text
forall a b. b -> Either a b
Right Text
l
        LogLevel
other -> LogLevel -> Either LogLevel Text
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelOther #-}

-- | @since 0.1
_LevelFatal :: Prism' LogLevel ()
_LevelFatal :: Prism' LogLevel ()
_LevelFatal =
  (() -> LogLevel)
-> (LogLevel -> Either LogLevel ()) -> Prism' LogLevel ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LogLevel -> () -> LogLevel
forall a b. a -> b -> a
const LogLevel
LevelFatal)
    ( \case
        LogLevel
LevelFatal -> () -> Either LogLevel ()
forall a b. b -> Either a b
Right ()
        LogLevel
other -> LogLevel -> Either LogLevel ()
forall a b. a -> Either a b
Left LogLevel
other
    )
{-# INLINE _LevelFatal #-}