[add] state-specific interpreting functions.

heftia/heftia.cabal

@@ -54,7 +54,7 @@ tested-with:
 source-repository head
     type: git
     location: https://github.com/sayo-hs/heftia
-    tag: v0.2.0
+    tag: v0.4.0
     subdir: heftia
 
 library

heftia/src/Control/Monad/Hefty.hs

@@ -3,6 +3,7 @@
 module Control.Monad.Hefty (
     module Control.Monad.Hefty.Types,
     module Control.Monad.Hefty.Interpret,
+    module Control.Monad.Hefty.Interpret.State,
     module Control.Monad.Hefty.Transform,
 ) where
 
@@ -54,6 +55,13 @@ import Control.Monad.Hefty.Interpret (
     runEff,
     runPure,
  )
+import Control.Monad.Hefty.Interpret.State (
+    StateElaborator,
+    StateInterpreter,
+    interpretStateBy,
+    iterStateAllEffHFBy,
+    reinterpretStateBy,
+ )
 import Control.Monad.Hefty.Transform (
     bundle,
     bundleAll,

heftia/src/Control/Monad/Hefty/Interpret/State.hs

@@ -1,3 +1,56 @@
 -- SPDX-License-Identifier: MPL-2.0
 
 module Control.Monad.Hefty.Interpret.State where
+
+import Control.Monad.Hefty.Interpret (qApp)
+import Control.Monad.Hefty.Types (Eff (Op, Val), sendUnionBy)
+import Data.Effect.OpenUnion.Internal (IsSuffixOf)
+import Data.Effect.OpenUnion.Internal.FO (Union, weakens, (!+))
+import Data.Effect.OpenUnion.Internal.HO (UnionH, nilH)
+import Data.Kind (Type)
+
+type StateInterpreter s e m (ans :: Type) = forall x. e x -> s -> (s -> x -> m ans) -> m ans
+
+type StateElaborator s e m ans = StateInterpreter s (e m) m ans
+
+iterStateAllEffHFBy
+    :: forall s eh ef m ans a
+     . (Monad m)
+    => s
+    -> (s -> a -> m ans)
+    -> StateInterpreter s (UnionH eh (Eff eh ef)) m ans
+    -> StateInterpreter s (Union ef) m ans
+    -> Eff eh ef a
+    -> m ans
+iterStateAllEffHFBy s0 ret fh ff = loop s0
+  where
+    loop s = \case
+        Val x -> ret s x
+        Op u q -> either (`fh` s) (`ff` s) u k
+          where
+            k s' = loop s' . qApp q
+{-# INLINE iterStateAllEffHFBy #-}
+
+interpretStateBy
+    :: forall s e ef ans a
+     . s
+    -> (s -> a -> Eff '[] ef ans)
+    -> StateInterpreter s e (Eff '[] ef) ans
+    -> Eff '[] (e ': ef) a
+    -> Eff '[] ef ans
+interpretStateBy = reinterpretStateBy
+{-# INLINE interpretStateBy #-}
+
+reinterpretStateBy
+    :: forall s e ef' ef ans a
+     . (ef `IsSuffixOf` ef')
+    => s
+    -> (s -> a -> Eff '[] ef' ans)
+    -> StateInterpreter s e (Eff '[] ef') ans
+    -> Eff '[] (e ': ef) a
+    -> Eff '[] ef' ans
+reinterpretStateBy s0 ret hdl =
+    iterStateAllEffHFBy s0 ret nilH (hdl !+ \e s k -> sendUnionBy (k s) (weakens e))
+{-# INLINE reinterpretStateBy #-}
+
+-- TODO: add other pattern functions.