--------------------------------------------------------------------------------

import Control.Applicative

import Data.List
import Data.Foldable
import Data.Traversable
import Data.Monoid

import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal

import Data.Tup.Tup.Class

--------------------------------------------------------------------------------
-- * data type declarations

data Tup0 a = Tup0                    deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup1 a = Tup1 A                  deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup2 a = Tup2 A A                deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup3 a = Tup3 A A A              deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup4 a = Tup4 A A A A            deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup5 a = Tup5 A A A A A          deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup6 a = Tup6 A A A A A A        deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup7 a = Tup7 A A A A A A A      deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup8 a = Tup8 A A A A A A A A    deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
data Tup9 a = Tup9 A A A A A A A A A  deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)

--------------------------------------------------------------------------------
-- * \"tupping\"

tupTup :: Applicative f => f a -> f a -> f (Tup2 a)
tupTup t1 t2 = Tup2 <$> t1 <*> t2

tupTup3 :: Applicative f => f a -> f a -> f a -> f (Tup3 a)
tupTup3 t1 t2 t3 = Tup3 <$> t1 <*> t2 <*> t3

tupTup4 :: Applicative f => f a -> f a -> f a -> f a -> f (Tup4 a)
tupTup4 t1 t2 t3 t4 = Tup4 <$> t1 <*> t2 <*> t3 <*> t4

tupTup5 :: Applicative f => f a -> f a -> f a -> f a -> f a -> f (Tup5 a)
tupTup5 t1 t2 t3 t4 t5 = Tup5 <$> t1 <*> t2 <*> t3 <*> t4 <*> t5

--------------------------------------------------------------------------------
-- * instances

instance Tup Tup0 where
  tupSize _ = 0
  tupToList (Tup0) = []
  tupFromList [] = Tup0
  tupFromList _ = error "tupFromList: list should have length 0"

instance Tup Tup1 where
  tupSize _ = 1
  tupToList (Tup1 x1) = [x1]
  tupFromList [x1] = Tup1 x1
  tupFromList _ = error "tupFromList: list should have length 1"

instance Tup Tup2 where
  tupSize _ = 2
  tupToList (Tup2 x1 x2) = [x1,x2]
  tupFromList [x1,x2] = Tup2 x1 x2
  tupFromList _ = error "tupFromList: list should have length 2"

instance Tup Tup3 where
  tupSize _ = 3
  tupToList (Tup3 x1 x2 x3) = [x1,x2,x3]
  tupFromList [x1,x2,x3] = Tup3 x1 x2 x3
  tupFromList _ = error "tupFromList: list should have length 3"

instance Tup Tup4 where
  tupSize _ = 4
  tupToList (Tup4 x1 x2 x3 x4) = [x1,x2,x3,x4]
  tupFromList [x1,x2,x3,x4] = Tup4 x1 x2 x3 x4
  tupFromList _ = error "tupFromList: list should have length 4"

instance Tup Tup5 where
  tupSize _ = 5
  tupToList (Tup5 x1 x2 x3 x4 x5) = [x1,x2,x3,x4,x5]
  tupFromList [x1,x2,x3,x4,x5] = Tup5 x1 x2 x3 x4 x5
  tupFromList _ = error "tupFromList: list should have length 5"

instance Tup Tup6 where
  tupSize _ = 6
  tupToList (Tup6 x1 x2 x3 x4 x5 x6) = [x1,x2,x3,x4,x5,x6]
  tupFromList [x1,x2,x3,x4,x5,x6] = Tup6 x1 x2 x3 x4 x5 x6
  tupFromList _ = error "tupFromList: list should have length 6"

instance Tup Tup7 where
  tupSize _ = 7
  tupToList (Tup7 x1 x2 x3 x4 x5 x6 x7) = [x1,x2,x3,x4,x5,x6,x7]
  tupFromList [x1,x2,x3,x4,x5,x6,x7] = Tup7 x1 x2 x3 x4 x5 x6 x7
  tupFromList _ = error "tupFromList: list should have length 7"

instance Tup Tup8 where
  tupSize _ = 8
  tupToList (Tup8 x1 x2 x3 x4 x5 x6 x7 x8) = [x1,x2,x3,x4,x5,x6,x7,x8]
  tupFromList [x1,x2,x3,x4,x5,x6,x7,x8] = Tup8 x1 x2 x3 x4 x5 x6 x7 x8
  tupFromList _ = error "tupFromList: list should have length 8"

instance Tup Tup9 where
  tupSize _ = 9
  tupToList (Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9) = [x1,x2,x3,x4,x5,x6,x7,x8,x9]
  tupFromList [x1,x2,x3,x4,x5,x6,x7,x8,x9] = Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9
  tupFromList _ = error "tupFromList: list should have length 9"

--------------------------------------------------------------------------------

