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