Tuple.hs

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.EMGM.Data.Tuple
-- Copyright   :  (c) 2008 Universiteit Utrecht
-- License     :  BSD3
--
-- Maintainer  :  generics@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Generic representation and instances for tuples of arity 0
-- (a.k.a. unit) and 2 to 7.
--
-- This module exports the reusable components of tuple representations. These
-- include the embedding-projection pair used in a type representation as well
-- as the type representations for 'Generic'.
--
-- This module also exports the instances for the representation dispatcher
-- 'Rep'.
-----------------------------------------------------------------------------

module Generics.EMGM.Data.Tuple (

  -- * Embedding-projection pairs
  epTuple0,
  epTuple2,
  epTuple3,
  epTuple4,
  epTuple5,
  epTuple6,
  epTuple7,

  -- * Representations
  rTuple0,
  rTuple2,
  rTuple3,
  rTuple4,
  rTuple5,
  rTuple6,
  rTuple7,
) where

import Generics.EMGM.Common

-----------------------------------------------------------------------------
-- 0: ()
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @()@
epTuple0 :: EP () Unit
epTuple0 = EP (\() -> Unit)
              (\Unit -> ())

conTuple0 :: ConDescr
conTuple0 = ConDescr "()" 0 [] Nonfix

-- | Representation for @()@ in 'Generic'
rTuple0 :: Generic g => g ()
rTuple0 =
  rtype epTuple0 $
        rcon conTuple0 runit

-----------------------------------------------------------------------------
-- 2: (a,b)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b)@
epTuple2 :: EP (a,b) (a :*: b)
epTuple2 = EP (\(a,b) -> a :*: b)
              (\(a :*: b) -> (a,b))

conTuple2 :: ConDescr
conTuple2 = ConDescr "(,)" 2 [] Nonfix

-- | Representation for @(a,b)@ in 'Generic'
rTuple2 :: Generic g => g a -> g b -> g (a,b)
rTuple2 ra rb =
  rtype epTuple2 $
        rcon conTuple2 (ra `rprod` rb)

-----------------------------------------------------------------------------
-- 3: (a,b,c)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b,c)@
epTuple3 :: EP (a,b,c) (a :*: b :*: c)
epTuple3 = EP (\(a,b,c) -> a :*: b :*: c)
              (\(a :*: b :*: c) -> (a,b,c))

conTuple3 :: ConDescr
conTuple3 = ConDescr "(,,)" 3 [] Nonfix

-- | Representation for @(a,b,c)@ in 'Generic'
rTuple3 :: Generic g => g a -> g b -> g c -> g (a,b,c)
rTuple3 ra rb rc =
  rtype epTuple3 $
        rcon conTuple3 (ra `rprod` rb `rprod` rc)

-----------------------------------------------------------------------------
-- 4: (a,b,c,d)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b,c,d)@
epTuple4 :: EP (a,b,c,d) (a :*: b :*: c :*: d)
epTuple4 = EP (\(a,b,c,d) -> a :*: b :*: c :*: d)
              (\(a :*: b :*: c :*: d) -> (a,b,c,d))

conTuple4 :: ConDescr
conTuple4 = ConDescr "(,,,)" 4 [] Nonfix

-- | Representation for @(a,b,c,d)@ in 'Generic'
rTuple4 :: Generic g => g a -> g b -> g c -> g d -> g (a,b,c,d)
rTuple4 ra rb rc rd =
  rtype epTuple4 $
        rcon conTuple4 (ra `rprod` rb `rprod` rc `rprod` rd)

-----------------------------------------------------------------------------
-- 5: (a,b,c,d,e)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b,c,d,e)@
epTuple5 :: EP (a,b,c,d,e) (a :*: b :*: c :*: d :*: e)
epTuple5 = EP (\(a,b,c,d,e) -> a :*: b :*: c :*: d :*: e)
              (\(a :*: b :*: c :*: d :*: e) -> (a,b,c,d,e))

conTuple5 :: ConDescr
conTuple5 = ConDescr "(,,,,)" 5 [] Nonfix

-- | Representation for @(a,b,c,d,e)@ in 'Generic'
rTuple5 :: Generic g => g a -> g b -> g c -> g d -> g e -> g (a,b,c,d,e)
rTuple5 ra rb rc rd re =
  rtype epTuple5 $
        rcon conTuple5 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re)

-----------------------------------------------------------------------------
-- 6: (a,b,c,d,e,f)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b,c,d,e,f)@
epTuple6 :: EP (a,b,c,d,e,f) (a :*: b :*: c :*: d :*: e :*: f)
epTuple6 = EP (\(a,b,c,d,e,f) -> a :*: b :*: c :*: d :*: e :*: f)
              (\(a :*: b :*: c :*: d :*: e :*: f) -> (a,b,c,d,e,f))

conTuple6 :: ConDescr
conTuple6 = ConDescr "(,,,,,)" 6 [] Nonfix

-- | Representation for @(a,b,c,d,e,f)@ in 'Generic'
rTuple6 :: Generic g => g a -> g b -> g c -> g d -> g e -> g f -> g (a,b,c,d,e,f)
rTuple6 ra rb rc rd re rf =
  rtype epTuple6 $
        rcon conTuple6 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re `rprod` rf)


-----------------------------------------------------------------------------
-- 7: (a,b,c,d,e,f,h)
-----------------------------------------------------------------------------

-- | Embedding-projection pair for @(a,b,c,d,e,f,h)@
epTuple7 :: EP (a,b,c,d,e,f,h) (a :*: b :*: c :*: d :*: e :*: f :*: h)
epTuple7 = EP (\(a,b,c,d,e,f,h) -> a :*: b :*: c :*: d :*: e :*: f :*: h)
              (\(a :*: b :*: c :*: d :*: e :*: f :*: h) -> (a,b,c,d,e,f,h))

conTuple7 :: ConDescr
conTuple7 = ConDescr "(,,,,,)" 7 [] Nonfix

-- | Representation for @(a,b,c,d,e,f,h)@ in 'Generic'
rTuple7 :: Generic g => g a -> g b -> g c -> g d -> g e -> g f -> g h -> g (a,b,c,d,e,f,h)
rTuple7 ra rb rc rd re rf rh =
  rtype epTuple7 $
        rcon conTuple7 (ra `rprod` rb `rprod` rc `rprod` rd `rprod` re `rprod` rf `rprod` rh)

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

instance (Generic g) => Rep g () where
  rep = rTuple0

instance (Generic g, Rep g a, Rep g b) => Rep g (a,b) where
  rep = rTuple2 rep rep

instance (Generic g, Rep g a, Rep g b, Rep g c) => Rep g (a,b,c) where
  rep = rTuple3 rep rep rep

instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d) => Rep g (a,b,c,d) where
  rep = rTuple4 rep rep rep rep

instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e) => Rep g (a,b,c,d,e) where
  rep = rTuple5 rep rep rep rep rep

instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f) => Rep g (a,b,c,d,e,f) where
  rep = rTuple6 rep rep rep rep rep rep

instance (Generic g, Rep g a, Rep g b, Rep g c, Rep g d, Rep g e, Rep g f, Rep g h) => Rep g (a,b,c,d,e,f,h) where
  rep = rTuple7 rep rep rep rep rep rep rep