sayo-hs/heftia
1
1
Fork 0
mirror of https://github.com/sayo-hs/heftia.git synced 2024-11-23 02:42:06 +03:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[fix] Generalize runStateIORef.

Browse Source
This commit is contained in:
Yamada Ryo 2024-09-09 18:57:52 +09:00
parent e2deb545fe
commit 1a2774adab
No known key found for this signature in database
GPG Key ID: AAE3C7A542B02DBF
1 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
heftia-effects/src/Control/Effect/Interpreter/Heftia/State.hs
View File

@ -17,7 +17,16 @@ module Control.Effect.Interpreter.Heftia.State where
import Control.Arrow ((>>>))
import Control.Effect (type (~>))
import Control.Effect.Hefty (Eff, injectF, interpose, interposeT, interpret, interpretFin, interpretK, raiseUnder)
import Control.Effect.Hefty (
Eff,
injectF,
interpose,
interposeT,
interpretFin,
interpretK,
interpretRec,
raiseUnder,
)
import Control.Effect.Interpreter.Heftia.Reader (runAsk)
import Control.Freer (Freer)
import Control.Monad.Freer (MonadFreer)
@ -91,15 +100,15 @@ runStateK initialState =
>>> runAsk initialState
runStateIORef ::
forall s r a fr u c.
(Freer c fr, Union u, MonadIO (Eff u fr '[] r)) =>
forall s r eh a fr u c.
(Freer c fr, Union u, HFunctor (u eh), MonadIO (Eff u fr eh r)) =>
s ->
Eff u fr '[] (LState s ': r) a ->
Eff u fr '[] r (s, a)
Eff u fr eh (LState s ': r) a ->
Eff u fr eh r (s, a)
runStateIORef s m = do
ref <- newIORef s
a <-
m & interpret \case
m & interpretRec \case
Get -> readIORef ref
Put s' -> writeIORef ref s'
readIORef ref <&> (,a)