Created
September 14, 2023 15:24
-
-
Save graninas/88010497e45f62d0fc41284df32f23db to your computer and use it in GitHub Desktop.
Church Free monad based State
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module StateLangSpec where | |
import Test.Hspec | |
import Data.IORef | |
import Control.Monad.Free.Church | |
data StateMethod s next | |
= Put s (() -> next) | |
| Get (s -> next) | |
| PrintIO String (() -> next) | |
instance Functor (StateMethod s) where | |
fmap f (Put st next) = Put st (f . next) | |
fmap f (Get next) = Get (f . next) | |
fmap f (PrintIO val next) = PrintIO val (f . next) | |
type FreePoweredState s a = F (StateMethod s) a | |
put :: s -> FreePoweredState s () | |
put st = liftF (Put st id) | |
get :: FreePoweredState s s | |
get = liftF (Get id) | |
printIO :: Show a => a -> FreePoweredState s () | |
printIO val = liftF (PrintIO (show val) id) | |
interpretStateMethod :: IORef s -> StateMethod s a -> IO a | |
interpretStateMethod stRef (Put st next) = do | |
writeIORef stRef st | |
pure (next ()) | |
interpretStateMethod stRef (Get next) = do | |
st <- readIORef stRef | |
pure (next st) | |
interpretStateMethod stRef (PrintIO val next) = do | |
putStrLn val | |
pure (next ()) | |
runFreePoweredState :: FreePoweredState s a -> s -> IO (s, a) | |
runFreePoweredState scenario st = do | |
stRef <- newIORef st | |
res <- foldF (interpretStateMethod stRef) scenario | |
st' <- readIORef stRef | |
pure (st', res) | |
myStatefulScenario :: FreePoweredState Int Int | |
myStatefulScenario = do | |
printIO "Hello world!" | |
st1 <- get | |
printIO ("Current state: " <> show st1) | |
put 42 | |
st2 <- get | |
printIO ("New state: " <> show st2) | |
pure (st1 + st2) | |
spec :: Spec | |
spec = | |
describe "Church-Free powered State eDSL test" $ do | |
it "Stateful scenario test" $ do | |
(st, res) <- runFreePoweredState myStatefulScenario 58 | |
st `shouldBe` 42 | |
res `shouldBe` 100 | |
-- Test passes. | |
-- Output: | |
-- StateLang | |
-- Church-Free powered State eDSL test | |
-- "Hello world!" | |
-- "Current state: 58" | |
-- "New state: 42" | |
-- Stateful scenario test | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment