{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Internal utilities.
--
-- @since 0.1
module Effects.Logger.Utils
  ( -- * Namespace
    Namespace (..),

    -- ** Logging functions

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

    -- * LogStr
    logStrToBs,
    logStrToText,
  )
where

import Control.DeepSeq (NFData)
import Control.Monad.Logger
  ( Loc (Loc),
    LogLevel (LevelDebug, LevelError, LevelInfo, LevelOther, LevelWarn),
    LogStr,
    ToLogStr (toLogStr),
  )
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Foldable (Foldable (foldMap'))
#if MIN_VERSION_base(4, 18, 0)
import Data.Functor ((<&>))
#endif
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.String (IsString (fromString))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TEnc
import Data.Text.Encoding.Error qualified as TEncError
import Effects.Concurrent.Thread (MonadThread)
import Effects.Concurrent.Thread qualified as Thread
import Effects.Time (MonadTime (getSystemZonedTime), getSystemTime)
import Effects.Time qualified as MonadTime
import GHC.Exts (IsList (Item, fromList, toList))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Language.Haskell.TH (Loc (loc_filename, loc_start))
import Optics.Core
  ( A_Lens,
    An_Iso,
    LabelOptic (labelOptic),
    iso,
    lensVL,
    view,
    (^.),
  )
import System.Log.FastLogger qualified as FL

-- | Logging namespace.
--
-- @since 0.1
newtype Namespace = MkNamespace
  { -- | @since 0.1
    Namespace -> Seq Text
unNamespace :: Seq Text
  }
  deriving stock
    ( -- | @since 0.1
      Namespace -> Namespace -> Bool
(Namespace -> Namespace -> Bool)
-> (Namespace -> Namespace -> Bool) -> Eq Namespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
/= :: Namespace -> Namespace -> Bool
Eq,
      -- | @since 0.1
      (forall x. Namespace -> Rep Namespace x)
-> (forall x. Rep Namespace x -> Namespace) -> Generic Namespace
forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Namespace -> Rep Namespace x
from :: forall x. Namespace -> Rep Namespace x
$cto :: forall x. Rep Namespace x -> Namespace
to :: forall x. Rep Namespace x -> Namespace
Generic,
      -- | @since 0.1
      Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Namespace -> ShowS
showsPrec :: Int -> Namespace -> ShowS
$cshow :: Namespace -> String
show :: Namespace -> String
$cshowList :: [Namespace] -> ShowS
showList :: [Namespace] -> ShowS
Show
    )
  deriving
    ( -- | @since 0.1
      Semigroup Namespace
Namespace
Semigroup Namespace =>
Namespace
-> (Namespace -> Namespace -> Namespace)
-> ([Namespace] -> Namespace)
-> Monoid Namespace
[Namespace] -> Namespace
Namespace -> Namespace -> Namespace
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Namespace
mempty :: Namespace
$cmappend :: Namespace -> Namespace -> Namespace
mappend :: Namespace -> Namespace -> Namespace
$cmconcat :: [Namespace] -> Namespace
mconcat :: [Namespace] -> Namespace
Monoid,
      -- | @since 0.1
      NonEmpty Namespace -> Namespace
Namespace -> Namespace -> Namespace
(Namespace -> Namespace -> Namespace)
-> (NonEmpty Namespace -> Namespace)
-> (forall b. Integral b => b -> Namespace -> Namespace)
-> Semigroup Namespace
forall b. Integral b => b -> Namespace -> Namespace
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Namespace -> Namespace -> Namespace
<> :: Namespace -> Namespace -> Namespace
$csconcat :: NonEmpty Namespace -> Namespace
sconcat :: NonEmpty Namespace -> Namespace
$cstimes :: forall b. Integral b => b -> Namespace -> Namespace
stimes :: forall b. Integral b => b -> Namespace -> Namespace
Semigroup
    )
    via (Seq Text)
  deriving anyclass
    ( -- | @since 0.1
      Namespace -> ()
(Namespace -> ()) -> NFData Namespace
forall a. (a -> ()) -> NFData a
$crnf :: Namespace -> ()
rnf :: Namespace -> ()
NFData
    )

-- | @since 0.1
instance
  (k ~ An_Iso, a ~ Seq Text, b ~ Seq Text) =>
  LabelOptic "unNamespace" k Namespace Namespace a b
  where
  labelOptic :: Optic k NoIx Namespace Namespace a b
labelOptic = (Namespace -> a) -> (b -> Namespace) -> Iso Namespace Namespace a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(MkNamespace Seq Text
ns) -> a
Seq Text
ns) b -> Namespace
Seq Text -> Namespace
MkNamespace
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance IsString Namespace where
  fromString :: String -> Namespace
fromString = Seq Text -> Namespace
MkNamespace (Seq Text -> Namespace)
-> (String -> Seq Text) -> String -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Seq Text
forall a. a -> Seq a
Seq.singleton (Text -> Seq Text) -> (String -> Text) -> String -> Seq Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  {-# INLINEABLE fromString #-}

-- | @since 0.1
instance IsList Namespace where
  type Item Namespace = Text
  fromList :: [Item Namespace] -> Namespace
fromList = Seq Text -> Namespace
MkNamespace (Seq Text -> Namespace)
-> ([Text] -> Seq Text) -> [Text] -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item (Seq Text)] -> Seq Text
[Text] -> Seq Text
forall l. IsList l => [Item l] -> l
fromList
  {-# INLINEABLE fromList #-}
  toList :: Namespace -> [Item Namespace]
toList = Seq Text -> [Item (Seq Text)]
Seq Text -> [Text]
forall l. IsList l => l -> [Item l]
toList (Seq Text -> [Text])
-> (Namespace -> Seq Text) -> Namespace -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> Seq Text
unNamespace
  {-# INLINEABLE toList #-}

displayNamespace :: Namespace -> Text
displayNamespace :: Namespace -> Text
displayNamespace =
  (Text -> Text) -> Seq Text -> Text
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' Text -> Text
forall a. a -> a
id
    (Seq Text -> Text) -> (Namespace -> Seq Text) -> Namespace -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Seq Text -> Seq Text
forall a. a -> Seq a -> Seq a
Seq.intersperse Text
"."
    (Seq Text -> Seq Text)
-> (Namespace -> Seq Text) -> Namespace -> Seq Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso NoIx Namespace (Seq Text) -> Namespace -> Seq Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx Namespace (Seq Text)
#unNamespace

-- | Determines how we log location data.
--
-- @since 0.1
data LocStrategy
  = -- | Logs the location with filename, line, col.
    --
    -- @since 0.1
    LocPartial !Loc
  | -- | Logs the location with filename.
    --
    -- @since 0.1
    LocStable !Loc
  | -- | No location logging.
    --
    -- @since 0.1
    LocNone
  deriving stock
    ( -- | @since 0.1
      LocStrategy -> LocStrategy -> Bool
(LocStrategy -> LocStrategy -> Bool)
-> (LocStrategy -> LocStrategy -> Bool) -> Eq LocStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocStrategy -> LocStrategy -> Bool
== :: LocStrategy -> LocStrategy -> Bool
$c/= :: LocStrategy -> LocStrategy -> Bool
/= :: LocStrategy -> LocStrategy -> Bool
Eq,
      -- | @since 0.1
      (forall x. LocStrategy -> Rep LocStrategy x)
-> (forall x. Rep LocStrategy x -> LocStrategy)
-> Generic LocStrategy
forall x. Rep LocStrategy x -> LocStrategy
forall x. LocStrategy -> Rep LocStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocStrategy -> Rep LocStrategy x
from :: forall x. LocStrategy -> Rep LocStrategy x
$cto :: forall x. Rep LocStrategy x -> LocStrategy
to :: forall x. Rep LocStrategy x -> LocStrategy
Generic,
      -- | @since 0.1
      Int -> LocStrategy -> ShowS
[LocStrategy] -> ShowS
LocStrategy -> String
(Int -> LocStrategy -> ShowS)
-> (LocStrategy -> String)
-> ([LocStrategy] -> ShowS)
-> Show LocStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocStrategy -> ShowS
showsPrec :: Int -> LocStrategy -> ShowS
$cshow :: LocStrategy -> String
show :: LocStrategy -> String
$cshowList :: [LocStrategy] -> ShowS
showList :: [LocStrategy] -> ShowS
Show
    )

-- | Formatter for logs.
--
-- @since 0.1
data LogFormatter = MkLogFormatter
  { -- | How to log the code location.
    --
    -- @since 0.1
    LogFormatter -> LocStrategy
locStrategy :: !LocStrategy,
    -- | If true, append a newline.
    --
    -- @since 0.1
    LogFormatter -> Bool
newline :: !Bool,
    -- | Whether to include the thread's label set by 'Thread.labelThread'.
    -- Falls back to the thread's 'Thread.ThreadId' when the label has not been set.
    --
    -- @since 0.1
    LogFormatter -> Bool
threadLabel :: !Bool,
    -- | Whether to include the timezone in the timestamp.
    --
    -- @since 0.1
    LogFormatter -> Bool
timezone :: !Bool
  }
  deriving stock
    ( -- | @since 0.1
      LogFormatter -> LogFormatter -> Bool
(LogFormatter -> LogFormatter -> Bool)
-> (LogFormatter -> LogFormatter -> Bool) -> Eq LogFormatter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogFormatter -> LogFormatter -> Bool
== :: LogFormatter -> LogFormatter -> Bool
$c/= :: LogFormatter -> LogFormatter -> Bool
/= :: LogFormatter -> LogFormatter -> Bool
Eq,
      -- | @since 0.1
      (forall x. LogFormatter -> Rep LogFormatter x)
-> (forall x. Rep LogFormatter x -> LogFormatter)
-> Generic LogFormatter
forall x. Rep LogFormatter x -> LogFormatter
forall x. LogFormatter -> Rep LogFormatter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LogFormatter -> Rep LogFormatter x
from :: forall x. LogFormatter -> Rep LogFormatter x
$cto :: forall x. Rep LogFormatter x -> LogFormatter
to :: forall x. Rep LogFormatter x -> LogFormatter
Generic,
      -- | @since 0.1
      Int -> LogFormatter -> ShowS
[LogFormatter] -> ShowS
LogFormatter -> String
(Int -> LogFormatter -> ShowS)
-> (LogFormatter -> String)
-> ([LogFormatter] -> ShowS)
-> Show LogFormatter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogFormatter -> ShowS
showsPrec :: Int -> LogFormatter -> ShowS
$cshow :: LogFormatter -> String
show :: LogFormatter -> String
$cshowList :: [LogFormatter] -> ShowS
showList :: [LogFormatter] -> ShowS
Show
    )

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ LocStrategy, b ~ LocStrategy) =>
  LabelOptic "locStrategy" k LogFormatter LogFormatter a b
  where
  labelOptic :: Optic k NoIx LogFormatter LogFormatter a b
labelOptic =
    LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL LogFormatter LogFormatter a b
 -> Lens LogFormatter LogFormatter a b)
-> LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkLogFormatter LocStrategy
a1 Bool
a2 Bool
a3 Bool
a4) ->
      (LocStrategy -> LogFormatter) -> f LocStrategy -> f LogFormatter
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\LocStrategy
b -> LocStrategy -> Bool -> Bool -> Bool -> LogFormatter
MkLogFormatter LocStrategy
b Bool
a2 Bool
a3 Bool
a4)
        (a -> f b
f a
LocStrategy
a1)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Bool, b ~ Bool) =>
  LabelOptic "newline" k LogFormatter LogFormatter a b
  where
  labelOptic :: Optic k NoIx LogFormatter LogFormatter a b
labelOptic =
    LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL LogFormatter LogFormatter a b
 -> Lens LogFormatter LogFormatter a b)
-> LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkLogFormatter LocStrategy
a1 Bool
a2 Bool
a3 Bool
a4) ->
      (Bool -> LogFormatter) -> f Bool -> f LogFormatter
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\Bool
b -> LocStrategy -> Bool -> Bool -> Bool -> LogFormatter
MkLogFormatter LocStrategy
a1 Bool
b Bool
a3 Bool
a4)
        (a -> f b
f a
Bool
a2)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Bool, b ~ Bool) =>
  LabelOptic "threadLabel" k LogFormatter LogFormatter a b
  where
  labelOptic :: Optic k NoIx LogFormatter LogFormatter a b
labelOptic =
    LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL LogFormatter LogFormatter a b
 -> Lens LogFormatter LogFormatter a b)
-> LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkLogFormatter LocStrategy
a1 Bool
a2 Bool
a3 Bool
a4) ->
      (Bool -> LogFormatter) -> f Bool -> f LogFormatter
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\Bool
b -> LocStrategy -> Bool -> Bool -> Bool -> LogFormatter
MkLogFormatter LocStrategy
a1 Bool
a2 Bool
b Bool
a4)
        (a -> f b
f a
Bool
a3)
  {-# INLINE labelOptic #-}

-- | @since 0.1
instance
  (k ~ A_Lens, a ~ Bool, b ~ Bool) =>
  LabelOptic "timezone" k LogFormatter LogFormatter a b
  where
  labelOptic :: Optic k NoIx LogFormatter LogFormatter a b
labelOptic =
    LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL LogFormatter LogFormatter a b
 -> Lens LogFormatter LogFormatter a b)
