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)