Skip to content

Instantly share code, notes, and snippets.

@fumieval

fumieval/ideal.hs

Created Jan 3, 2013
Embed
What would you like to do?
an example of an example of ideal monads
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"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment