-- |Description: Internal
module Polysemy.Log.Atomic where

import Polysemy (interpretH, runT)
import Polysemy.Internal (InterpretersFor)
import Polysemy.Internal.Tactics (liftT)

import Polysemy.Log.Data.DataLog (DataLog(DataLog, Local))
import Polysemy.Log.Data.Log (Log(Log))
import Polysemy.Log.Data.LogMessage (LogMessage)

-- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState'.
-- Maintains a context function as state that is applied to each logged message, allowing the context of a block to be
-- modified.
interpretDataLogAtomicLocal ::
  ∀ a r .
  Member (AtomicState [a]) r =>
  (a -> a) ->
  InterpreterFor (DataLog a) r
interpretDataLogAtomicLocal :: (a -> a) -> InterpreterFor (DataLog a) r
interpretDataLogAtomicLocal a -> a
context =
  (forall x (rInitial :: EffectRow).
 DataLog a (Sem rInitial) x
 -> Tactical (DataLog a) (Sem rInitial) r x)
-> Sem (DataLog a : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
(forall x (rInitial :: EffectRow).
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
    DataLog msg ->
      Sem r () -> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f ())
forall (m :: * -> *) (f :: * -> *) (r :: EffectRow) (e :: Effect)
       a.
Functor f =>
Sem r a -> Sem (WithTactics e f m r) (f a)
liftT (([a] -> [a]) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (a -> a
context a
msg a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
    Local f ma ->
      Sem r (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise (Sem r (f x)
 -> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x))
-> (Sem (DataLog a : r) (f x) -> Sem r (f x))
-> Sem (DataLog a : r) (f x)
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
Member (AtomicState [a]) r =>
(a -> a) -> InterpreterFor (DataLog a) r
interpretDataLogAtomicLocal (a -> a
f (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
context) (Sem (DataLog a : r) (f x)
 -> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x))
-> Sem
     (WithTactics (DataLog a) f (Sem rInitial) r)
     (Sem (DataLog a : r) (f x))
-> Sem (WithTactics (DataLog a) f (Sem rInitial) r) (f x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sem rInitial x
-> Sem
     (WithTactics (DataLog a) f (Sem rInitial) r)
     (Sem (DataLog a : r) (f x))
forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial x
ma
{-# INLINE interpretDataLogAtomicLocal #-}

-- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState'.
interpretDataLogAtomic' ::
  ∀ a r .
  Member (AtomicState [a]) r =>
  InterpreterFor (DataLog a) r
interpretDataLogAtomic' :: InterpreterFor (DataLog a) r
interpretDataLogAtomic' =
  (a -> a) -> InterpreterFor (DataLog a) r
forall a (r :: EffectRow).
Member (AtomicState [a]) r =>
(a -> a) -> InterpreterFor (DataLog a) r
interpretDataLogAtomicLocal a -> a
forall a. a -> a
id
{-# INLINE interpretDataLogAtomic' #-}

-- |Interpret 'DataLog' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a
-- 'TVar'.
interpretDataLogAtomic ::
  ∀ a r .
  Member (Embed IO) r =>
  InterpretersFor [DataLog a, AtomicState [a]] r
interpretDataLogAtomic :: InterpretersFor '[DataLog a, AtomicState [a]] r
interpretDataLogAtomic Sem (Append '[DataLog a, AtomicState [a]] r) a
sem = do
  TVar [a]
tv <- [a] -> Sem r (TVar [a])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
  TVar [a] -> Sem (AtomicState [a] : r) a -> Sem r a
forall (r :: EffectRow) s a.
Member (Embed IO) r =>
TVar s -> Sem (AtomicState s : r) a -> Sem r a
runAtomicStateTVar TVar [a]
tv (Sem (DataLog a : AtomicState [a] : r) a
-> Sem (AtomicState [a] : r) a
forall a (r :: EffectRow).
Member (AtomicState [a]) r =>
InterpreterFor (DataLog a) r
interpretDataLogAtomic' Sem (DataLog a : AtomicState [a] : r) a
Sem (Append '[DataLog a, AtomicState [a]] r) a
sem)
{-# INLINE interpretDataLogAtomic #-}

-- |Interpret 'Log' by prepending each message to a list in an 'AtomicState'.
interpretLogAtomic' ::
  Member (AtomicState [LogMessage]) r =>
  InterpreterFor Log r
interpretLogAtomic' :: InterpreterFor Log r
interpretLogAtomic' =
  (forall x (rInitial :: EffectRow). Log (Sem rInitial) x -> Sem r x)
-> Sem (Log : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
    Log msg -> ([LogMessage] -> [LogMessage]) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (LogMessage
msg LogMessage -> [LogMessage] -> [LogMessage]
forall a. a -> [a] -> [a]
:)
{-# INLINE interpretLogAtomic' #-}

-- |Interpret 'Log' by prepending each message to a list in an 'AtomicState', then interpret the 'AtomicState' in a
-- 'TVar'.
interpretLogAtomic ::
  Member (Embed IO) r =>
  InterpretersFor [Log, AtomicState [LogMessage]] r
interpretLogAtomic :: InterpretersFor '[Log, AtomicState [LogMessage]] r
interpretLogAtomic Sem (Append '[Log, AtomicState [LogMessage]] r) a
sem = do
  TVar [LogMessage]
tv <- [LogMessage] -> Sem r (TVar [LogMessage])
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
  TVar [LogMessage]
-> Sem (AtomicState [LogMessage] : r) a -> Sem r a
forall (r :: EffectRow) s a.
Member (Embed IO) r =>
TVar s -> Sem (AtomicState s : r) a -> Sem r a
runAtomicStateTVar TVar [LogMessage]
tv (Sem (Log : AtomicState [LogMessage] : r) a
-> Sem (AtomicState [LogMessage] : r) a
forall (r :: EffectRow).
Member (AtomicState [LogMessage]) r =>
InterpreterFor Log r
interpretLogAtomic' Sem (Log : AtomicState [LogMessage] : r) a
Sem (Append '[Log, AtomicState [LogMessage]] r) a
sem)
{-# INLINE interpretLogAtomic #-}