--------------------------------------------------------------------------------
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.Class
--------------------------------------------------------------------------------
-- * data type declarations
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 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 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 (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 (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 (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 (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
--------------------------------------------------------------------------------