-- |Smart constructors for @'DataLog' 'LogReport'@
module Ribosome.Report (
  module Ribosome.Report,
  module Ribosome.Host.Effect.Reports,
  module Ribosome.Host.Interpreter.Reports,
  LogReport (LogReport),
  Report (Report),
  ReportContext (ReportContext),
  Reportable (toReport),
) where

import Log (Severity (Error, Info, Warn), dataLog)
import qualified Polysemy.Log as Log

import Ribosome.Data.SettingError (SettingError)
import Ribosome.Effect.Scratch (Scratch)
import Ribosome.Effect.Settings (Settings)
import qualified Ribosome.Host.Data.Report as Report
import Ribosome.Host.Data.Report (
  LogReport (LogReport),
  Report (Report),
  ReportContext (ReportContext),
  Reportable (toReport),
  resumeReport,
  severity,
  )
import Ribosome.Host.Data.RpcError (RpcError)
import Ribosome.Host.Effect.Reports (Reports (..), storeReport, storedReports)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.Interpreter.Reports

-- |Add a segment to the current 'Report' logging context.
context ::
  Member (DataLog LogReport) r =>
  Text ->
  Sem r a ->
  Sem r a
context :: forall (r :: EffectRow) a.
Member (DataLog LogReport) r =>
Text -> Sem r a -> Sem r a
context Text
ctx =
  (LogReport -> LogReport) -> Sem r a -> Sem r a
forall a (r :: EffectRow) b.
Member (DataLog a) r =>
(a -> a) -> Sem r b -> Sem r b
Log.local (IsLabel
  "context" (ASetter LogReport LogReport ReportContext ReportContext)
ASetter LogReport LogReport ReportContext ReportContext
#context ASetter LogReport LogReport ReportContext ReportContext
-> (ReportContext -> ReportContext) -> LogReport -> LogReport
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \ (ReportContext [Text]
cur) -> [Text] -> ReportContext
ReportContext (Text
ctx Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cur))

-- |Set the current 'Report' logging context.
setContext ::
  Member (DataLog LogReport) r =>
  ReportContext ->
  Sem r a ->
  Sem r a
setContext :: forall (r :: EffectRow) a.
Member (DataLog LogReport) r =>
ReportContext -> Sem r a -> Sem r a
setContext ReportContext
ctx =
  (LogReport -> LogReport) -> Sem r a -> Sem r a
forall a (r :: EffectRow) b.
Member (DataLog a) r =>
(a -> a) -> Sem r b -> Sem r b
Log.local (IsLabel
  "context" (ASetter LogReport LogReport ReportContext ReportContext)
ASetter LogReport LogReport ReportContext ReportContext
#context ASetter LogReport LogReport ReportContext ReportContext
-> ReportContext -> LogReport -> LogReport
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ReportContext
ctx)

-- |Convert a value to 'Report' via 'Reportable' and send it to the log.
logReport ::
  Reportable e =>
  Member (DataLog LogReport) r =>
  e ->
  Sem r ()
logReport :: forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport e
e =
  LogReport -> Sem r ()
forall a (r :: EffectRow). Member (DataLog a) r => a -> Sem r ()
dataLog (Report -> Bool -> Bool -> ReportContext -> LogReport
LogReport Report
r Bool
True (Report -> Severity
severity Report
r Severity -> Severity -> Bool
forall a. Ord a => a -> a -> Bool
>= Severity
Warn) ReportContext
forall a. Monoid a => a
mempty)
  where
    r :: Report
r = e -> Report
forall e. Reportable e => e -> Report
toReport e
e

-- |Send a 'Report' to the log given a user and log message, with serverity 'Info'.
info ::
  Member (DataLog LogReport) r =>
  Text ->
  [Text] ->
  Sem r ()
info :: forall (r :: EffectRow).
Member (DataLog LogReport) r =>
Text -> [Text] -> Sem r ()
info Text
user [Text]
log =
  Report -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport Report :: HasCallStack => Text -> [Text] -> Severity -> Report
Report {$sel:severity:Report :: Severity
severity = Severity
Info, [Text]
Text
$sel:user:Report :: Text
$sel:log:Report :: [Text]
log :: [Text]
user :: Text
..}

-- |Send a 'Report' to the log given a user and log message, with serverity 'Warn'.
warn ::
  Member (DataLog LogReport) r =>
  Text ->
  [Text] ->
  Sem r ()
warn :: forall (r :: EffectRow).
Member (DataLog LogReport) r =>
Text -> [Text] -> Sem r ()
warn Text
user [Text]
log =
  Report -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport Report :: HasCallStack => Text -> [Text] -> Severity -> Report
Report {$sel:severity:Report :: Severity
severity = Severity
Warn, [Text]
Text
log :: [Text]
user :: Text
$sel:user:Report :: Text
$sel:log:Report :: [Text]
..}

-- |Send a 'Report' to the log given a user and log message, with serverity 'Log.Error'.
error ::
  Member (DataLog LogReport) r =>
  Text ->
  [Text] ->
  Sem r ()
error :: forall (r :: EffectRow).
Member (DataLog LogReport) r =>
Text -> [Text] -> Sem r ()
error Text
user [Text]
log =
  Report -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport Report :: HasCallStack => Text -> [Text] -> Severity -> Report
Report {$sel:severity:Report :: Severity
severity = Severity
Error, [Text]
Text
log :: [Text]
user :: Text
$sel:user:Report :: Text
$sel:log:Report :: [Text]
..}

-- |Eliminate @'Stop' err@ by converting @err@ to a 'Report' and logging it, continuing execution for a unit action.
reportStop ::
  ∀ err r .
  Reportable err =>
  Member (DataLog LogReport) r =>
  Sem (Stop err : r) () ->
  Sem r ()
reportStop :: forall err (r :: EffectRow).
(Reportable err, Member (DataLog LogReport) r) =>
Sem (Stop err : r) () -> Sem r ()
reportStop Sem (Stop err : r) ()
sem =
  (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    (err -> Sem r ()) -> (() -> Sem r ()) -> Either err () -> Sem r ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either err -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either err () -> Sem r ()) -> Sem r (Either err ()) -> Sem r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem (Stop err : r) () -> Sem r (Either err ())
forall e (r :: EffectRow) a.
Sem (Stop e : r) a -> Sem r (Either e a)
runStop Sem (Stop err : r) ()
sem

-- |Resume an effect by converting the error to a 'Report' and logging it, continuing execution for a unit action.
resumeLogReport ::
  ∀ eff e r .
  Reportable e =>
  Members [eff !! e, DataLog LogReport] r =>
  Sem (eff : r) () ->
  Sem r ()
resumeLogReport :: forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow).
(Reportable e, Members '[eff !! e, DataLog LogReport] r) =>
Sem (eff : r) () -> Sem r ()
resumeLogReport Sem (eff : r) ()
sem =
  (HasCallStack => Sem r ()) -> Sem r ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack do
    Sem (eff : r) ()
sem Sem (eff : r) () -> (e -> Sem r ()) -> Sem r ()
forall err (eff :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member (Resumable err eff) r =>
Sem (eff : r) a -> (err -> Sem r a) -> Sem r a
!! e -> Sem r ()
forall e (r :: EffectRow).
(Reportable e, Member (DataLog LogReport) r) =>
e -> Sem r ()
logReport

-- |Resume all plugin effects.
pluginLogReports ::
  Members [Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError, Stop Report] r =>
  InterpretersFor [Scratch, Settings, Rpc] r
pluginLogReports :: forall (r :: EffectRow).
Members
  '[Scratch !! RpcError, Settings !! SettingError, Rpc !! RpcError,
    Stop Report]
  r =>
InterpretersFor '[Scratch, Settings, Rpc] r
pluginLogReports =
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Rpc (Sem (Rpc : r) a -> Sem r a)
-> (Sem (Scratch : Settings : Rpc : r) a -> Sem (Rpc : r) a)
-> Sem (Scratch : Settings : Rpc : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Settings (Sem (Settings : Rpc : r) a -> Sem (Rpc : r) a)
-> (Sem (Scratch : Settings : Rpc : r) a
    -> Sem (Settings : Rpc : r) a)
-> Sem (Scratch : Settings : Rpc : r) a
-> Sem (Rpc : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall (eff :: (* -> *) -> * -> *) e (r :: EffectRow) a.
(Reportable e, Members '[eff !! e, Stop Report] r) =>
Sem (eff : r) a -> Sem r a
resumeReport @Scratch