My first Monad

I’ve finally made my first monad; I’m still not 100% sure if I’ve really come to grips on it entirely. Here’s its definition:

import System.IO
import Control.Applicative

newtype IODirector a = IODirector { runIODirector :: (Handle,Handle) -> IO (a, (Handle,Handle)) }

instance Monad IODirector where
  return a = IODirector $ \hs -> return (a, hs)
  m >>= k  = IODirector $ \hs -> do (a, hs) <- runIODirector m hs
                                    runIODirector (k a) hs

class MonadDirectedIO a where
  dPutStr :: String -> a ()
  dPutStrLn :: String -> a ()

  dGetLine :: a String
  dGetChar :: a Char

  dFlushOut :: a ()

  dSetBufferingIn :: BufferMode -> a ()
  dSetBufferingOut :: BufferMode -> a ()
  dSetBufferingBoth :: BufferMode -> a ()

  dSetEcho :: Bool -> a ()

instance MonadDirectedIO IODirector where
  dPutStr s = IODirector $ \hs@(_,hOut) -> do hPutStr hOut s
                                              return ((), hs)
  dPutStrLn = dPutStr . (++ "\n")

  dGetLine = IODirector $ \hs@(hIn,_) -> do r <- hGetLine hIn
                                            return (r, hs)
  dGetChar = IODirector $ \hs@(hIn,_) -> do r <- hGetChar hIn
                                            return (r, hs)

  dFlushOut = IODirector $ \hs@(_,hOut) -> do hFlush hOut
                                              return ((), hs)

  dSetBufferingIn m  = IODirector $ \hs@(hIn,_) -> do hSetBuffering hIn m
                                                      return ((), hs)
  dSetBufferingOut m = IODirector $ \hs@(_,hOut) -> do hSetBuffering hOut m
                                                       return ((), hs)
  dSetBufferingBoth  = (>>) <$> dSetBufferingIn <*> dSetBufferingOut

  dSetEcho m = IODirector $ \hs@(_,hOut) -> do hSetEcho hOut m
                                               return ((), hs)

It’s basically a glorified State monad, and I bet I could even probably extend the extant State monad to let me do this if I really wanted to, though I’m not sure about the threading .. more on that in a second.

Its function is to let you specify an input and output Handle (e.g. (stdin,stdout)) which will be used for I/O within the context of the monad. The benefit here is not needing to thread the Handle pair throughout your code, and they get passed all the way down.

As this is my first monad, I had a bit of difficulty working out what everything should be: there was the new type, IODirector a, which actually represented the stateful computation, then making IODirector (and not IODirector a) an instance of Monad. Must remember that Monad takes a type constructor (* -> *).

Next were the difficulties in threading IO through/in/about IODirector. I knew that I had to do it, I just didn’t know how, or where. Reflecting on the newtype declaration now, it seems obvious that the type it wraps is (Handle,Handle) -> IO (a, (Handle,Handle)), which is just a way of saying α -> IO β for some α, β—essentially, any other I/O action which takes an argument. Next was working out where to return values into the IO monad correctly, but again, on reflection it’s clear that it’s in returning the aforementioned stateful computation’s result that it needs to be wrapped into IO, and indeed, that the entire computation therein is a part of IO. Simple!

The binding rules as a part of IODirector’s Monad instance take care of the threading (and indeed, look exactly like the State monad’s bind/return)—then only the functionality needed to be added. Though not required, I encapsulated the requirement for acting as a “MonadDirectedIO” in a type-class of the same name, and then made an instance of it on IODirector.

I lastly had some difficulty in working out how to correctly define dSetBufferingBoth in point-free form: I was trying all sorts of things involving sequence and various monoid and monad constructs, but was repeatedly running into a brick wall because I never involved (>>)! Duh. Applicative functor to the rescue. I’ve already done this before with more boring functions, so I should’ve realised this a bit earlier (as I’d already defined it as dSetBufferingBoth m = dSetBufferingIn m >> dSetBufferingOut m, so it should have come a bit more quickly …).

Here’s what you can do as a result:

main :: IO ()
main = do
  runIODirector myIoFunc (stdin,stdout)
  return ()

myIoFunc :: IODirector ()
myIoFunc = do
  n <- myNamePrompt "I am an IO func: "
  dPutStrLn ("Hi " ++ n ++ "!")
  return ()

myNamePrompt :: String -> IODirector String
myNamePrompt n = do
  dPutStr n
  dFlushOut
  r <- dGetLine
  return r

You can see that the type-signatures are exactly the same as they would be for a normal IO-centric process, only IO is now IODirector, and the I/O functions themselves are prefixed with d. It’s also trivial to change the in/out channels, if you so wanted, by adding dPut in the same vein as State’s put.

This fun was had while writing a small Go game in Haskell, just to get some real practice with the language. Many thanks to Miran Lipovača’s Learn You a Haskell for Great Good!

Onward!