`runList` の実装 ref: http://d.hatena.ne.jp/fumiexcel/20121111/1352614885

runList.hs

import Data.Char
ex0 :: GenericIO ()
ex0 = do
        mapM_ putCh "Hello, Haskeller! Please input a character:"
        ch <- getCh
        mapM_ putCh "The ordinal of the character is:"
        mapM_ putCh (show (ord ch))
        mapM_ putCh ".\n Thank you!\n"

data Free f a = Pure a
              | Free (f (Free f a))

instance Functor f => Monad (Free f) where
        return = Pure
        Pure a >>= k = k a
        Free fm >>= k = Free (fmap (>>=k) fm)

data CharIO a = GetCh (Char -> a)
              | PutCh Char a

instance Functor CharIO where
        fmap f (GetCh g) = GetCh (f . g)
        fmap f (PutCh c a) = PutCh c (f a)

getCh :: Free CharIO Char
getCh = Free $ GetCh $ \ch -> Pure ch

putCh :: Char -> Free CharIO ()
putCh ch = Free $ PutCh ch (Pure ())

type GenericIO = Free CharIO

runStdIO :: Free CharIO a -> IO a
runStdIO (Pure a) = return a
runStdIO (Free (GetCh f)) = getChar >>= (\ch -> runStdIO (f ch))
runStdIO (Free (PutCh x count)) = putChar x >> runStdIO count

runList :: Free CharIO a -> [Char] -> (a, [Char])
runList (Pure a) s = (a, s)
runList (Free (GetCh f)) (c:cs) = runList (f c) cs
runList (Free (PutCh x count)) s = runList count (s ++ [x])

-- *Main> runList ex0 "a"
-- ((),"Hello, Haskeller! Please input a character:The ordinal of the character is:97.\n Thank you!\n")