[Haskell-cafe] Why aren't there anonymous sum types in Haskell?

David Barbour dmbarbour at gmail.com
Thu Jun 23 03:10:04 CEST 2011


On Wed, Jun 22, 2011 at 1:25 PM, pipoca <eliyahu.ben.miney at gmail.com> wrote:

> Is there any reason why we don't have either anonymous disjoint union
> types, or why some of the proposals here (e.g. type (:|:) a b = Either
> a b ) haven't been implemented, or put into the standard libraries
> (and publicised in beginner texts)?


I know that {-# LANGUAGE TypeOperators #-} has been in GHC for a while, but
I'm not sure how widely accepted among other Haskell implementations it is.

It seems to me that you'd need an additional function:
> either' :: (a -> c) -> (b -> d) -> Either a b -> Either c d
>

 import Control.Arrow (+++, |||)

The '+++' operator from ArrowChoice already does what you need here. And the
'|||' operator is a more generic form of the '???' operator I mentioned
earlier.


> if we want to map a and d over ad using either' to get
> bcef :: [B :|: C :|: E :|: F]
> it wouldn't work, we'd get
> bcef :: [(B :|: C) :|: (E :|: F)]
> instead, which is presumably not what we wanted...
>

Actually, we do want [(B :|: C) :|: (E :|: F)] in this case. It's important
for generic programming.

However, these types are associative, so we could develop a standard set of
re-association operators.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110622/e25d85f8/attachment.htm>


More information about the Haskell-Cafe mailing list