Compose
From HaskellWiki
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 build up, we extract this long composition chain, and apply it to our starting value.
5 Using Cont
I'm pretty sure this could be done, but I don't have a clue how! If you know 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 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) 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) {- *Compose> main compose: 12 compostState: 12 composeReader: 12 composeWriter: 12 -}
