Skip to content

Instantly share code, notes, and snippets.

@xiaolzha
Last active October 9, 2015 07:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save xiaolzha/1f82825ea4741933a549 to your computer and use it in GitHub Desktop.
Save xiaolzha/1f82825ea4741933a549 to your computer and use it in GitHub Desktop.
Combine reader monad and state monad
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad.State.Strict
import Data.Text
import qualified Data.HashMap.Strict as M
import Control.Monad
import Control.Monad.Reader
import Prelude hiding (unwords)
type ContextName = Text
{- Reader Monad, works -}
context :: ReaderT Text IO Text
context = do
name <- ask
return name
main1 :: IO ()
main1 = do
name <- runReaderT context "CONCRETE_CONTEXT"
print (name)
{- State Monad, works -}
type AppState = M.HashMap Text Text
addValue :: Text -> Text -> StateT AppState IO ()
addValue k v = do
st <- get
put (M.insert k v st)
getValue :: Text -> StateT AppState IO (Maybe Text)
getValue k = do
st <- get
return (val st)
where
val st = M.lookup k st
modifyValue :: Text -> Text -> StateT AppState IO ()
modifyValue k v = do
st <- get
put $ M.insert k v (M.delete k st)
runWithState :: StateT AppState IO (Maybe Text)
runWithState = do
addValue "k1" "v1"
addValue "k2" "v2"
modifyValue "k2" "v_2"
getValue "k2"
main2 :: IO ()
main2 = do
st <- runStateT runWithState M.empty
print (fst st)
print (snd st)
{- Use reader monad in state monad, works-}
addValueWithContext :: Text -> Text -> StateT AppState (ReaderT Text IO) ()
addValueWithContext k v = do
ctx <- ask
st <- get
put $ M.insert k (concate ctx v) st
where
concate ctx val = unwords [val, "in", ctx]
getValueInContext :: Text -> StateT AppState (ReaderT Text IO) (Maybe Text)
getValueInContext k = do
st <- get
return $ val st
where
val st = M.lookup k st
runStateWithContext :: StateT AppState (ReaderT Text IO) (Maybe Text)
runStateWithContext = do
addValueWithContext "k1" "v1"
addValueWithContext "k2" "v2"
getValueInContext "k2"
main3 = do
st <- runReaderT (runStateT runStateWithContext M.empty) "CONCRETE_CONTEXT"
print (fst st)
print (snd st)
addValueWithContext2 :: Text -> Text -> ReaderT Text (StateT AppState IO) ()
addValueWithContext2 k v = do
ctx <- ask
st <- get
put $ M.insert k ((concate ctx v)) st
where
concate ctx val = unwords [val, "in", ctx]
runStateWithContext2 :: ReaderT Text (StateT AppState IO) ()
runStateWithContext2 = do
addValueWithContext2 "k1" "v1"
addValueWithContext2 "k2" "v2"
main4 = do
s <- runStateT (runReaderT runStateWithContext2 "CONCRETE_CONTEXT") M.empty
print (snd s)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment