# Compose

### From HaskellWiki

DavidHouse (Talk | contribs) (Cont example, props Cale.) |
(composeReader' = foldr local id) |
||

(7 intermediate revisions by 5 users not shown) | |||

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 :: [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>. |
+ | 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 second, and so on. I.e. <hask>compose [(*2), (+1)] 3 = 7</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. |
||

− | == The Sane Solution == |
+ | == The sane solution == |

<haskell> |
<haskell> |
||

compose :: [a -> a] -> a -> a |
compose :: [a -> a] -> a -> a |
||

Line 11: | Line 11: | ||

</haskell> |
</haskell> |
||

− | This one's easy. We fold over the list using composition as our combinator to join items. We flip it, though, because we want a value to be fed into the first function in the list first, but <hask>f . g</hask> applies <hask>g</hask> before <hask>f</hask>. |
+ | This one's easy. We fold over the list using [[Function composition|composition]] as our combinator to join items. We flip it, though, because we want a value to be fed into the first function in the list first, but <hask>f . g</hask> applies <hask>g</hask> before <hask>f</hask>. |

We use <hask>id</hask> as the starting value, as <hask>id</hask> is an identity for composition. |
We use <hask>id</hask> as the starting value, as <hask>id</hask> is an identity for composition. |
||

Line 45: | Line 45: | ||

where compose' [] = ask |
where compose' [] = ask |
||

compose' (f:fs) = local f (compose' fs) |
compose' (f:fs) = local f (compose' fs) |
||

+ | -- compose' = foldr local ask |
||

+ | |||

+ | -- alternative: no runReader or ask required |
||

+ | -- TODO: explain why this works |
||

+ | composeReader' :: [a -> a] -> a -> a |
||

+ | composeReader' = foldr local id |
||

</haskell> |
</haskell> |
||

Line 71: | Line 77: | ||

where compose' [] = return id |
where compose' [] = return id |
||

compose' (f:fs) = censor (. f) (compose' fs) |
compose' (f:fs) = censor (. f) (compose' fs) |
||

+ | -- compose' = foldr (censor . flip (.)) (return id) |
||

</haskell> |
</haskell> |
||

Line 111: | Line 118: | ||

</haskell> |
</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: |
+ | This takes <hask>m</hask>-sized chunks off of <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> |
<haskell> |
||

Line 196: | Line 203: | ||

-} |
-} |
||

</haskell> |
</haskell> |
||

+ | |||

+ | [[Category:Idioms]] |

## Latest revision as of 06:26, 18 September 2008

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 |

## [edit] 1 The sane solution

compose :: [a -> a] -> a -> a compose fs v = foldl (flip (.)) id fs $ v

## [edit] 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.

## [edit] 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) -- compose' = foldr local ask -- alternative: no runReader or ask required -- TODO: explain why this works composeReader' :: [a -> a] -> a -> a composeReader' = foldr local id

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.

## [edit] 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) -- compose' = foldr (censor . flip (.)) (return id)

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## [edit] 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.

## [edit] 6 References

Mainly see All About Monads, specifically chapter two, which has overviews and examples for all the major monads.

## [edit] 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 -}