{-# LANGUAGE TemplateHaskell #-}
module Colog.Polysemy.Effect
(
Log (..)
, log
, LogActionSem
, runLogActionSem
, runLogAction
, runLogAsTrace
, runLogAsOutput
, runTraceAsLog
, runOutputAsLog
) where
import Prelude hiding (log)
import Data.Kind (Type)
import Polysemy (Embed, Member, Sem, embed, interpret, makeSem_)
import Polysemy.Output (Output (..), output)
import Polysemy.Trace (Trace (..), trace)
import Colog.Core.Action (LogAction (..))
data Log (msg :: Type) (m :: Type -> Type) (a :: Type) where
Log :: msg -> Log msg m ()
makeSem_ ''Log
log :: forall msg r .
Member (Log msg) r
=> msg
-> Sem r ()
type LogActionSem r msg = LogAction (Sem r) msg
runLogActionSem :: forall msg r a . LogActionSem r msg -> Sem (Log msg ': r) a -> Sem r a
runLogActionSem :: forall msg (r :: EffectRow) a.
LogActionSem r msg -> Sem (Log msg : r) a -> Sem r a
runLogActionSem (LogAction msg -> Sem r ()
action) = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Log msg
msg -> msg -> Sem r ()
action msg
msg
runLogAction
:: forall m msg r a .
Member (Embed m) r
=> LogAction m msg
-> Sem (Log msg ': r) a
-> Sem r a
runLogAction :: forall (m :: * -> *) msg (r :: EffectRow) a.
Member (Embed m) r =>
LogAction m msg -> Sem (Log msg : r) a -> Sem r a
runLogAction (LogAction msg -> m ()
action) = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Log msg
msg -> forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ msg -> m ()
action msg
msg
{-# INLINE runLogAction #-}
runLogAsTrace
:: forall r a .
Member Trace r
=> Sem (Log String ': r) a
-> Sem r a
runLogAsTrace :: forall (r :: EffectRow) a.
Member Trace r =>
Sem (Log String : r) a -> Sem r a
runLogAsTrace = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Log String
msg -> forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace String
msg
{-# INLINE runLogAsTrace #-}
runLogAsOutput
:: forall msg r a .
Member (Output msg) r
=> Sem (Log msg ': r) a
-> Sem r a
runLogAsOutput :: forall msg (r :: EffectRow) a.
Member (Output msg) r =>
Sem (Log msg : r) a -> Sem r a
runLogAsOutput = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Log msg
msg -> forall o (r :: EffectRow). Member (Output o) r => o -> Sem r ()
output msg
msg
{-# INLINE runLogAsOutput #-}
runTraceAsLog
:: forall r a .
Member (Log String) r
=> Sem (Trace ': r) a
-> Sem r a
runTraceAsLog :: forall (r :: EffectRow) a.
Member (Log String) r =>
Sem (Trace : r) a -> Sem r a
runTraceAsLog = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Trace String
msg -> forall msg (r :: EffectRow). Member (Log msg) r => msg -> Sem r ()
log String
msg
{-# INLINE runTraceAsLog #-}
runOutputAsLog
:: forall msg r a .
Member (Log msg) r
=> Sem (Output msg ': r) a
-> Sem r a
runOutputAsLog :: forall msg (r :: EffectRow) a.
Member (Log msg) r =>
Sem (Output msg : r) a -> Sem r a
runOutputAsLog = forall (e :: Effect) (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 forall a b. (a -> b) -> a -> b
$ \case
Output msg
msg -> forall msg (r :: EffectRow). Member (Log msg) r => msg -> Sem r ()
log msg
msg
{-# INLINE runOutputAsLog #-}