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