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

import qualified Colog.Polysemy as Colog
import Control.Concurrent.STM (newTVarIO)

-- |Interpret 'Colog.Log' by prepending each message to a list in an 'AtomicState'.
interpretCologAtomic' ::
  ∀ a r .
  Member (AtomicState [a]) r =>
  InterpreterFor (Colog.Log a) r
interpretCologAtomic' :: forall a (r :: EffectRow).
Member (AtomicState [a]) r =>
InterpreterFor (Log a) r
interpretCologAtomic' =
  (forall (rInitial :: EffectRow) x.
 Log a (Sem rInitial) x -> Sem r x)
-> Sem (Log a : 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
    Colog.Log a
msg -> ([a] -> [a]) -> Sem r ()
forall s (r :: EffectRow).
Member (AtomicState s) r =>
(s -> s) -> Sem r ()
atomicModify' (a
msg a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
{-# inline interpretCologAtomic' #-}

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