[Haskell-cafe] Fwd: Martin Odersky on "What's wrong with Monads"
Strake
strake888 at gmail.com
Thu Jun 28 17:51:18 CEST 2012
On 26/06/2012, Nathan Howell <nathan.d.howell at gmail.com> wrote:
> On Tue, Jun 26, 2012 at 3:19 PM, Tillmann Rendel
> <rendel at informatik.uni-marburg.de> wrote:
>> 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: ...
Better yet, use foldMap:
> import Data.Monoid
> import Data.Foldable
> 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)
> instance Foldable Tree where
> foldMap f (Leaf x) = f x
> foldMap f (Branch s t) = foldMap f s <> foldMap f t
> 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 . foldMap Product
> _ -> getSum . foldMap Sum
> print . getResult $ val
Yet better yet:
> {-# LANGUAGE DeriveFunctor, DeriveFoldable #-}
> import Data.Monoid;
> import Data.Foldable;
> import System.Environment
> data Tree a = Leaf a | Branch (Tree a) (Tree a)
> deriving (Functor, Foldable);
> ...
(^_^)
--
Strake
More information about the Haskell-Cafe
mailing list