module Data.Tup.Newtype where
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 NTup0 a = NTup0 deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup1 a = NTup1 a deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup2 a = NTup2 (a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup3 a = NTup3 (a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup4 a = NTup4 (a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup5 a = NTup5 (a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup6 a = NTup6 (a,a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup7 a = NTup7 (a,a,a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup8 a = NTup8 (a,a,a,a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
newtype NTup9 a = NTup9 (a,a,a,a,a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
ntup0 :: NTup0 a
ntup0 = NTup0
ntup1 :: a -> NTup1 a
ntup1 x1 = NTup1 x1
ntup2 :: a -> a -> NTup2 a
ntup2 x1 x2 = NTup2 (x1,x2)
ntup3 :: a -> a -> a -> NTup3 a
ntup3 x1 x2 x3 = NTup3 (x1,x2,x3)
ntup4 :: a -> a -> a -> a -> NTup4 a
ntup4 x1 x2 x3 x4 = NTup4 (x1,x2,x3,x4)
ntup5 :: a -> a -> a -> a -> a -> NTup5 a
ntup5 x1 x2 x3 x4 x5 = NTup5 (x1,x2,x3,x4,x5)
ntup6 :: a -> a -> a -> a -> a -> a -> NTup6 a
ntup6 x1 x2 x3 x4 x5 x6 = NTup6 (x1,x2,x3,x4,x5,x6)
ntup7 :: a -> a -> a -> a -> a -> a -> a -> NTup7 a
ntup7 x1 x2 x3 x4 x5 x6 x7 = NTup7 (x1,x2,x3,x4,x5,x6,x7)
ntup8 :: a -> a -> a -> a -> a -> a -> a -> a -> NTup8 a
ntup8 x1 x2 x3 x4 x5 x6 x7 x8 = NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
ntup9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> NTup9 a
ntup9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
untup1 :: NTup1 a -> a
untup1 (NTup1 t) = t
untup2 :: NTup2 a -> (a,a)
untup2 (NTup2 t) = t
untup3 :: NTup3 a -> (a,a,a)
untup3 (NTup3 t) = t
untup4 :: NTup4 a -> (a,a,a,a)
untup4 (NTup4 t) = t
untup5 :: NTup5 a -> (a,a,a,a,a)
untup5 (NTup5 t) = t
untup6 :: NTup6 a -> (a,a,a,a,a,a)
untup6 (NTup6 t) = t
untup7 :: NTup7 a -> (a,a,a,a,a,a,a)
untup7 (NTup7 t) = t
untup8 :: NTup8 a -> (a,a,a,a,a,a,a,a)
untup8 (NTup8 t) = t
untup9 :: NTup9 a -> (a,a,a,a,a,a,a,a,a)
untup9 (NTup9 t) = t
instance Tup NTup0 where
tupSize _ = 0
tupToList _ = []
tupFromList [] = NTup0
tupFromList _ = error "tupFromList: list should have length 0"
instance Tup NTup1 where
tupSize _ = 1
tupToList (NTup1 x1) = [x1]
tupFromList [x1] = NTup1 x1
tupFromList _ = error "tupFromList: list should have length 1"
instance Tup NTup2 where
tupSize _ = 2
tupToList (NTup2 (x1,x2)) = [x1,x2]
tupFromList [x1,x2] = NTup2 (x1,x2)
tupFromList _ = error "tupFromList: list should have length 2"
instance Tup NTup3 where
tupSize _ = 3
tupToList (NTup3 (x1,x2,x3)) = [x1,x2,x3]
tupFromList [x1,x2,x3] = NTup3 (x1,x2,x3)
tupFromList _ = error "tupFromList: list should have length 3"
instance Tup NTup4 where
tupSize _ = 4
tupToList (NTup4 (x1,x2,x3,x4)) = [x1,x2,x3,x4]
tupFromList [x1,x2,x3,x4] = NTup4 (x1,x2,x3,x4)
tupFromList _ = error "tupFromList: list should have length 4"
instance Tup NTup5 where
tupSize _ = 5
tupToList (NTup5 (x1,x2,x3,x4,x5)) = [x1,x2,x3,x4,x5]
tupFromList [x1,x2,x3,x4,x5] = NTup5 (x1,x2,x3,x4,x5)
tupFromList _ = error "tupFromList: list should have length 5"
instance Tup NTup6 where
tupSize _ = 6
tupToList (NTup6 (x1,x2,x3,x4,x5,x6)) = [x1,x2,x3,x4,x5,x6]
tupFromList [x1,x2,x3,x4,x5,x6] = NTup6 (x1,x2,x3,x4,x5,x6)
tupFromList _ = error "tupFromList: list should have length 6"
instance Tup NTup7 where
tupSize _ = 7
tupToList (NTup7 (x1,x2,x3,x4,x5,x6,x7)) = [x1,x2,x3,x4,x5,x6,x7]
tupFromList [x1,x2,x3,x4,x5,x6,x7] = NTup7 (x1,x2,x3,x4,x5,x6,x7)
tupFromList _ = error "tupFromList: list should have length 7"
instance Tup NTup8 where
tupSize _ = 8
tupToList (NTup8 (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] = NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
tupFromList _ = error "tupFromList: list should have length 8"
instance Tup NTup9 where
tupSize _ = 9
tupToList (NTup9 (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] = NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
tupFromList _ = error "tupFromList: list should have length 9"
instance Applicative NTup0 where
pure _ = NTup0
NTup0 <*> NTup0 = NTup0
instance Applicative NTup1 where
pure x = NTup1 x
NTup1 f1 <*> NTup1 x1 = NTup1 (f1 x1)
instance Applicative NTup2 where
pure x = NTup2 (x,x)
NTup2 (f1,f2) <*> NTup2 (x1,x2) = NTup2 (f1 x1, f2 x2)
instance Applicative NTup3 where
pure x = NTup3 (x,x,x)
NTup3 (f1,f2,f3) <*> NTup3 (x1,x2,x3) = NTup3 (f1 x1, f2 x2, f3 x3)
instance Applicative NTup4 where
pure x = NTup4 (x,x,x,x)
NTup4 (f1,f2,f3,f4) <*> NTup4 (x1,x2,x3,x4) = NTup4 (f1 x1, f2 x2, f3 x3, f4 x4)
instance Applicative NTup5 where
pure x = NTup5 (x,x,x,x,x)
NTup5 (f1,f2,f3,f4,f5) <*> NTup5 (x1,x2,x3,x4,x5) = NTup5 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5)
instance Applicative NTup6 where
pure x = NTup6 (x,x,x,x,x,x)
NTup6 (f1,f2,f3,f4,f5,f6) <*> NTup6 (x1,x2,x3,x4,x5,x6) = NTup6 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6)
instance Applicative NTup7 where
pure x = NTup7 (x,x,x,x,x,x,x)
NTup7 (f1,f2,f3,f4,f5,f6,f7) <*> NTup7 (x1,x2,x3,x4,x5,x6,x7)
= NTup7 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6, f7 x7)
instance Applicative NTup8 where
pure x = NTup8 (x,x,x,x,x,x,x,x)
NTup8 (f1,f2,f3,f4,f5,f6,f7,f8) <*> NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
= NTup8 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6, f7 x7, f8 x8)
instance Applicative NTup9 where
pure x = NTup9 (x,x,x,x,x,x,x,x,x)
NTup9 (f1,f2,f3,f4,f5,f6,f7,f8,f9) <*> NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
= NTup9 (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 (NTup0 a) where NUM_INSTANCE
instance Num a => Num (NTup1 a) where NUM_INSTANCE
instance Num a => Num (NTup2 a) where NUM_INSTANCE
instance Num a => Num (NTup3 a) where NUM_INSTANCE
instance Num a => Num (NTup4 a) where NUM_INSTANCE
instance Num a => Num (NTup5 a) where NUM_INSTANCE
instance Num a => Num (NTup6 a) where NUM_INSTANCE
instance Num a => Num (NTup7 a) where NUM_INSTANCE
instance Num a => Num (NTup8 a) where NUM_INSTANCE
instance Num a => Num (NTup9 a) where NUM_INSTANCE
#define FRACTIONAL_INSTANCE \
{ t1 / t2 = (/) <$> t1 <*> t2 \
; recip = fmap recip \
; fromRational = pure . fromRational }
instance Fractional a => Fractional (NTup0 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup1 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup2 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup3 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup4 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup5 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup6 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup7 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup8 a) where FRACTIONAL_INSTANCE
instance Fractional a => Fractional (NTup9 a) where FRACTIONAL_INSTANCE
#define MONOID_INSTANCE \
{ mempty = pure mempty \
; mappend t1 t2 = mappend <$> t1 <*> t2 }
instance Monoid a => Monoid (NTup0 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup1 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup2 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup3 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup4 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup5 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup6 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup7 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup8 a) where MONOID_INSTANCE
instance Monoid a => Monoid (NTup9 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 (NTup0 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup1 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup2 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup3 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup4 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup5 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup6 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup7 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup8 a) where STORABLE_INSTANCE
instance Storable a => Storable (NTup9 a) where STORABLE_INSTANCE