an example of an example of ideal monads

ideal.hs

import Data.Char

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

class Idealize f where
    (>>~) :: f a -> (a -> Ideal f b) -> f b

instance Idealize f => Monad (Ideal f) where
    return = Pure
    Pure a >>= k = k a
    Ideal fa >>= k = Ideal (fa >>~ k)

newtype Liberty f a = Liberty (f (Free f a))

type Free f = Ideal (Liberty f)

instance Functor f => Idealize (Liberty f) where
    Liberty fii >>~ k = Liberty (fmap (>>=k) fii)

free :: Functor f => f (Free f a) -> Free f a
free f = Ideal (Liberty f)

-- そろそろFreeモナドに関して一言いっとくか http://fumieval.hatenablog.com/entry/20121111/1352614885

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

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

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

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

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

main = runStdIO $ 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 ".\nThank you!\n"