Last active
February 13, 2017 20:20
-
-
Save osa1/b0f6b302693f34a0088df55eaf931b5c to your computer and use it in GitHub Desktop.
Running state effect using IORef
This file contains hidden or 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
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE GADTs #-} | |
{-# LANGUAGE TupleSections #-} | |
{-# LANGUAGE TypeOperators #-} | |
module Lib where | |
import Control.Monad.Freer | |
import Control.Monad.Freer.Internal | |
import Control.Monad.Freer.State | |
import Data.IORef | |
runStateIO :: Member IO r => IORef s -> Eff (State s ': r) a -> Eff r (a,s) | |
runStateIO ref = loop | |
where | |
loop (Val v) = (v,) <$> send (readIORef ref) | |
loop (E u q) = | |
case decomp u of | |
Right Get -> send (readIORef ref) >>= loop . qApp q | |
Right (Put s) -> send (writeIORef ref s) >> loop (qApp q ()) | |
Left u' -> E u' (tsingleton (loop . qApp q)) | |
statefulFac :: Member (State Int) r => Int -> Eff r () | |
statefulFac 1 = return () | |
statefulFac n = do | |
a <- get | |
put (n * a) | |
statefulFac (n - 1) | |
runStatefulFac_IO :: Int -> IO Int | |
runStatefulFac_IO n = do | |
ref <- newIORef 1 :: IO (IORef Int) | |
snd <$> runM (runStateIO ref (statefulFac 5)) | |
runStatefulFac_pure :: Int -> Int | |
runStatefulFac_pure n = snd (run (runState (statefulFac n) 1)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment