Created
January 3, 2013 18:04
-
-
Save fumieval/4445447 to your computer and use it in GitHub Desktop.
an example of an example of ideal monads
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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