-- |Interpreters for 'Reports'.
module Ribosome.Host.Interpreter.Reports where

import Conc (interpretAtomic)
import qualified Data.Map.Strict as Map
import Polysemy.Chronos (ChronosTime)

import Ribosome.Host.Data.Report (ReportContext)
import qualified Ribosome.Host.Data.StoredReport as StoredReport
import Ribosome.Host.Data.StoredReport (StoredReport)
import qualified Ribosome.Host.Effect.Reports as Reports
import Ribosome.Host.Effect.Reports (Reports)

-- |Interpret 'Reports' by storing reports in 'AtomicState'.
interpretReportsAtomic ::
  Members [AtomicState (Map ReportContext [StoredReport]), ChronosTime] r =>
  Int ->
  InterpreterFor Reports r
interpretReportsAtomic :: forall (r :: EffectRow).
Members
  '[AtomicState (Map ReportContext [StoredReport]), ChronosTime] r =>
Int -> InterpreterFor Reports r
interpretReportsAtomic Int
maxReports =
  (forall (rInitial :: EffectRow) x.
 Reports (Sem rInitial) x -> Sem r x)
-> Sem (Reports : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Reports.StoreReport ReportContext
htag Report
msg -> do
      StoredReport
sr <- Report -> Sem r StoredReport
forall (r :: EffectRow).
Member ChronosTime r =>
Report -> Sem r StoredReport
StoredReport.now Report
msg
      (Map ReportContext [StoredReport]
 -> Map ReportContext [StoredReport])
-> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' ((Maybe [StoredReport] -> Maybe [StoredReport])
-> ReportContext
-> Map ReportContext [StoredReport]
-> Map ReportContext [StoredReport]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (StoredReport -> Maybe [StoredReport] -> Maybe [StoredReport]
alter StoredReport
sr) ReportContext
htag)
      where
        alter :: StoredReport -> Maybe [StoredReport] -> Maybe [StoredReport]
alter StoredReport
sr =
          [StoredReport] -> Maybe [StoredReport]
forall a. a -> Maybe a
Just ([StoredReport] -> Maybe [StoredReport])
-> (Maybe [StoredReport] -> [StoredReport])
-> Maybe [StoredReport]
-> Maybe [StoredReport]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [StoredReport] -> [StoredReport]
forall a. Int -> [a] -> [a]
take Int
maxReports ([StoredReport] -> [StoredReport])
-> (Maybe [StoredReport] -> [StoredReport])
-> Maybe [StoredReport]
-> [StoredReport]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StoredReport]
-> ([StoredReport] -> [StoredReport])
-> Maybe [StoredReport]
-> [StoredReport]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Item [StoredReport]
StoredReport
sr] (StoredReport
sr StoredReport -> [StoredReport] -> [StoredReport]
forall a. a -> [a] -> [a]
:)
    Reports (Sem rInitial) x
Reports.StoredReports ->
      Sem r x
forall s (r :: EffectRow). Member (AtomicState s) r => Sem r s
atomicGet

-- |Interpret 'Reports' by storing reports in 'AtomicState' and interpret the state effect.
interpretReports ::
  Members [ChronosTime, Embed IO] r =>
  InterpreterFor Reports r
interpretReports :: forall (r :: EffectRow).
Members '[ChronosTime, Embed IO] r =>
InterpreterFor Reports r
interpretReports =
  Map ReportContext [StoredReport]
-> InterpreterFor
     (AtomicState (Map ReportContext [StoredReport])) r
forall a (r :: EffectRow).
Member (Embed IO) r =>
a -> InterpreterFor (AtomicState a) r
interpretAtomic Map ReportContext [StoredReport]
forall a. Monoid a => a
mempty (Sem (AtomicState (Map ReportContext [StoredReport]) : r) a
 -> Sem r a)
-> (Sem (Reports : r) a
    -> Sem (AtomicState (Map ReportContext [StoredReport]) : r) a)
-> Sem (Reports : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Int
-> InterpreterFor
     Reports (AtomicState (Map ReportContext [StoredReport]) : r)
forall (r :: EffectRow).
Members
  '[AtomicState (Map ReportContext [StoredReport]), ChronosTime] r =>
Int -> InterpreterFor Reports r
interpretReportsAtomic Int
100 (Sem
   (Reports : AtomicState (Map ReportContext [StoredReport]) : r) a
 -> Sem (AtomicState (Map ReportContext [StoredReport]) : r) a)
-> (Sem (Reports : r) a
    -> Sem
         (Reports : AtomicState (Map ReportContext [StoredReport]) : r) a)
-> Sem (Reports : r) a
-> Sem (AtomicState (Map ReportContext [StoredReport]) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Reports : r) a
-> Sem
     (Reports : AtomicState (Map ReportContext [StoredReport]) : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder