never executed always true always false
1 {-
2 A simple homogeneous pair type with useful Functor, Applicative, and
3 Traversable instances.
4 -}
5
6
7 {-# LANGUAGE DeriveFunctor #-}
8
9 module GHC.Data.Pair
10 ( Pair(..)
11 , unPair
12 , toPair
13 , swap
14 , pLiftFst
15 , pLiftSnd
16 )
17 where
18
19 import GHC.Prelude
20
21 import GHC.Utils.Outputable
22 import qualified Data.Semigroup as Semi
23
24 data Pair a = Pair { pFst :: a, pSnd :: a }
25 deriving (Functor)
26 -- Note that Pair is a *unary* type constructor
27 -- whereas (,) is binary
28
29 -- The important thing about Pair is that it has a *homogeneous*
30 -- Functor instance, so you can easily apply the same function
31 -- to both components
32
33 instance Applicative Pair where
34 pure x = Pair x x
35 (Pair f g) <*> (Pair x y) = Pair (f x) (g y)
36
37 instance Foldable Pair where
38 foldMap f (Pair x y) = f x `mappend` f y
39
40 instance Traversable Pair where
41 traverse f (Pair x y) = Pair <$> f x <*> f y
42
43 instance Semi.Semigroup a => Semi.Semigroup (Pair a) where
44 Pair a1 b1 <> Pair a2 b2 = Pair (a1 Semi.<> a2) (b1 Semi.<> b2)
45
46 instance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where
47 mempty = Pair mempty mempty
48 mappend = (Semi.<>)
49
50 instance Outputable a => Outputable (Pair a) where
51 ppr (Pair a b) = ppr a <+> char '~' <+> ppr b
52
53 unPair :: Pair a -> (a,a)
54 unPair (Pair x y) = (x,y)
55
56 toPair :: (a,a) -> Pair a
57 toPair (x,y) = Pair x y
58
59 swap :: Pair a -> Pair a
60 swap (Pair x y) = Pair y x
61
62 pLiftFst :: (a -> a) -> Pair a -> Pair a
63 pLiftFst f (Pair a b) = Pair (f a) b
64
65 pLiftSnd :: (a -> a) -> Pair a -> Pair a
66 pLiftSnd f (Pair a b) = Pair a (f b)