-> LensVL LogFormatter LogFormatter a b
-> Lens LogFormatter LogFormatter a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkLogFormatter LocStrategy
a1 Bool
a2 Bool
a3 Bool
a4) ->
      (Bool -> LogFormatter) -> f Bool -> f LogFormatter
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (\Bool
b -> LocStrategy -> Bool -> Bool -> Bool -> LogFormatter
MkLogFormatter LocStrategy
a1 Bool
a2 Bool
a3 Bool
b)
        (a -> f b
f a
Bool
a4)
  {-# INLINE labelOptic #-}

-- | 'LogFormatter' with:
--
-- @
-- locStrategy = 'LocPartial' loc
-- newline = 'True'
-- threadLabel = 'False'
-- timezone = 'False'
-- @
--
-- @since 0.1
defaultLogFormatter :: Loc -> LogFormatter
defaultLogFormatter :: Loc -> LogFormatter
defaultLogFormatter Loc
loc =
  MkLogFormatter
    { locStrategy :: LocStrategy
locStrategy = Loc -> LocStrategy
LocPartial Loc
loc,
      newline :: Bool
newline = Bool
True,
      threadLabel :: Bool
threadLabel = Bool
False,
      timezone :: Bool
timezone = Bool
False
    }

-- | Produces a formatted 'LogStr'.
--
-- __Example__
--
-- @
-- -- [timestamp][thread_label][namespace][code_loc][level] msg
-- [2022-02-08 10:20:05][thread-label][one.two][filename:1:2][Warn] msg
-- @
--
-- @since 0.1
formatLog ::
  ( HasCallStack,
    MonadThread m,
    MonadTime m,
    ToLogStr msg
  ) =>
  -- | Possible namespace.
  Maybe Namespace ->
  -- | Formatter to use.
  LogFormatter ->
  -- | The level in which to log.
  LogLevel ->
  -- | Message.
  msg ->
  -- | Formatted LogStr.
  m LogStr
formatLog :: forall (m :: * -> *) msg.
(HasCallStack, MonadThread m, MonadTime m, ToLogStr msg) =>
Maybe Namespace -> LogFormatter -> LogLevel -> msg -> m LogStr
formatLog Maybe Namespace
mNamespace LogFormatter
formatter LogLevel
lvl msg
msg = do
  timestampTxt <- m LogStr
timeFn
  let namespaceTxt = case Maybe Namespace
mNamespace of
        Maybe Namespace
Nothing -> LogStr
""
        Just Namespace
namespace -> LogStr -> LogStr
brackets (LogStr -> LogStr) -> LogStr -> LogStr
forall a b. (a -> b) -> a -> b
$ Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Text -> LogStr) -> Text -> LogStr
forall a b. (a -> b) -> a -> b
$ Namespace -> Text
displayNamespace Namespace
namespace
  threadLabel <-
    if formatter ^. #threadLabel
      then getThreadLabel
      else pure ""
  let locTxt = case LogFormatter
formatter LogFormatter
-> Optic' A_Lens NoIx LogFormatter LocStrategy -> LocStrategy
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx LogFormatter LocStrategy
#locStrategy of
        LocPartial Loc
loc -> (LogStr -> LogStr
brackets (LogStr -> LogStr) -> (Loc -> LogStr) -> Loc -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Builder -> LogStr) -> (Loc -> Builder) -> Loc -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Builder
partialLoc) Loc
loc
        LocStable Loc
loc -> (LogStr -> LogStr
brackets (LogStr -> LogStr) -> (Loc -> LogStr) -> Loc -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Builder -> LogStr) -> (Loc -> Builder) -> Loc -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> Builder
stableLoc) Loc
loc
        LocStrategy
LocNone -> LogStr
""
      lvlTxt = Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Text -> LogStr) -> Text -> LogStr
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text
showLevel LogLevel
lvl
      msgTxt = msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg
      newline'
        | LogFormatter
formatter LogFormatter -> Optic' A_Lens NoIx LogFormatter Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx LogFormatter Bool
#newline = LogStr
"\n"
        | Bool
otherwise = LogStr
""
      formatted =
        [LogStr] -> LogStr
forall a. Monoid a => [a] -> a
mconcat
          [ LogStr -> LogStr
brackets LogStr
timestampTxt,
            LogStr
threadLabel,
            LogStr
namespaceTxt,
            LogStr
locTxt,
            LogStr -> LogStr
brackets LogStr
lvlTxt,
            LogStr
" ",
            LogStr
msgTxt,
            LogStr
newline'
          ]
  pure formatted
  where
    timeFn :: m LogStr
