I have little experience with Haskell, but I haven't seen Either used in contexts other than error/success. If you could point me to some piece of code that uses it in a different way it would be great.

One example use case is datatype-generic programming.

> {-# LANGUAGE TypeFamilies #-}

Suppose I have a type class that gives me a unique representation for a type. The functions 'from' and 'to' allow me to convert from a value of that type to a value in its representation. An instance of 'Representable' should encode an isomorphism between some type 'a' and its representation type 'Rep a'. An isomorphism means that we can translate between 'a' and 'Rep a' without losing important information such as the structure of the value.

> class Representable a where
>   type Rep a
>   from :: a -> Rep a
>   to   :: Rep a -> a

I can establish some types from the Haskell Prelude as representations for other types. Here, I use the "unit" type (), 'Either' as is the topic of the current thread, and the pair type (,).

> instance Representable () where
>   type Rep () = ()
>   from = id
>   to = id
> instance (Representable a, Representable b) => Representable (Either a b) where
>   type Rep (Either a b) = Either a b
>   from = id
>   to = id
> instance (Representable a, Representable b) => Representable (a, b) where
>   type Rep (a, b) = (a, b)
>   from = id
>   to = id

The reason that I pick (), 'Either', and (,) is that we can represent many typical Haskell user-defined datatypes with these so-called basic types. A simple example is 'Bool'. In this case, the representation type for 'Bool' is 'Either () ()' since 'Bool' can be either 'True' or 'False'. The constructors of 'Bool' take no arguments, so we can use () to fill in the arguments for the 'Left' and 'Right' constructors of 'Either'.

> instance Representable Bool where
>   type Rep Bool = Either () ()
>   from x = case x of
>     False -> Left ()
>     True  -> Right ()
>   to x = case x of
>     Left ()  -> False
>     Right () -> True

Here is a more interesting example with constructors that take zero, two, and three arguments.

> data MyType a b = Zero | Two a a | Three a b a

In order to represent 'MyType', we use nesting of 'Either' and pairs. This allows us to utilize the basic types defined above to represent more complicated types.

> instance Representable (MyType a b) where
>   type Rep (MyType a b) = Either () (Either (a, a) (a, (b, a)))
>   from x = case x of
>     Zero           -> Left ()
>     Two a1 a2      -> Right (Left (a1, a2))
>     Three a1 b1 a2 -> Right (Right (a1, (b1, a2)))
>   to x = case x of
>     Left ()                      -> Zero
>     Right (Left (a1, a2))        -> Two a1 a2
>     Right (Right (a1, (b1, a2))) -> Three a1 b1 a2

Now, what's the real point of all this? Well, if we can define functions over the basic types (unit, 'Either', and pair), we can easily extend those functions to other types that can be represented by the basic types. Some canonical examples are equality and ordering. There already exist instances for the basic types, so defining instances for 'MyType' is trivial. We simply convert each 'MyType' value into its representation as defined above. The functions then act on the representation value.

> instance (Eq a, Eq b) => Eq (MyType a b) where
>   x == y = from x == from y

> instance (Ord a, Ord b) => Ord (MyType a b) where
>   compare x y = compare (from x) (from y)

You might say that we already have "deriving (Eq, Ord)," and that's true. But the implementation of deriving is specified by the Language Report and built into each compiler. If you come up with a new generic function, you won't have deriving for that. It's also (currently) much easier to write the above than to build a new deriving implementation for a compiler.

There are many examples of generic functions and uses of datatype-generic concepts in Haskell. Just search Hackage for "generics."

Regards,
Sean