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

import Control.Concurrent.STM (newTVarIO)
import qualified DiPolysemy as Di
import Polysemy.Internal.Tactics (liftT)

-- |Interpret 'Di.Di' by prepending each message to a list in an 'AtomicState'.
interpretDiAtomic' ::
  ∀ level path msg r .
  Member (AtomicState [msg]) r =>
  InterpreterFor (Di.Di level path msg) r
interpretDiAtomic' :: forall level path msg (r :: EffectRow).
Member (AtomicState [msg]) r =>
InterpreterFor (Di level path msg) r
interpretDiAtomic' =
  (forall (rInitial :: EffectRow) x.
 Di level path msg (Sem rInitial) x
 -> Tactical (Di level path msg) (Sem rInitial) r x)
-> Sem (Di level path msg : r) a -> Sem r a
forall (e :: Effect) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH \case
    Di.Log level
_ msg
msg -> Sem r ()
-> Sem (WithTactics (Di level path msg) 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 (([msg] -> [msg]) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (msg
msg msg -> [msg] -> [msg]
forall a. a -> [a] -> [a]
:))
    Di level path msg (Sem rInitial) x
Di.Flush -> ()
-> Sem (WithTactics (Di level path msg) f (Sem rInitial) r) (f ())
forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT ()
    Di.Local Di level path msg -> Di level path msg
_ Sem rInitial x
ma -> Sem rInitial x -> Tactical (Di level path msg) (Sem rInitial) r x
forall (m :: * -> *) a (e :: Effect) (r :: EffectRow).
m a -> Tactical e m r a
runTSimple Sem rInitial x
ma
    Di level path msg (Sem rInitial) x
Di.Fetch -> Maybe (Di level path msg)
-> Sem
     (WithTactics (Di level path msg) f (Sem rInitial) r)
     (f (Maybe (Di level path msg)))
forall (f :: * -> *) a (e :: Effect) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
pureT Maybe (Di level path msg)
forall a. Maybe a
Nothing
{-# inline interpretDiAtomic' #-}

-- |Interpret 'Di.Di' by prepending each message to a list in an 'AtomicState', then interpret the
-- 'AtomicState' in a 'TVar'.
interpretDiAtomic ::
  ∀ level path msg r .
  Member (Embed IO) r =>
  InterpretersFor [Di.Di level path msg, AtomicState [msg]] r
interpretDiAtomic :: forall level path msg (r :: EffectRow).
Member (Embed IO) r =>
InterpretersFor '[Di level path msg, AtomicState [msg]] r
interpretDiAtomic Sem (Append '[Di level path msg, AtomicState [msg]] r) a
sem = do
  TVar [msg]
tv <- IO (TVar [msg]) -> Sem r (TVar [msg])
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed ([msg] -> IO (TVar [msg])
forall a. a -> IO (TVar a)
newTVarIO [])
  TVar [msg] -> Sem (AtomicState [msg] : 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 [msg]
tv (Sem (Di level path msg : AtomicState [msg] : r) a
-> Sem (AtomicState [msg] : r) a
forall level path msg (r :: EffectRow).
Member (AtomicState [msg]) r =>
InterpreterFor (Di level path msg) r
interpretDiAtomic' Sem (Di level path msg : AtomicState [msg] : r) a
Sem (Append '[Di level path msg, AtomicState [msg]] r) a
sem)
{-# inline interpretDiAtomic #-}