1-- | 2-- Module : Foundation.Tuple 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : portable 7-- 8{-# LANGUAGE DeriveDataTypeable #-} 9{-# LANGUAGE DeriveGeneric #-} 10module Foundation.Tuple 11 ( Tuple2(..) 12 , Tuple3(..) 13 , Tuple4(..) 14 , Fstable(..) 15 , Sndable(..) 16 , Thdable(..) 17 ) where 18 19import Basement.Compat.Base 20import Basement.Compat.Bifunctor 21import Foundation.Primitive 22 23-- | Strict tuple (a,b) 24data Tuple2 a b = Tuple2 !a !b 25 deriving (Show,Eq,Ord,Typeable,Data,Generic) 26 27instance (NormalForm a, NormalForm b) => NormalForm (Tuple2 a b) where 28 toNormalForm (Tuple2 a b) = toNormalForm a `seq` toNormalForm b 29instance Bifunctor Tuple2 where 30 bimap f g (Tuple2 a b) = Tuple2 (f a) (g b) 31 32-- | Strict tuple (a,b,c) 33data Tuple3 a b c = Tuple3 !a !b !c 34 deriving (Show,Eq,Ord,Typeable,Data,Generic) 35 36instance (NormalForm a, NormalForm b, NormalForm c) => NormalForm (Tuple3 a b c) where 37 toNormalForm (Tuple3 a b c) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c 38 39-- | Strict tuple (a,b,c,d) 40data Tuple4 a b c d = Tuple4 !a !b !c !d 41 deriving (Show,Eq,Ord,Typeable,Data,Generic) 42 43instance (NormalForm a, NormalForm b, NormalForm c, NormalForm d) 44 => NormalForm (Tuple4 a b c d) where 45 toNormalForm (Tuple4 a b c d) = toNormalForm a `seq` toNormalForm b `seq` toNormalForm c `seq` toNormalForm d 46 47-- | Class of product types that have a first element 48class Fstable a where 49 type ProductFirst a 50 fst :: a -> ProductFirst a 51 52-- | Class of product types that have a second element 53class Sndable a where 54 type ProductSecond a 55 snd :: a -> ProductSecond a 56 57-- | Class of product types that have a third element 58class Thdable a where 59 type ProductThird a 60 thd :: a -> ProductThird a 61 62instance Fstable (a,b) where 63 type ProductFirst (a,b) = a 64 fst (a,_) = a 65instance Fstable (a,b,c) where 66 type ProductFirst (a,b,c) = a 67 fst (a,_,_) = a 68instance Fstable (a,b,c,d) where 69 type ProductFirst (a,b,c,d) = a 70 fst (a,_,_,_) = a 71instance Fstable (Tuple2 a b) where 72 type ProductFirst (Tuple2 a b) = a 73 fst (Tuple2 a _) = a 74instance Fstable (Tuple3 a b c) where 75 type ProductFirst (Tuple3 a b c) = a 76 fst (Tuple3 a _ _) = a 77instance Fstable (Tuple4 a b c d) where 78 type ProductFirst (Tuple4 a b c d) = a 79 fst (Tuple4 a _ _ _) = a 80 81instance Sndable (a,b) where 82 type ProductSecond (a,b) = b 83 snd (_,b) = b 84instance Sndable (a,b,c) where 85 type ProductSecond (a,b,c) = b 86 snd (_,b,_) = b 87instance Sndable (a,b,c,d) where 88 type ProductSecond (a,b,c,d) = b 89 snd (_,b,_,_) = b 90instance Sndable (Tuple2 a b) where 91 type ProductSecond (Tuple2 a b) = b 92 snd (Tuple2 _ b) = b 93instance Sndable (Tuple3 a b c) where 94 type ProductSecond (Tuple3 a b c) = b 95 snd (Tuple3 _ b _) = b 96instance Sndable (Tuple4 a b c d) where 97 type ProductSecond (Tuple4 a b c d) = b 98 snd (Tuple4 _ b _ _) = b 99 100instance Thdable (a,b,c) where 101 type ProductThird (a,b,c) = c 102 thd (_,_,c) = c 103instance Thdable (a,b,c,d) where 104 type ProductThird (a,b,c,d) = c 105 thd (_,_,c,_) = c 106instance Thdable (Tuple3 a b c) where 107 type ProductThird (Tuple3 a b c) = c 108 thd (Tuple3 _ _ c) = c 109instance Thdable (Tuple4 a b c d) where 110 type ProductThird (Tuple4 a b c d) = c 111 thd (Tuple4 _ _ c _) = c 112