Skip to content

Instantly share code, notes, and snippets.

@sjoerdvisscher
Created December 19, 2009 16:35
Show Gist options
  • Save sjoerdvisscher/260138 to your computer and use it in GitHub Desktop.
Save sjoerdvisscher/260138 to your computer and use it in GitHub Desktop.
Free Monad Web example
import Control.Monad.Free -- from category-extras
data WebF r = Display String r | Form String (String -> r)
instance Functor WebF where
fmap f (Display m r) = Display m (f r)
fmap f (Form m g) = Form m (f . g)
type Web = Free WebF
display :: String -> Web ()
display msg = inFree (Display msg $ return ())
form :: String -> Web String
form msg = inFree (Form msg return)
runWebInteractively :: Web String -> IO ()
runWebInteractively = cataFree runDone runWebF
runDone :: String -> IO ()
runDone x = putStrLn $ "Done: " ++ x
runWebF :: WebF (IO ()) -> IO ()
runWebF (Display msg np) = do
putStrLn msg
np
runWebF (Form msg np) = do
putStrLn msg
putStr "Request> "
r <- getLine
np r
example = do name <- form "Hello, what's your name?"
display $ "Hello, " ++ name
l <- form "Enter numbers seperated by spaces:"
return $ name ++ ", the sum is: " ++ show (sum' l)
runExample = runWebInteractively example
sum' :: String -> Int
sum' = sum . map read . words
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment