{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE OverlappingInstances   #-}
{-# OPTIONS -fno-warn-orphans       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.EMGM.Data.Maybe
-- Copyright   :  (c) 2008 Universiteit Utrecht
-- License     :  BSD3
--
-- Maintainer  :  generics@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Generic representation and instances for @'Maybe' a@.
--
-- This module exports the reusable components of the @'Maybe' a@ representation.
-- These include the embedding-projection pair used in a type representation as
-- well as the type representations of @'Maybe' a@ for 'Generic', 'Generic2',
-- and 'Generic3'.
--
-- This module also exports the instances for the representation dispatchers
-- 'Rep', 'FRep', 'FRep2', and 'FRep3'.
--
-----------------------------------------------------------------------------

module Generics.EMGM.Data.Maybe (

  -- * Embedding-projection pair
  epMaybe,

  -- * Representations
  rMaybe,
  rMaybe2,
  rMaybe3,
) where

import Generics.EMGM.Common

-----------------------------------------------------------------------------
-- Embedding-projection pair
-----------------------------------------------------------------------------

fromMaybe :: Maybe a -> Unit :+: a
fromMaybe Nothing   =  L Unit
fromMaybe (Just a)  =  R a

toMaybe :: Unit :+: a -> Maybe a
toMaybe (L Unit)  =  Nothing
toMaybe (R a)     =  Just a

-- | Embedding-projection pair for @Maybe a@
epMaybe :: EP (Maybe a) (Unit :+: a)
epMaybe = EP fromMaybe toMaybe

-----------------------------------------------------------------------------
-- Representation values
-----------------------------------------------------------------------------

conNothing, conJust :: ConDescr
conNothing = ConDescr "Nothing" 0 [] Nonfix
conJust    = ConDescr "Just"    1 [] Nonfix

-- | Representation for @Maybe a@ in 'Generic'
rMaybe :: (Generic g) => g a -> g (Maybe a)
rMaybe ra =
  rtype epMaybe
    (rcon conNothing runit `rsum` rcon conJust ra)

-- | Representation for @Maybe a@ in 'Generic2'
rMaybe2 :: (Generic2 g) => g a b -> g (Maybe a) (Maybe b)
rMaybe2 ra =
  rtype2 epMaybe epMaybe
    (rcon2 conNothing runit2 `rsum2` rcon2 conJust ra)

-- | Representation for @Maybe a@ in 'Generic3'
rMaybe3 :: (Generic3 g) => g a b c -> g (Maybe a) (Maybe b) (Maybe c)
rMaybe3 ra =
  rtype3 epMaybe epMaybe epMaybe
    (rcon3 conNothing runit3 `rsum3` rcon3 conJust ra)

-----------------------------------------------------------------------------
-- Instance declarations
-----------------------------------------------------------------------------

instance (Generic g, Rep g a) => Rep g (Maybe a) where
  rep = rMaybe rep

instance (Generic g) => FRep g Maybe where
  frep = rMaybe

instance (Generic2 g) => FRep2 g Maybe where
  frep2 = rMaybe2

instance (Generic3 g) => FRep3 g Maybe where
  frep3 = rMaybe3