Code for my blog post about pure I/O

IOAction.hs

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

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 ()