emgm-0.1: src/Generics/EMGM/Data/Either.hs
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverlappingInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module : Generics.EMGM.Data.Either
-- Copyright : (c) 2008 Universiteit Utrecht
-- License : BSD3
--
-- Maintainer : generics@haskell.org
-- Stability : experimental
-- Portability : non-portable
--
-- Summary: Generic representation and instances for @'Either' a b@.
--
-- This module exports the reusable components of the @'Either' a b@
-- representation. These include the embedding-projection pair used in a type
-- representation as well as the type representation of @'Either' a b@ for
-- 'Generic'.
--
-- This module also exports the instance for the representation dispatcher
-- 'Rep'.
-----------------------------------------------------------------------------
module Generics.EMGM.Data.Either (
-- * Embedding-projection pair
epEither,
-- * Representation
rEither,
) where
import Generics.EMGM.Common
-----------------------------------------------------------------------------
-- Embedding-projection pair
-----------------------------------------------------------------------------
fromEither :: Either a b -> a :+: b
fromEither (Left a) = L a
fromEither (Right b) = R b
toEither :: a :+: b -> Either a b
toEither (L a) = Left a
toEither (R b) = Right b
-- | Embedding-projection pair for @Either a b@
epEither :: EP (Either a b) (a :+: b)
epEither = EP fromEither toEither
-----------------------------------------------------------------------------
-- Representation values
-----------------------------------------------------------------------------
conLeft, conRight :: ConDescr
conLeft = ConDescr "Left" 1 [] Nonfix
conRight = ConDescr "Right" 1 [] Nonfix
-- | Representation for @Either a b@ in 'Generic'
rEither :: (Generic g) => g a -> g b -> g (Either a b)
rEither ra rb = rtype epEither (rcon conLeft ra `rsum` rcon conRight rb)
-----------------------------------------------------------------------------
-- Instance declarations
-----------------------------------------------------------------------------
instance (Generic g, Rep g a, Rep g b) => Rep g (Either a b) where
rep = rEither rep rep