[Haskell-cafe] Typeclass with an `or' restriction.

oleg at okmij.org oleg at okmij.org
Sat May 11 07:03:24 CEST 2013


Mateusz Kowalczyk wrote:
> Is there a way however to do something along the lines of:
> > class Eq a => Foo a where bar :: a -> a -> Bool bar = (==)
> >
> > class Num a => Foo a where bar :: a -> a -> Bool bar _ _ = False
> This would allow us to make an instance of Num be an instance of Foo
> or an instance of Eq to be an instance of Foo.

GADTs are a particular good way to constraint disjunction, if you can live
with the closed universe. (In the following example I took a liberty
to replace Int with Ord, to make the example crispier.)

> {-# LANGUAGE GADTs #-}
>
> data OrdEq a where
>     Ord :: Ord a => OrdEq a             -- representation of Ord dict
>     Eq  :: Eq a  => OrdEq a             -- representation of Eq dict
>
> bar :: OrdEq a -> a -> a -> Bool
> bar Ord x y = x > y
> bar Eq  x y = x == y

The function bar has almost the desired signature, only (OrdEq a ->)
has the ordinary arrow rather than the double arrow. We can fix that:

> class Dict a where
>     repr :: OrdEq a
>
> -- We state that for Int, we prefer Ord
> instance Dict Int where
>     repr = Ord
>
> bar' :: Dict a => a -> a -> Bool
> bar' = bar repr
>
> test = bar' (1::Int) 2

I can see the utility of this: something like C++ STL iterators and
algorithms? An algorithm could test if a bidirectional iterator is
available, or it has to do, less efficiently, with unidirectional. Of
course we can use ordinary type classes, at the cost of the
significant repetition. In the OrdEq example above, there are only two
choices of the algorithm for Bar: either the type supports Ord, or the
type supports Eq. So the choice depends on wide sets of types rather
than on types themselves.





More information about the Haskell-Cafe mailing list