Skip to content

Instantly share code, notes, and snippets.

@chris-taylor
Last active September 28, 2020 12:32
Show Gist options
  • Star 10 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save chris-taylor/4745921 to your computer and use it in GitHub Desktop.
Save chris-taylor/4745921 to your computer and use it in GitHub Desktop.
Code for my blog post about pure I/O
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
@tinyplasticgreyknight
Copy link

tinyplasticgreyknight commented Sep 2, 2016

It might be useful to show what the types of get and put are here, just for a little extra clarity? Your write-up is already very good though. :-)

get :: IOAction String
put :: String -> IOAction ()

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment