{-# LANGUAGE AllowAmbiguousTypes #-}

-- | Provides static namespaced logging functionality on top of
-- 'Effectful.Logger.Dynamic.Logger'.
--
-- @since 0.1
module Effectful.Logger.Namespace
  ( -- * Effect
    Namespace (..),
    addNamespace,

    -- * Constraint aliases
    HasNamespace,
    LoggerNS,

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

    -- * LogStr
    Utils.logStrToBs,
    Utils.logStrToText,

    -- * Optics

    -- ** LocStrategy
    _LocPartial,
    _LocStable,
    _LocNone,
  )
where

import Data.Kind (Constraint, Type)
import Data.Sequence (Seq ((:|>)))
import Data.Text (Text)
import Effectful (Eff, Effect, type (:>))
import Effectful.Concurrent.Static (Concurrent)
import Effectful.Dispatch.Static (HasCallStack)
import Effectful.Logger.Dynamic (LogLevel, LogStr, Logger, ToLogStr)
import Effectful.Logger.Utils
  ( LocStrategy (LocNone, LocPartial, LocStable),
    LogFormatter (locStrategy, newline, threadLabel, timezone),
    Namespace (unNamespace),
  )
import Effectful.Logger.Utils qualified as Utils
import Effectful.Reader.Static (Reader, asks, local)
import Effectful.Time.Dynamic (Time)
import Language.Haskell.TH (Loc)
import Optics.Core
  ( A_Getter,
    A_Setter,
    Is,
    LabelOptic',
    NoIx,
    Optic',
    Prism',
    Setter',
    castOptic,
    over',
    prism,
    view,
    (%),
  )

-- | Alias for constraints required to use namespaces.
type HasNamespace :: Type -> Type -> [Effect] -> Constraint
type HasNamespace env k es =
  ( Is k A_Getter,
    Is k A_Setter,
    LabelOptic' "namespace" k env Namespace,
    Reader env :> es
  )

-- | Alias for HasNamespace and Logger constraint.
type LoggerNS :: Type -> Type -> [Effect] -> Constraint
type LoggerNS env k es = (HasNamespace env k es, Logger :> es, Reader env :> es)

-- | Adds to the namespace.
--
-- @since 0.1
addNamespace ::
  forall env a k es.
  ( Is k A_Setter,
    LabelOptic' "namespace" k env Namespace,
    Reader env :> es
  ) =>
  -- | New namespace.
  Text ->
  Eff es a ->
  Eff es a
addNamespace :: forall env a k (es :: [Effect]).
(Is k A_Setter, LabelOptic' "namespace" k env Namespace,
 Reader env :> es) =>
Text -> Eff es a -> Eff es a
addNamespace Text
txt = (env -> env) -> Eff es a -> Eff es a
forall r (es :: [Effect]) a.
(HasCallStack, Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
local ((Optic A_Setter NoIx env env (Seq Text) (Seq Text)
-> (Seq Text -> Seq Text) -> env -> env
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over' (Optic' k NoIx env Namespace -> Setter' env Namespace
castSet Optic' k NoIx env Namespace
#namespace Setter' env Namespace
-> Optic An_Iso NoIx Namespace Namespace (Seq Text) (Seq Text)
-> Optic A_Setter NoIx env env (Seq Text) (Seq Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx Namespace Namespace (Seq Text) (Seq Text)
#unNamespace) (Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
:|> Text
txt)))
  where
    -- See https://github.com/well-typed/optics/issues/368 for why this is
    -- necessary.
    castSet :: Optic' k NoIx env Namespace -> Setter' env Namespace
    castSet :: Optic' k NoIx env Namespace -> Setter' env Namespace
castSet = forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic @A_Setter @k @_ @env @env @Namespace @Namespace
{-# INLINEABLE addNamespace #-}

-- | Produces a formatted 'LogStr' in terms of:
--
-- - Static Concurrent.
-- - Static Reader.
-- - Dynamic Time.
--
-- __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 ::
  forall env msg k es.
  ( Concurrent :> es,
    Is k A_Getter,
    LabelOptic' "namespace" k env Namespace,
    HasCallStack,
    Reader env :> es,
    Time :> es,
    ToLogStr msg
  ) =>
  -- | Formatter.
  LogFormatter ->
  -- | Log level.
  LogLevel ->
  -- | Message.
  msg ->
  Eff es LogStr
formatLog :: forall env msg k (es :: [Effect]).
(Concurrent :> es, Is k A_Getter,
 LabelOptic' "namespace" k env Namespace, HasCallStack,
 Reader env :> es, Time :> es, ToLogStr msg) =>
LogFormatter -> LogLevel -> msg -> Eff es LogStr
formatLog LogFormatter
formatter LogLevel
lvl msg
msg = do
  namespace <- forall r (es :: [Effect]) a.
(HasCallStack, Reader r :> es) =>
(r -> a) -> Eff es a
asks @env (Optic' k NoIx env Namespace -> env -> Namespace
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' k NoIx env Namespace
#namespace)
  Utils.formatLog (Just namespace) formatter lvl msg

-- | @since 0.1
_LocPartial :: Prism' LocStrategy Loc
_LocPartial :: Prism' LocStrategy Loc
_LocPartial =
  (Loc -> LocStrategy)
-> (LocStrategy -> Either LocStrategy Loc)
-> Prism' LocStrategy Loc
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    Loc -> LocStrategy
LocPartial
    ( \case
        LocPartial Loc
loc -> Loc -> Either LocStrategy Loc
forall a b. b -> Either a b
Right Loc
loc
        LocStrategy
x -> LocStrategy -> Either LocStrategy Loc
forall a b. a -> Either a b
Left LocStrategy
x
    )
{-# INLINE _LocPartial #-}

-- | @since 0.1
_LocStable :: Prism' LocStrategy Loc
_LocStable :: Prism' LocStrategy Loc
_LocStable =
  (Loc -> LocStrategy)
-> (LocStrategy -> Either LocStrategy Loc)
-> Prism' LocStrategy Loc
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    Loc -> LocStrategy
LocStable
    ( \case
        LocStable Loc
loc -> Loc -> Either LocStrategy Loc
forall a b. b -> Either a b
Right Loc
loc
        LocStrategy
x -> LocStrategy -> Either LocStrategy Loc
forall a b. a -> Either a b
Left LocStrategy
x
    )
{-# INLINE _LocStable #-}

-- | @since 0.1
_LocNone :: Prism' LocStrategy ()
_LocNone :: Prism' LocStrategy ()
_LocNone =
  (() -> LocStrategy)
-> (LocStrategy -> Either LocStrategy ()) -> Prism' LocStrategy ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    (LocStrategy -> () -> LocStrategy
forall a b. a -> b -> a
const LocStrategy
LocNone)
    ( \case
        LocStrategy
LocNone -> () -> Either LocStrategy ()
forall a b. b -> Either a b
Right ()
        LocStrategy
x -> LocStrategy -> Either LocStrategy ()
forall a b. a -> Either a b
Left LocStrategy
x
    )
{-# INLINE _LocNone #-}