timeFn =
      if LogFormatter
formatter LogFormatter -> Optic' A_Lens NoIx LogFormatter Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx LogFormatter Bool
#timezone
        then String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> LogStr) -> (ZonedTime -> String) -> ZonedTime -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> String
MonadTime.formatZonedTime (ZonedTime -> LogStr) -> m ZonedTime -> m LogStr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ZonedTime
forall (m :: * -> *). (MonadTime m, HasCallStack) => m ZonedTime
getSystemZonedTime
        else String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> LogStr) -> (LocalTime -> String) -> LocalTime -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> String
MonadTime.formatLocalTime (LocalTime -> LogStr) -> m LocalTime -> m LogStr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LocalTime
forall (m :: * -> *). (HasCallStack, MonadTime m) => m LocalTime
getSystemTime
{-# INLINEABLE formatLog #-}

{- ORMOLU_DISABLE -}

-- | Retrieves the thread label or thread id, if the former has not been set.
getThreadLabel :: (HasCallStack, MonadThread m) => m LogStr
getThreadLabel :: forall (m :: * -> *). (HasCallStack, MonadThread m) => m LogStr
getThreadLabel = do
#if MIN_VERSION_base(4, 18, 0)
  tid <- m ThreadId
forall (m :: * -> *). (MonadThread m, HasCallStack) => m ThreadId
Thread.myThreadId
  Thread.threadLabel tid <&> \case
    Just String
label -> String -> LogStr
bracketsLogStr String
label
    Maybe String
Nothing -> String -> LogStr
bracketsLogStr (String -> LogStr) -> String -> LogStr
forall a b. (a -> b) -> a -> b
$ ThreadId -> String
forall a. Show a => a -> String
show ThreadId
tid
#else
  bracketsLogStr . show <$> Thread.myThreadId
#endif
  where
    bracketsLogStr :: String -> LogStr
bracketsLogStr = LogStr -> LogStr
brackets (LogStr -> LogStr) -> (String -> LogStr) -> String -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr
{-# INLINEABLE getThreadLabel #-}

{- ORMOLU_ENABLE -}

partialLoc :: Loc -> Builder
partialLoc :: Loc -> Builder
partialLoc Loc {String
loc_filename :: Loc -> String
loc_filename :: String
loc_filename, CharPos
loc_start :: Loc -> CharPos
loc_start :: CharPos
loc_start} =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Builder
forall a. IsString a => String -> a
fromString String
loc_filename,
      Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
line,
      Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
char
    ]
  where
    (Int
locLine, Int
locChar) = CharPos
loc_start
    line :: Builder
line = String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
locLine
    char :: Builder
char = String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
locChar

stableLoc :: Loc -> Builder
stableLoc :: Loc -> Builder
stableLoc = String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> (Loc -> String) -> Loc -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx Loc String -> Loc -> String
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Loc String
#loc_filename

showLevel :: LogLevel -> Text
showLevel :: LogLevel -> Text
showLevel LogLevel
LevelDebug = Text
"Debug"
showLevel LogLevel
LevelInfo = Text
"Info"
showLevel LogLevel
LevelWarn = Text
"Warn"
showLevel LogLevel
LevelError = Text
"Error"
showLevel (LevelOther Text
txt) = Text
txt

-- LogStr uses ByteString's Builder internally, so we might as well use it
-- for constants.
brackets :: LogStr -> LogStr
brackets :: LogStr -> LogStr
brackets LogStr
m = Builder -> LogStr
cLogStr Builder
"[" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
m LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> Builder -> LogStr
cLogStr Builder
"]"

cLogStr :: Builder -> LogStr
cLogStr :: Builder -> LogStr
cLogStr = forall msg. ToLogStr msg => msg -> LogStr
toLogStr @Builder

-- | @since 0.1
logStrToBs :: LogStr -> ByteString
logStrToBs :: LogStr -> ByteString
logStrToBs = LogStr -> ByteString
FL.fromLogStr

-- | @since 0.1
logStrToText :: LogStr -> Text
logStrToText :: LogStr -> Text
logStrToText = OnDecodeError -> ByteString -> Text
TEnc.decodeUtf8With OnDecodeError
TEncError.lenientDecode (ByteString -> Text) -> (LogStr -> ByteString) -> LogStr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> ByteString
FL.fromLogStr