{-
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 Outputable
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
import Data.Foldable
import Data.Monoid
import Data.Traversable
#endif

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 *homogenous*
-- 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 Monoid a => Monoid (Pair a) where
  mempty = Pair mempty mempty
  Pair a1 b1 `mappend` Pair a2 b2 = Pair (a1 `mappend` a2) (b1 `mappend` b2)

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)