{-
A simple homogeneous pair type with useful Functor, Applicative, and
Traversable instances.
-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}

module GHC.Data.Pair
   ( Pair(..)
   , unPair
   , toPair
   , swap
   , pLiftFst
   , pLiftSnd
   )
where

#include "GhclibHsVersions.h"

import GHC.Prelude

import GHC.Utils.Outputable
import qualified Data.Semigroup as Semi

data Pair a = Pair { Pair a -> a
pFst :: a, Pair a -> a
pSnd :: a }
  deriving (a -> Pair b -> Pair a
(a -> b) -> Pair a -> Pair b
(forall a b. (a -> b) -> Pair a -> Pair b)
-> (forall a b. a -> Pair b -> Pair a) -> Functor Pair
forall a b. a -> Pair b -> Pair a
forall a b. (a -> b) -> Pair a -> Pair b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pair b -> Pair a
$c<$ :: forall a b. a -> Pair b -> Pair a
fmap :: (a -> b) -> Pair a -> Pair b
$cfmap :: forall a b. (a -> b) -> Pair a -> Pair b
Functor)
-- 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 Applicative Pair where
  pure :: a -> Pair a
pure a
x = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
x a
x
  (Pair a -> b
f a -> b
g) <*> :: Pair (a -> b) -> Pair a -> Pair b
<*> (Pair a
x a
y) = b -> b -> Pair b
forall a. a -> a -> Pair a
Pair (a -> b
f a
x) (a -> b
g a
y)

instance Foldable Pair where
  foldMap :: (a -> m) -> Pair a -> m
foldMap a -> m
f (Pair a
x a
y) = a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
y

instance Traversable Pair where
  traverse :: (a -> f b) -> Pair a -> f (Pair b)
traverse a -> f b
f (Pair a
x a
y) = b -> b -> Pair b
forall a. a -> a -> Pair a
Pair (b -> b -> Pair b) -> f b -> f (b -> Pair b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x f (b -> Pair b) -> f b -> f (Pair b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
y

instance Semi.Semigroup a => Semi.Semigroup (Pair a) where
  Pair a
a1 a
b1 <> :: Pair a -> Pair a -> Pair a
<> Pair a
a2 a
b2 =  a -> a -> Pair a
forall a. a -> a -> Pair a
Pair (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
Semi.<> a
a2) (a
b1 a -> a -> a
forall a. Semigroup a => a -> a -> a
Semi.<> a
b2)

instance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where
  mempty :: Pair a
mempty = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
mempty
  mappend :: Pair a -> Pair a -> Pair a
mappend = Pair a -> Pair a -> Pair a
forall a. Semigroup a => a -> a -> a
(Semi.<>)

instance Outputable a => Outputable (Pair a) where
  ppr :: Pair a -> SDoc
ppr (Pair a
a a
b) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
a SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'~' SDoc -> SDoc -> SDoc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
b

unPair :: Pair a -> (a,a)
unPair :: Pair a -> (a, a)
unPair (Pair a
x a
y) = (a
x,a
y)

toPair :: (a,a) -> Pair a
toPair :: (a, a) -> Pair a
toPair (a
x,a
y) = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
x a
y

swap :: Pair a -> Pair a
swap :: Pair a -> Pair a
swap (Pair a
x a
y) = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
y a
x

pLiftFst :: (a -> a) -> Pair a -> Pair a
pLiftFst :: (a -> a) -> Pair a -> Pair a
pLiftFst a -> a
f (Pair a
a a
b) = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair (a -> a
f a
a) a
b

pLiftSnd :: (a -> a) -> Pair a -> Pair a
pLiftSnd :: (a -> a) -> Pair a -> Pair a
pLiftSnd a -> a
f (Pair a
a a
b) = a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
a (a -> a
f a
b)