-
-
Save seckcoder/0ab5f830d6f6ef00f1d6 to your computer and use it in GitHub Desktop.
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
data IOAction a = Return a | |
| Put String (IOAction a) | |
| Get (String -> IOAction a) | |
get = Get Return | |
put s = Put s (Return ()) | |
seqio :: IOAction a -> (a -> IOAction b) -> IOAction b | |
seqio (Return a) f = f a | |
seqio (Put s io) f = Put s (seqio io f) | |
seqio (Get g) f = Get (\s -> seqio (g s) f) | |
echo = get `seqio` put | |
hello = put "What is your name?" `seqio` \_ -> | |
get `seqio` \name -> | |
put "What is your age?" `seqio` \_ -> | |
get `seqio` \age -> | |
put ("Hello " ++ name ++ "!") `seqio` \_ -> | |
put ("You are " ++ age ++ " years old") | |
hello2 = do put "What is your name?" | |
name <- get | |
put "What is your age?" | |
age <- get | |
put ("Hello, " ++ name ++ "!") | |
put ("You are " ++ age ++ " years old!") | |
run (Return a) = return a | |
run (Put s io) = putStrLn s >> run io | |
run (Get f) = getLine >>= run . f | |
-- Glue code that makes everything play nice -- | |
instance Monad IOAction where | |
return = Return | |
(>>=) = seqio | |
instance Show a => Show (IOAction a) where | |
show io = go 0 0 io | |
where | |
go m n (Return a) = ind m "Return " ++ show a | |
go m n (Put s io) = ind m "Put " ++ show s ++ " (\n" ++ go (m+2) n io ++ "\n" ++ ind m ")" | |
go m n (Get g) = let i = "$" ++ show n | |
in ind m "Get (" ++ i ++ " -> \n" ++ go (m+2) (n+1) (g i) ++ "\n" ++ ind m ")" | |
ind m s = replicate m ' ' ++ s | |
-- IOAction is also a Functor -- | |
mapio :: (a -> b) -> IOAction a -> IOAction b | |
mapio f (Return a) = Return (f a) | |
mapio f (Put s io) = Put s (mapio f io) | |
mapio f (Get g) = Get (\s -> mapio f (g s)) | |
instance Functor IOAction where | |
fmap = mapio |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment