[Haskell-cafe] Could someone teach me why we use Data.Monoid?

Gregory Collins greg at gregorycollins.net
Fri Nov 13 12:57:20 EST 2009


Magicloud Magiclouds <magicloud.magiclouds at gmail.com> writes:

> I see. Then what is about Dual and Endo? Especially Endo, I completely
> confused....

It should help to look at the instances:

> -- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
> newtype Dual a = Dual { getDual :: a }
>         deriving (Eq, Ord, Read, Show, Bounded)
> 
> instance Monoid a => Monoid (Dual a) where
>         mempty = Dual mempty
>         Dual x `mappend` Dual y = Dual (y `mappend` x)

You can tag a monoidal value as being "Dual" and then invoking "mappend"
will swap the argument order.

Re: Endo:

> -- | The monoid of endomorphisms under composition.
> newtype Endo a = Endo { appEndo :: a -> a }
> 
> instance Monoid (Endo a) where
>         mempty = Endo id
>         Endo f `mappend` Endo g = Endo (f . g)

It's a way of labelling functions of type a -> a ("endomorphism") as
being a monoid under composition (the "." operator). A short example:

> GHCi, version 6.10.4: http://www.haskell.org/ghc/  :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer ... linking ... done.
> Loading package base ... linking ... done.
> Prelude> import Data.Monoid
> Prelude Data.Monoid> let f = ((+2) :: Double -> Double)
> Prelude Data.Monoid> let g = ((/4) :: Double -> Double)
> Prelude Data.Monoid> appEndo (Endo f `mappend` Endo g) 4
> 3.0

same as "(f . g) 4" == 4/4 + 2

> Prelude Data.Monoid> appEndo (getDual (Dual (Endo f) `mappend` Dual (Endo g))) 4
> 1.5

same as "(g . f) 4" == (4+2)/4.

G.
-- 
Gregory Collins <greg at gregorycollins.net>


More information about the Haskell-Cafe mailing list