{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TemplateHaskell #-}
module Disco.Effects.Counter where
import Polysemy
import Polysemy.State
data Counter m a where
Next :: Counter m Integer
makeSem ''Counter
runCounter' :: Integer -> Sem (Counter ': r) a -> Sem r a
runCounter' :: Integer -> Sem (Counter : r) a -> Sem r a
runCounter' Integer
i
= Integer -> Sem (State Integer : r) a -> Sem r a
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r a
evalState Integer
i
(Sem (State Integer : r) a -> Sem r a)
-> (Sem (Counter : r) a -> Sem (State Integer : r) a)
-> Sem (Counter : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: [(* -> *) -> * -> *]) x.
Counter (Sem rInitial) x -> Sem (State Integer : r) x)
-> Sem (Counter : r) a -> Sem (State Integer : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) x.
e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret \case
Counter (Sem rInitial) x
Next -> do
x
n <- Sem (State Integer : r) x
forall s (r :: [(* -> *) -> * -> *]). Member (State s) r => Sem r s
get
x -> Sem (State Integer : r) ()
forall s (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
s -> Sem r ()
put (x
nx -> x -> x
forall a. Num a => a -> a -> a
+x
1)
x -> Sem (State Integer : r) x
forall (m :: * -> *) a. Monad m => a -> m a
return x
n
runCounter :: Sem (Counter ': r) a -> Sem r a
runCounter :: Sem (Counter : r) a -> Sem r a
runCounter = Integer -> Sem (Counter : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) a.
Integer -> Sem (Counter : r) a -> Sem r a
runCounter' Integer
0