{-# 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