instance Applicative Tup0 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup0
  Tup0 <*> Tup0 = Tup0 

instance Applicative Tup1 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup1 x
  Tup1 f1 <*> Tup1 x1 = Tup1 (f1 x1)

instance Applicative Tup2 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup2 x x
  Tup2 f1 f2 <*> Tup2 x1 x2 = Tup2 (f1 x1) (f2 x2)

instance Applicative Tup3 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup3 x x x
  Tup3 f1 f2 f3 <*> Tup3 x1 x2 x3 = Tup3 (f1 x1) (f2 x2) (f3 x3)

instance Applicative Tup4 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup4 x x x x
  Tup4 f1 f2 f3 f4 <*> Tup4 x1 x2 x3 x4 = Tup4 (f1 x1) (f2 x2) (f3 x3) (f4 x4)

instance Applicative Tup5 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup5 x x x x x
  Tup5 f1 f2 f3 f4 f5 <*> Tup5 x1 x2 x3 x4 x5 = Tup5 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5)

instance Applicative Tup6 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup6 x x x x x x
  Tup6 f1 f2 f3 f4 f5 f6 <*> Tup6 x1 x2 x3 x4 x5 x6 = Tup6 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6)

instance Applicative Tup7 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup7 x x x x x x x
  Tup7 f1 f2 f3 f4 f5 f6 f7 <*> Tup7 x1 x2 x3 x4 x5 x6 x7 
    = Tup7 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7)

instance Applicative Tup8 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup8 x x x x x x x x
  Tup8 f1 f2 f3 f4 f5 f6 f7 f8 <*> Tup8 x1 x2 x3 x4 x5 x6 x7 x8 
    = Tup8 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8)

instance Applicative Tup9 where
  {-# INLINE pure  #-}
  {-# INLINE (<*>) #-}
  pure x = Tup9 x x x x x x x x x
  Tup9 f1 f2 f3 f4 f5 f6 f7 f8 f9 <*> Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9 
    = Tup9 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8) (f9 x9)

--------------------------------------------------------------------------------

#define NUM_INSTANCE                   \
  { t1 + t2 = (+) <$> t1 <*> t2        \
  ; t1 - t2 = (-) <$> t1 <*> t2        \
  ; t1 * t2 = (*) <$> t1 <*> t2        \
  ; abs    = fmap abs                  \
  ; signum = fmap signum               \
  ; fromInteger = pure . fromInteger }

instance Num a => Num (Tup0 a) where NUM_INSTANCE
instance Num a => Num (Tup1 a) where NUM_INSTANCE
instance Num a => Num (Tup2 a) where NUM_INSTANCE
instance Num a => Num (Tup3 a) where NUM_INSTANCE
instance Num a => Num (Tup4 a) where NUM_INSTANCE
instance Num a => Num (Tup5 a) where NUM_INSTANCE
instance Num a => Num (Tup6 a) where NUM_INSTANCE
instance Num a => Num (Tup7 a) where NUM_INSTANCE
instance Num a => Num (Tup8 a) where NUM_INSTANCE
instance Num a => Num (Tup9 a) where NUM_INSTANCE

--------------------------------------------------------------------------------

#define FRACTIONAL_INSTANCE              \
  { t1 / t2 = (/) <$> t1 <*> t2          \
  ; recip   = fmap recip                 \
  ; fromRational = pure . fromRational }

instance Fractional a => Fractional (Tup0 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup1 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup2 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup3 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup4 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup5 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup6 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup7 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup8 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (Tup9 a) where FRACTIONAL_INSTANCE

--------------------------------------------------------------------------------

#define MONOID_INSTANCE                     \
  { mempty = pure mempty                    \
  ; mappend t1 t2 = mappend <$> t1 <*> t2 } 

instance Monoid a => Monoid (Tup0 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup1 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup2 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup3 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup4 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup5 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup6 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup7 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup8 a) where MONOID_INSTANCE
instance Monoid a => Monoid (Tup9 a) where MONOID_INSTANCE

--------------------------------------------------------------------------------

#define STORABLE_INSTANCE                                 \
  { sizeOf    t = tupSize t * sizeOf (tupUndef t)         \
  ; alignment t = alignment (tupUndef t)                  \
  ; peek ptr    = let { ptrUndef :: Ptr b -> b ; ptrUndef _ = undefined }              \
                  in  tupFromList <$> peekArray (tupSize $ ptrUndef ptr) (castPtr ptr) \
  ; poke ptr t  = pokeArray (castPtr ptr) (tupToList t) }

instance Storable a => Storable (Tup0 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup1 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup2 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup3 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup4 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup5 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup6 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup7 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup8 a) where STORABLE_INSTANCE
instance Storable a => Storable (Tup9 a) where STORABLE_INSTANCE

--------------------------------------------------------------------------------