{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE DeriveGeneric #-}
#ifndef __HADDOCK__
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE TypeOperators #-}
#endif
#endif
#if MIN_VERSION_base(4,9,0)
#define LIFTED_FUNCTOR_CLASSES 1
#else
#if MIN_VERSION_transformers(0,5,0)
#define LIFTED_FUNCTOR_CLASSES 1
#else
#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)
#define LIFTED_FUNCTOR_CLASSES 1
#endif
#endif
#endif
module Data.Strict.Tuple (
Pair(..)
#ifndef __HADDOCK__
#ifdef __GLASGOW_HASKELL__
, (:!:)
#endif
#endif
, fst
, snd
, curry
, uncurry
, Data.Strict.Tuple.swap
, zip
, unzip
) where
import Prelude (Functor (..), Eq (..), Ord (..), Show (..), Read (..), (.), Bounded, map, ($)
, (&&), showParen, showString, readParen, lex, return)
import Control.Applicative ((<$>), (<*>))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import Data.Foldable (Foldable (..))
import Data.Traversable (Traversable (..))
import qualified Prelude as L
import Control.DeepSeq (NFData (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Binary (Binary (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Hashable (Hashable(..))
import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..))
import Data.Ix (Ix (..))
import GHC.Generics (Generic)
import Data.Data (Data (..), Typeable)
#if __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic1)
#endif
#if MIN_VERSION_deepseq(1,4,3)
import Control.DeepSeq (NFData1 (..), NFData2 (..))
#endif
#ifdef MIN_VERSION_assoc
import Data.Bifunctor.Assoc (Assoc (..))
import Data.Bifunctor.Swap (Swap (..))
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
import Data.Functor.Classes
(Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..),
Show1 (..), Show2 (..))
#else
import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))
#endif
#if __HADDOCK__
import Data.Tuple ()
#endif
infix 2 :!:
data Pair a b = !a :!: !b
deriving (Pair a b -> Pair a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
/= :: Pair a b -> Pair a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
== :: Pair a b -> Pair a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Pair a b -> Pair a b -> Bool
Eq, Pair a b -> Pair a b -> Bool
Pair a b -> Pair a b -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b}. (Ord a, Ord b) => Eq (Pair a b)
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
min :: Pair a b -> Pair a b -> Pair a b
$cmin :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
max :: Pair a b -> Pair a b -> Pair a b
$cmax :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Pair a b
>= :: Pair a b -> Pair a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
> :: Pair a b -> Pair a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
<= :: Pair a b -> Pair a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
< :: Pair a b -> Pair a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Bool
compare :: Pair a b -> Pair a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Pair a b -> Pair a b -> Ordering
Ord, ReadPrec [Pair a b]
ReadPrec (Pair a b)
ReadS [Pair a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Pair a b]
forall a b. (Read a, Read b) => ReadPrec (Pair a b)
forall a b. (Read a, Read b) => Int -> ReadS (Pair a b)
forall a b. (Read a, Read b) => ReadS [Pair a b]
readListPrec :: ReadPrec [Pair a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Pair a b]
readPrec :: ReadPrec (Pair a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Pair a b)
readList :: ReadS [Pair a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Pair a b]
readsPrec :: Int -> ReadS (Pair a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Pair a b)
Read, Int -> Pair a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
forall a b. (Show a, Show b) => [Pair a b] -> ShowS
forall a b. (Show a, Show b) => Pair a b -> String
showList :: [Pair a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Pair a b] -> ShowS
show :: Pair a b -> String
$cshow :: forall a b. (Show a, Show b) => Pair a b -> String
showsPrec :: Int -> Pair a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Pair a b -> ShowS
Show, Typeable, Pair a b -> DataType
Pair a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {a} {b}. (Data a, Data b) => Typeable (Pair a b)
forall a b. (Data a, Data b) => Pair a b -> DataType
forall a b. (Data a, Data b) => Pair a b -> Constr
forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Pair a b -> Pair a b
forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Pair a b -> u
forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Pair a b -> [u]
forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pair a b)
forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair a b -> c (Pair a b)
forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pair a b))
forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pair a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pair a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair a b -> c (Pair a b)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pair a b))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
$cgmapMo :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
$cgmapMp :: forall a b (m :: * -> *).
(Data a, Data b, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
$cgmapM :: forall a b (m :: * -> *).
(Data a, Data b, Monad m) =>
(forall d. Data d => d -> m d) -> Pair a b -> m (Pair a b)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pair a b -> u
$cgmapQi :: forall a b u.
(Data a, Data b) =>
Int -> (forall d. Data d => d -> u) -> Pair a b -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pair a b -> [u]
$cgmapQ :: forall a b u.
(Data a, Data b) =>
(forall d. Data d => d -> u) -> Pair a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
$cgmapQr :: forall a b r r'.
(Data a, Data b) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
$cgmapQl :: forall a b r r'.
(Data a, Data b) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pair a b -> r
gmapT :: (forall b. Data b => b -> b) -> Pair a b -> Pair a b
$cgmapT :: forall a b.
(Data a, Data b) =>
(forall b. Data b => b -> b) -> Pair a b -> Pair a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pair a b))
$cdataCast2 :: forall a b (t :: * -> * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Pair a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Pair a b))
$cdataCast1 :: forall a b (t :: * -> *) (c :: * -> *).
(Data a, Data b, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pair a b))
dataTypeOf :: Pair a b -> DataType
$cdataTypeOf :: forall a b. (Data a, Data b) => Pair a b -> DataType
toConstr :: Pair a b -> Constr
$ctoConstr :: forall a b. (Data a, Data b) => Pair a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pair a b)
$cgunfold :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pair a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair a b -> c (Pair a b)
$cgfoldl :: forall a b (c :: * -> *).
(Data a, Data b) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pair a b -> c (Pair a b)
Data, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (Pair a b) x -> Pair a b
forall a b x. Pair a b -> Rep (Pair a b) x
$cto :: forall a b x. Rep (Pair a b) x -> Pair a b
$cfrom :: forall a b x. Pair a b -> Rep (Pair a b) x
Generic, Pair a b
forall a. a -> a -> Bounded a
forall a b. (Bounded a, Bounded b) => Pair a b
maxBound :: Pair a b
$cmaxBound :: forall a b. (Bounded a, Bounded b) => Pair a b
minBound :: Pair a b
$cminBound :: forall a b. (Bounded a, Bounded b) => Pair a b
Bounded, (Pair a b, Pair a b) -> [Pair a b]
(Pair a b, Pair a b) -> Pair a b -> Bool
(Pair a b, Pair a b) -> Pair a b -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall {a} {b}. (Ix a, Ix b) => Ord (Pair a b)
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> [Pair a b]
forall a b.
(Ix a, Ix b) =>
(Pair a b, Pair a b) -> Pair a b -> Bool
forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
unsafeRangeSize :: (Pair a b, Pair a b) -> Int
$cunsafeRangeSize :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
rangeSize :: (Pair a b, Pair a b) -> Int
$crangeSize :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Int
inRange :: (Pair a b, Pair a b) -> Pair a b -> Bool
$cinRange :: forall a b.
(Ix a, Ix b) =>
(Pair a b, Pair a b) -> Pair a b -> Bool
unsafeIndex :: (Pair a b, Pair a b) -> Pair a b -> Int
$cunsafeIndex :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
index :: (Pair a b, Pair a b) -> Pair a b -> Int
$cindex :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> Pair a b -> Int
range :: (Pair a b, Pair a b) -> [Pair a b]
$crange :: forall a b. (Ix a, Ix b) => (Pair a b, Pair a b) -> [Pair a b]
Ix
#if __GLASGOW_HASKELL__ >= 706
, forall a a. Rep1 (Pair a) a -> Pair a a
forall a a. Pair a a -> Rep1 (Pair a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a a. Rep1 (Pair a) a -> Pair a a
$cfrom1 :: forall a a. Pair a a -> Rep1 (Pair a) a
Generic1
#endif
)
#ifndef __HADDOCK__
#ifdef __GLASGOW_HASKELL__
type (:!:) = Pair
#endif
#endif
toStrict :: (a, b) -> Pair a b
toStrict :: forall a b. (a, b) -> Pair a b
toStrict (a
a, b
b) = a
a forall a b. a -> b -> Pair a b
:!: b
b
toLazy :: Pair a b -> (a, b)
toLazy :: forall a b. Pair a b -> (a, b)
toLazy (a
a :!: b
b) = (a
a, b
b)
fst :: Pair a b -> a
fst :: forall a b. Pair a b -> a
fst (a
x :!: b
_) = a
x
snd :: Pair a b -> b
snd :: forall a b. Pair a b -> b
snd (a
_ :!: b
y) = b
y
curry :: (Pair a b -> c) -> a -> b -> c
curry :: forall a b c. (Pair a b -> c) -> a -> b -> c
curry Pair a b -> c
f a
x b
y = Pair a b -> c
f (a
x forall a b. a -> b -> Pair a b
:!: b
y)
uncurry :: (a -> b -> c) -> Pair a b -> c
uncurry :: forall a b c. (a -> b -> c) -> Pair a b -> c
uncurry a -> b -> c
f (a
x :!: b
y) = a -> b -> c
f a
x b
y
swap :: Pair a b -> Pair b a
swap :: forall a b. Pair a b -> Pair b a
swap (a
a :!: b
b) = b
b forall a b. a -> b -> Pair a b
:!: a
a
zip :: [a] -> [b] -> [Pair a b]
zip :: forall a b. [a] -> [b] -> [Pair a b]
zip [a]
x [b]
y = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith forall a b. a -> b -> Pair a b
(:!:) [a]
x [b]
y
unzip :: [Pair a b] -> ([a], [b])
unzip :: forall a b. [Pair a b] -> ([a], [b])
unzip [Pair a b]
x = ( forall a b. (a -> b) -> [a] -> [b]
map forall a b. Pair a b -> a
fst [Pair a b]
x
, forall a b. (a -> b) -> [a] -> [b]
map forall a b. Pair a b -> b
snd [Pair a b]
x
)
instance Functor (Pair e) where
fmap :: forall a b. (a -> b) -> Pair e a -> Pair e b
fmap a -> b
f = forall a b. (a, b) -> Pair a b
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
instance Foldable (Pair e) where
foldMap :: forall m a. Monoid m => (a -> m) -> Pair e a -> m
foldMap a -> m
f (e
_ :!: a
x) = a -> m
f a
x
instance Traversable (Pair e) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Pair e a -> f (Pair e b)
traverse a -> f b
f (e
e :!: a
x) = forall a b. a -> b -> Pair a b
(:!:) e
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
instance (Semigroup a, Semigroup b) => Semigroup (Pair a b) where
(a
x1 :!: b
y1) <> :: Pair a b -> Pair a b -> Pair a b
<> (a
x2 :!: b
y2) = (a
x1 forall a. Semigroup a => a -> a -> a
<> a
x2) forall a b. a -> b -> Pair a b
:!: (b
y1 forall a. Semigroup a => a -> a -> a
<> b
y2)
instance (Monoid a, Monoid b) => Monoid (Pair a b) where
mempty :: Pair a b
mempty = forall a. Monoid a => a
mempty forall a b. a -> b -> Pair a b
:!: forall a. Monoid a => a
mempty
(a
x1 :!: b
y1) mappend :: Pair a b -> Pair a b -> Pair a b
`mappend` (a
x2 :!: b
y2) = (a
x1 forall a. Monoid a => a -> a -> a
`mappend` a
x2) forall a b. a -> b -> Pair a b
:!: (b
y1 forall a. Monoid a => a -> a -> a
`mappend` b
y2)
instance (NFData a, NFData b) => NFData (Pair a b) where
rnf :: Pair a b -> ()
rnf = forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
#if MIN_VERSION_deepseq(1,4,3)
instance (NFData a) => NFData1 (Pair a) where
liftRnf :: forall a. (a -> ()) -> Pair a a -> ()
liftRnf a -> ()
rnfA = forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
rnfA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
instance NFData2 Pair where
liftRnf2 :: forall a b. (a -> ()) -> (b -> ()) -> Pair a b -> ()
liftRnf2 a -> ()
rnfA b -> ()
rnfB = forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
liftRnf2 a -> ()
rnfA b -> ()
rnfB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
#endif
instance (Binary a, Binary b) => Binary (Pair a b) where
put :: Pair a b -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
get :: Get (Pair a b)
get = forall a b. (a, b) -> Pair a b
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
instance Bifunctor Pair where
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Pair a c -> Pair b d
bimap a -> b
f c -> d
g (a
a :!: c
b) = a -> b
f a
a forall a b. a -> b -> Pair a b
:!: c -> d
g c
b
first :: forall a b c. (a -> b) -> Pair a c -> Pair b c
first a -> b
f (a
a :!: c
b) = a -> b
f a
a forall a b. a -> b -> Pair a b
:!: c
b
second :: forall b c a. (b -> c) -> Pair a b -> Pair a c
second b -> c
g (a
a :!: b
b) = a
a forall a b. a -> b -> Pair a b
:!: b -> c
g b
b
instance Bifoldable Pair where
bifold :: forall m. Monoid m => Pair m m -> m
bifold (m
a :!: m
b) = m
a forall a. Monoid a => a -> a -> a
`mappend` m
b
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Pair a b -> m
bifoldMap a -> m
f b -> m
g (a
a :!: b
b) = a -> m
f a
a forall a. Monoid a => a -> a -> a
`mappend` b -> m
g b
b
bifoldr :: forall a c b. (a -> c -> c) -> (b -> c -> c) -> c -> Pair a b -> c
bifoldr a -> c -> c
f b -> c -> c
g c
c (a
a :!: b
b) = b -> c -> c
g b
b (a -> c -> c
f a
a c
c)
bifoldl :: forall c a b. (c -> a -> c) -> (c -> b -> c) -> c -> Pair a b -> c
bifoldl c -> a -> c
f c -> b -> c
g c
c (a
a :!: b
b) = c -> b -> c
g (c -> a -> c
f c
c a
a) b
b
instance Bitraversable Pair where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Pair a b -> f (Pair c d)
bitraverse a -> f c
f b -> f d
g (a
a :!: b
b) = forall a b. a -> b -> Pair a b
(:!:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> f d
g b
b
instance (Hashable a, Hashable b) => Hashable (Pair a b) where
hashWithSalt :: Int -> Pair a b -> Int
hashWithSalt Int
salt = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
instance (Hashable a) => Hashable1 (Pair a) where
liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> Pair a a -> Int
liftHashWithSalt Int -> a -> Int
hashA Int
salt = forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> a -> Int
hashA Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
instance Hashable2 Pair where
liftHashWithSalt2 :: forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> Pair a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
hashB Int
salt = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashA Int -> b -> Int
hashB Int
salt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Pair a b -> (a, b)
toLazy
#ifdef MIN_VERSION_assoc
instance Assoc Pair where
assoc :: forall a b c. Pair (Pair a b) c -> Pair a (Pair b c)
assoc ((a
a :!: b
b) :!: c
c) = (a
a forall a b. a -> b -> Pair a b
:!: (b
b forall a b. a -> b -> Pair a b
:!: c
c))
unassoc :: forall a b c. Pair a (Pair b c) -> Pair (Pair a b) c
unassoc (a
a :!: (b
b :!: c
c)) = ((a
a forall a b. a -> b -> Pair a b
:!: b
b) forall a b. a -> b -> Pair a b
:!: c
c)
instance Swap Pair where
swap :: forall a b. Pair a b -> Pair b a
swap = forall a b. Pair a b -> Pair b a
Data.Strict.Tuple.swap
#endif
#ifdef LIFTED_FUNCTOR_CLASSES
instance Eq2 Pair where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Pair a c -> Pair b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (a
a :!: c
b) (b
a' :!: d
b') = a -> b -> Bool
f a
a b
a' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
b d
b'
instance Eq a => Eq1 (Pair a) where
liftEq :: forall a b. (a -> b -> Bool) -> Pair a a -> Pair a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
instance Ord2 Pair where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Pair a c -> Pair b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (a
a :!: c
b) (b
a' :!: d
b') = a -> b -> Ordering
f a
a b
a' forall a. Monoid a => a -> a -> a
`mappend` c -> d -> Ordering
g c
b d
b'
instance Ord a => Ord1 (Pair a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Pair a a -> Pair a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
instance Show a => Show1 (Pair a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Pair a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
instance Show2 Pair where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Pair a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sa [a] -> ShowS
_ Int -> b -> ShowS
sb [b] -> ShowS
_ Int
d (a
a :!: b
b) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
3)
forall a b. (a -> b) -> a -> b
$ Int -> a -> ShowS
sa Int
3 a
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" :!: "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
sb Int
3 b
b
instance Read2 Pair where
liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Pair a b)
liftReadsPrec2 Int -> ReadS a
ra ReadS [a]
_ Int -> ReadS b
rb ReadS [b]
_ Int
d = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
3) forall a b. (a -> b) -> a -> b
$ \String
s -> ReadS (Pair a b)
cons String
s where
cons :: ReadS (Pair a b)
cons String
s0 = do
(a
a, String
s1) <- Int -> ReadS a
ra Int
3 String
s0
(String
":!:", String
s2) <- ReadS String
lex String
s1
(b
b, String
s3) <- Int -> ReadS b
rb Int
3 String
s2
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a forall a b. a -> b -> Pair a b
:!: b
b, String
s3)
instance Read a => Read1 (Pair a) where
liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Pair a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
#else
instance Eq a => Eq1 (Pair a) where eq1 = (==)
instance Ord a => Ord1 (Pair a) where compare1 = compare
instance Show a => Show1 (Pair a) where showsPrec1 = showsPrec
instance Read a => Read1 (Pair a) where readsPrec1 = readsPrec
#endif