-- |
-- Module      : Foundation.Tuple
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Foundation.Tuple
    ( Tuple2(..)
    , Tuple3(..)
    , Tuple4(..)
    , Fstable(..)
    , Sndable(..)
    , Thdable(..)
    ) where

import Foundation.Internal.Base
import Foundation.Class.Bifunctor
import Foundation.Primitive

-- | Strict tuple (a,b)
data Tuple2 a b = Tuple2 !a !b
    deriving (Show,Eq,Ord,Typeable,Data,Generic)

instance (NormalForm a, NormalForm b) => NormalForm (Tuple2 a b) where
    toNormalForm (Tuple2 a b) = toNormalForm a `seq` toNormalForm b
instance Bifunctor Tuple2 where
  bimap f g (Tuple2 a b) = Tuple2 (f a) (g b)

-- | Strict tuple (a,b,c)
data Tuple3 a b c = Tuple3 !a !b !c
    deriving (Show,Eq,Ord,Typeable,Data,Generic)

instance (NormalForm a, NormalForm b, NormalForm c) => NormalForm (Tuple3 a b c) where
    toNormalForm (Tuple3 a b c) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c

-- | Strict tuple (a,b,c,d)
data Tuple4 a b c d = Tuple4 !a !b !c !d
    deriving (Show,Eq,Ord,Typeable,Data,Generic)

instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d)
      => NormalForm (Tuple4 a b c d) where
    toNormalForm (Tuple4 a b c d) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d

-- | Class of product types that have a first element
class Fstable a where
    type ProductFirst a
    fst :: a -> ProductFirst a

-- | Class of product types that have a second element
class Sndable a where
    type ProductSecond a
    snd :: a -> ProductSecond a

-- | Class of product types that have a third element
class Thdable a where
    type ProductThird a
    thd :: a -> ProductThird a

instance Fstable (a,b) where
    type ProductFirst (a,b) = a
    fst (a,_) = a
instance Fstable (a,b,c) where
    type ProductFirst (a,b,c) = a
    fst (a,_,_) = a
instance Fstable (a,b,c,d) where
    type ProductFirst (a,b,c,d) = a
    fst (a,_,_,_) = a
instance Fstable (Tuple2 a b) where
    type ProductFirst (Tuple2 a b) = a
    fst (Tuple2 a _) = a
instance Fstable (Tuple3 a b c) where
    type ProductFirst (Tuple3 a b c) = a
    fst (Tuple3 a _ _) = a
instance Fstable (Tuple4 a b c d) where
    type ProductFirst (Tuple4 a b c d) = a
    fst (Tuple4 a _ _ _) = a

instance Sndable (a,b) where
    type ProductSecond (a,b) = b
    snd (_,b) = b
instance Sndable (a,b,c) where
    type ProductSecond (a,b,c) = b
    snd (_,b,_) = b
instance Sndable (a,b,c,d) where
    type ProductSecond (a,b,c,d) = b
    snd (_,b,_,_) = b
instance Sndable (Tuple2 a b) where
    type ProductSecond (Tuple2 a b) = b
    snd (Tuple2 _ b) = b
instance Sndable (Tuple3 a b c) where
    type ProductSecond (Tuple3 a b c) = b
    snd (Tuple3 _ b _) = b
instance Sndable (Tuple4 a b c d) where
    type ProductSecond (Tuple4 a b c d) = b
    snd (Tuple4 _ b _ _) = b

instance Thdable (a,b,c) where
    type ProductThird (a,b,c) = c
    thd (_,_,c) = c
instance Thdable (a,b,c,d) where
    type ProductThird (a,b,c,d) = c
    thd (_,_,c,_) = c
instance Thdable (Tuple3 a b c) where
    type ProductThird (Tuple3 a b c) = c
    thd (Tuple3 _ _ c) = c
instance Thdable (Tuple4 a b c d) where
    type ProductThird (Tuple4 a b c d) = c
    thd (Tuple4 _ _ c _) = c