Compose
From HaskellWiki
(typo and a bit of extra detail) |
(Cont example, props Cale.) |
||
| Line 1: | Line 1: | ||
<hask>Compose</hask> is a nice little module which shows off some of the features of the various monads around. | <hask>Compose</hask> is a nice little module which shows off some of the features of the various monads around. | ||
| - | The task is to write a function <hask>compose :: [ | + | The task is to write a function <hask>compose :: [a -> a] -> (a -> a)</hask>, which should take a list of functions and chain them together: a value would be fed into the first, which then produces a new value, which is fed into the third, and so on. I.e. <hask>compose [(*2), (+1)] 3 = 8</hask>. |
This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated. | This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated. | ||
| Line 7: | Line 7: | ||
== The Sane Solution == | == The Sane Solution == | ||
<haskell> | <haskell> | ||
| - | compose :: [ | + | compose :: [a -> a] -> a -> a |
compose fs v = foldl (flip (.)) id fs $ v | compose fs v = foldl (flip (.)) id fs $ v | ||
</haskell> | </haskell> | ||
| Line 17: | Line 17: | ||
== Using <hask>State</hask> == | == Using <hask>State</hask> == | ||
<haskell> | <haskell> | ||
| - | composeState :: [ | + | composeState :: [a -> a] -> a -> a |
composeState = execState . mapM modify | composeState = execState . mapM modify | ||
</haskell> | </haskell> | ||
| Line 41: | Line 41: | ||
== Using <hask>Reader</hask> == | == Using <hask>Reader</hask> == | ||
<haskell> | <haskell> | ||
| - | composeReader :: [ | + | composeReader :: [a -> a] -> a -> a |
composeReader fs v = runReader (compose' fs) v | composeReader fs v = runReader (compose' fs) v | ||
where compose' [] = ask | where compose' [] = ask | ||
| Line 67: | Line 67: | ||
== Using <hask>Writer</hask> == | == Using <hask>Writer</hask> == | ||
<haskell> | <haskell> | ||
| - | composeWriter :: [ | + | composeWriter :: [a -> a] -> a -> a |
composeWriter fs v = (execWriter $ compose' fs) v | composeWriter fs v = (execWriter $ compose' fs) v | ||
where compose' [] = return id | where compose' [] = return id | ||
| Line 82: | Line 82: | ||
== Using <hask>Cont</hask> == | == Using <hask>Cont</hask> == | ||
| - | + | The <hask>Cont</hask> example is so complicated it needs its own helper functions! | |
| + | |||
| + | <haskell> | ||
| + | getCC :: MonadCont m => m (m a) | ||
| + | getCC = callCC (\c -> let x = c x in return x) | ||
| + | getCC' :: MonadCont m => a -> m (a, a -> m b) | ||
| + | getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f) | ||
| + | </haskell> | ||
| + | |||
| + | These are rather complex if you don't know CPS and the <hask>Cont</hask> monad well already, but essentially they create a GOTO-style checkpoint. You can use a do-block something along these lines: | ||
| + | |||
| + | <haskell> | ||
| + | do stuff; | ||
| + | boing <- getCC | ||
| + | moreStuff; | ||
| + | boing; | ||
| + | </haskell> | ||
| + | |||
| + | And you'll pop back up to <hask>boing</hask>. <hask>getCC'</hask> is similar, but it lets you use a parameter. Again, to exemplify: | ||
| + | |||
| + | <haskell> | ||
| + | x `modulo` m = (`runContT` return) $ do (u, jump) <- getCC' x | ||
| + | lift $ print u | ||
| + | case u of | ||
| + | _ | u < 0 -> jump (u + m) | ||
| + | | u >= m -> jump (u - m) | ||
| + | | otherwise -> return u | ||
| + | </haskell> | ||
| + | |||
| + | This take <hask>m</hask>-sized chunks off <hask>u</hask> (which starts off being <hask>x</hask>) until <hask>u</hask> is in range. Right, on to the actual <hask>compose</hask> itself: | ||
| + | |||
| + | <haskell> | ||
| + | composeCont :: [a -> a] -> a -> a | ||
| + | composeCont fs = runCont compose' id | ||
| + | where compose' = do ((gs,f), jump) <- getCC' (fs,id) | ||
| + | case gs of | ||
| + | [] -> return f | ||
| + | (g:gs') -> jump (gs', g . f) | ||
| + | </haskell> | ||
| + | |||
| + | This is similar to the <hask>modulo</hask> loop above, but uses a pair as the passed parameter. It walks down the list, accumulating the composition chain. Instead of building a composition chain, it is possible to act on the value directly, a bit like with the <hask>State</hask> example: | ||
| + | |||
| + | <haskell> | ||
| + | composeCont :: [a -> a] -> a -> a | ||
| + | composeCont fs x = runCont compose' id | ||
| + | where compose' = do ((gs,y), jump) <- getCC' (fs,x) | ||
| + | case gs of | ||
| + | [] -> return y | ||
| + | (g:gs') -> jump (gs', g y) | ||
| + | </haskell> | ||
| + | |||
| + | Thanks to Cale Gibbard for providing this example. | ||
== References == | == References == | ||
| Line 98: | Line 149: | ||
import Control.Monad.Reader | import Control.Monad.Reader | ||
import Control.Monad.State | import Control.Monad.State | ||
| + | import Control.Monad.Cont | ||
| - | compose :: [ | + | compose :: [a -> a] -> a -> a |
compose fs v = foldl (flip (.)) id fs $ v | compose fs v = foldl (flip (.)) id fs $ v | ||
| - | composeState :: [ | + | composeState :: [a -> a] -> a -> a |
composeState = execState . mapM modify | composeState = execState . mapM modify | ||
| - | composeReader :: [ | + | composeReader :: [a -> a] -> a -> a |
composeReader fs v = runReader (compose' fs) v | composeReader fs v = runReader (compose' fs) v | ||
where compose' [] = ask | where compose' [] = ask | ||
compose' (f:fs) = local f (compose' fs) | compose' (f:fs) = local f (compose' fs) | ||
| - | composeWriter :: [ | + | composeWriter :: [a -> a] -> a -> a |
composeWriter fs v = (execWriter $ compose' fs) v | composeWriter fs v = (execWriter $ compose' fs) v | ||
where compose' [] = return id | where compose' [] = return id | ||
compose' (f:fs) = censor (. f) (compose' fs) | compose' (f:fs) = censor (. f) (compose' fs) | ||
| + | |||
| + | getCC :: MonadCont m => m (m a) | ||
| + | getCC = callCC (\c -> let x = c x in return x) | ||
| + | getCC' :: MonadCont m => a -> m (a, a -> m b) | ||
| + | getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f)) | ||
| + | |||
| + | composeCont :: [a -> a] -> a -> a | ||
| + | composeCont fs = runCont compose' id | ||
| + | where compose' = do ((gs,f), jump) <- getCC' (fs,id) | ||
| + | case gs of | ||
| + | [] -> return f | ||
| + | (g:gs') -> jump (gs',g . f) | ||
main = do let fs = [(+1), (*2), \n -> (n - 5) * 4] | main = do let fs = [(+1), (*2), \n -> (n - 5) * 4] | ||
| Line 121: | Line 185: | ||
putStrLn $ "composeReader: " ++ (show $ composeReader fs v) | putStrLn $ "composeReader: " ++ (show $ composeReader fs v) | ||
putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v) | putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v) | ||
| + | putStrLn $ "composeCont: " ++ (show $ composeCont fs v) | ||
{- | {- | ||
| Line 128: | Line 193: | ||
composeReader: 12 | composeReader: 12 | ||
composeWriter: 12 | composeWriter: 12 | ||
| + | composeCont: 12 | ||
-} | -} | ||
</haskell> | </haskell> | ||
Revision as of 22:47, 14 May 2006
This page illustrates the solution in different monads. Most are a bit of a joke; you'd probably only ever use the first solution presented, but nevertheless the nice features of the various monads are demonstrated.
Contents |
1 The Sane Solution
compose :: [a -> a] -> a -> a compose fs v = foldl (flip (.)) id fs $ v
2 Using State
composeState :: [a -> a] -> a -> a composeState = execState . mapM modify
composeState fs v = execState (mapM modify fs) v
fs = mapM modify [(*2), (+1), \n -> (n - 5) * 4] -- fs is entirely equivalent to the following do-block: fs' = do modify (*2) modify (+1) modify (\n -> (n - 5) * 4)
In other words, we obtain a stateful computation that modifies the state with the first function in the list, then the second, and so on.
3 Using Reader
composeReader :: [a -> a] -> a -> a composeReader fs v = runReader (compose' fs) v where compose' [] = ask compose' (f:fs) = local f (compose' fs)
fs = compose' [(*2), (+1), \n -> (n - 5) * 4] -- again, this is entirely equivalent to the following: fs' = local (*2) $ local (+1) $ local (\n -> (n - 5) * 4) ask
Once this composition has been built up, we run it, starting off with an environment of the starting value.
4 Using Writer
composeWriter :: [a -> a] -> a -> a composeWriter fs v = (execWriter $ compose' fs) v where compose' [] = return id compose' (f:fs) = censor (. f) (compose' fs)
Once this computation has been built up, we extract this long composition chain, and apply it to our starting value.
Also interesting to note is that this method is really equivalent to the "Sane method" described above. We just iterate along the list, accumulating a composition chain. The only difference here is that we're using some of 5 Using Cont
The getCC :: MonadCont m => m (m a) getCC = callCC (\c -> let x = c x in return x) getCC' :: MonadCont m => a -> m (a, a -> m b) getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f)
do stuff; boing <- getCC moreStuff; boing;
x `modulo` m = (`runContT` return) $ do (u, jump) <- getCC' x lift $ print u case u of _ | u < 0 -> jump (u + m) | u >= m -> jump (u - m) | otherwise -> return u
composeCont :: [a -> a] -> a -> a composeCont fs = runCont compose' id where compose' = do ((gs,f), jump) <- getCC' (fs,id) case gs of [] -> return f (g:gs') -> jump (gs', g . f)
composeCont :: [a -> a] -> a -> a composeCont fs x = runCont compose' id where compose' = do ((gs,y), jump) <- getCC' (fs,x) case gs of [] -> return y (g:gs') -> jump (gs', g y)
Thanks to Cale Gibbard for providing this example.
6 References
Mainly see All About Monads, specifically chapter two, which has overviews and examples for all the major monads.
7 The whole code
In case you wish to run this code, here it is in its entirety:
-- Thread a value through a list of function applications module Compose where import Control.Monad.Writer import Control.Monad.Reader import Control.Monad.State import Control.Monad.Cont compose :: [a -> a] -> a -> a compose fs v = foldl (flip (.)) id fs $ v composeState :: [a -> a] -> a -> a composeState = execState . mapM modify composeReader :: [a -> a] -> a -> a composeReader fs v = runReader (compose' fs) v where compose' [] = ask compose' (f:fs) = local f (compose' fs) composeWriter :: [a -> a] -> a -> a composeWriter fs v = (execWriter $ compose' fs) v where compose' [] = return id compose' (f:fs) = censor (. f) (compose' fs) getCC :: MonadCont m => m (m a) getCC = callCC (\c -> let x = c x in return x) getCC' :: MonadCont m => a -> m (a, a -> m b) getCC' x0 = callCC (\c -> let f x = c (x, f) in return (x0, f)) composeCont :: [a -> a] -> a -> a composeCont fs = runCont compose' id where compose' = do ((gs,f), jump) <- getCC' (fs,id) case gs of [] -> return f (g:gs') -> jump (gs',g . f) main = do let fs = [(+1), (*2), \n -> (n - 5) * 4] v = 3 putStrLn $ "compose: " ++ (show $ compose fs v) putStrLn $ "compostState: " ++ (show $ composeState fs v) putStrLn $ "composeReader: " ++ (show $ composeReader fs v) putStrLn $ "composeWriter: " ++ (show $ composeWriter fs v) putStrLn $ "composeCont: " ++ (show $ composeCont fs v) {- *Compose> main compose: 12 compostState: 12 composeReader: 12 composeWriter: 12 composeCont: 12 -}
