module Control.Eff.State.LazyState where
import Control.Eff
import Data.OpenUnion
data LazyState s v where
LGet :: LazyState s s
LPut :: s -> LazyState s ()
Delay :: Eff '[LazyState s] a -> LazyState s a
lget :: Member (LazyState s) r => Eff r s
lget = send LGet
lput :: Member (LazyState s) r => s -> Eff r ()
lput = send . LPut
lmodify :: (Member (LazyState s) r, Member (LazyState t) r)
=> (t -> s) -> Eff r ()
lmodify f = do
s <- lget
lput (f s)
onDemand :: Member (LazyState s) r => Eff '[LazyState s] v -> Eff r v
onDemand = send . Delay
runStateLazy :: s -> Eff (LazyState s ': r) a -> Eff r (a,s)
runStateLazy s = handle_relay_s s (\s0 x -> return (x,s0))
(\s0 req k -> case req of
LGet -> k s0 s0
LPut s1 -> k s1 ()
Delay m -> let ~(x,s1) = run $ runStateLazy s0 m
in k s1 x)
runStateBack0 :: Eff '[LazyState s] a -> (a,s)
runStateBack0 m =
let (x,s) = go s m in
(x,s)
where
go :: s -> Eff '[LazyState s] a -> (a,s)
go s (Val x) = (x,s)
go s (E u q) = case decomp u of
Right LGet -> go s $ qApp q s
Right (LPut s1) -> let ~(x,sp) = go sp $ qApp q () in (x,s1)
Right (Delay m1) -> let ~(x,s1) = go s m1 in go s1 $ qApp q x
Left _ -> error "LazyState: the impossible happened"
runStateBack :: Eff '[LazyState s] a -> (a,s)
runStateBack m =
let (x,(_,sp)) = run $ go (sp,[]) m in
(x,head sp)
where
go :: ([s],[s]) -> Eff '[LazyState s] a -> Eff '[] (a,([s],[s]))
go ss = handle_relay_s ss (\ss1 x -> return (x,ss1))
(\ss1@(sg,sp) req k -> case req of
LGet -> k ss1 (head sg)
LPut s -> k (tail sg,sp++[s]) ()
Delay m1 -> let ~(x,ss2) = run $ go ss1 m1
in k ss2 x)