[Haskell-cafe] Monoids and newtypes
David Menendez
dave at zednenem.com
Thu Jan 22 16:02:51 EST 2009
On Thu, Jan 22, 2009 at 10:11 AM, Ketil Malde <ketil at malde.org> wrote:
>
> I was just wondering if not phantom types might serve here as an
> alternative way to go about that. Here's a small example illustrating
> it:
...
> *Monoids> mconcat [1,2::Foo Additive]
> Foo 3
> *Monoids> mconcat [1,2::Foo Multiplicative]
> Foo 2
>
> (This can of course be prettified a bit by omitting the constructor
> from the Show instance).
>
> Any thought about this, pro/contra the newtype method?
I'm not sure that requiring type annotations is less intrusive than
using a wrapper or an explicit dictionary. But there may be types
where this sort of thing makes sense to do.
My favorite alternative to Monoid uses labeled instances.
data Proxy l -- empty, to ensure that labels are never examined
class LMonoid label where
type Carrier label :: *
unit :: Proxy label -> Carrier label
mult :: Proxy label -> Carrier label -> Carrier label -> Carrier label
data Sum a
sum_ :: Proxy (Sum a)
sum_ = undefined
instance Num a => LMonoid (Sum a) where
type Carrier (Sum a) = a
unit _ = 0
mult _ = (+)
-- this works nicely with the writer monad
data Writer l a = W (Carrier l) a
instance (LMonoid l) => Monad (Writer l) where
return a = W (unit (undefined :: Proxy l)) a
(W o1 a) >>= f = let W o2 b = f a in W (mult (undefined :: Proxy l) o1 o2) b
tell :: Carrier l -> Writer l ()
tell x = W x ()
-- and with Foldable
class Foldable f where
fold :: (LMonoid l) => Proxy l -> f (Carrier l) -> Carrier l
-- e.g., fold sum_ [1,2,3]
-- and it works well with Monoid
data Std a
instance (Monoid a) => LMonoid (Std a) where
unit _ = mempty
mult _ = mappend
newtype WrapL l = WrapL (Carrier l)
instance LMonoid l => Monoid (WrapL l) where
mempty = WrapL (unit (undefined :: Proxy l))
mappend (Wrap x) (Wrap y) = WrapL (mult (undefined::l) x y)
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list