[Haskell-cafe] Martin Odersky on "What's wrong with Monads"
Nathan Howell
nathan.d.howell at gmail.com
Wed Jun 27 03:19:14 CEST 2012
On Tue, Jun 26, 2012 at 3:19 PM, Tillmann Rendel
<rendel at informatik.uni-marburg.de> wrote:
> A function to add up all integers in a tree:
>
> amount:: Tree -> Integer
> amount (Leaf x) = x
> amount (Branch t1 t2) = amountt1 + amountt2
>
> All fine so far. Now, consider the following additional requirement: "If the
> command-line flag --multiply is set, the function amount computes the
> product instead of the sum."
>
> How would you implement this requirement in Haskell without changing the
> line "amount (Leaf x) = x"?
One option is to encode the desired behavior at the type level. By
extended the data type slightly and adding a Functor instance,
selecting between a product and a sum can be done using their Monoid
newtypes:
import Data.Monoid
import System.Environment
data Tree a = Leaf a | Branch (Tree a) (Tree a)
instance Functor Tree where
f `fmap` Leaf x = Leaf (f x)
f `fmap` Branch x y = Branch (fmap f x) (fmap f y)
amount :: Monoid a => Tree a -> a
amount (Leaf x) = x
amount (Branch t1 t2) = amount t1 <> amount t2
main :: IO ()
main = do
args <- getArgs
let val :: Tree Int
val = Branch (Leaf 8) (Leaf 18)
let getResult :: Tree Int -> Int
getResult = case args of
["--multiply"] -> getProduct . amount . fmap Product
_ -> getSum . amount . fmap Sum
print . getResult $ val
More information about the Haskell-Cafe
mailing list