module Data.Tuple.HT (
   -- * Pair
   mapPair,
   mapFst,
   mapSnd,
   swap,
   sortPair,
   forcePair,
   double,

   -- * Triple
   fst3,
   snd3,
   thd3,
   mapTriple,
   mapFst3,
   mapSnd3,
   mapThd3,
   curry3,
   uncurry3,
   triple,
   ) where

import Data.Tuple.Lazy


{- |
Known as @dup@ in the 'Arrow' literature.
-}
{-# INLINE double #-}
double :: a -> (a,a)
double :: a -> (a, a)
double a
a = (a
a,a
a)

{-# INLINE triple #-}
triple :: a -> (a,a,a)
triple :: a -> (a, a, a)
triple a
a = (a
a,a
a,a
a)

{-# INLINE fst3 #-}
fst3 :: (a,b,c) -> a
fst3 :: (a, b, c) -> a
fst3 (a
x,b
_,c
_) = a
x

{-# INLINE snd3 #-}
snd3 :: (a,b,c) -> b
snd3 :: (a, b, c) -> b
snd3 (a
_,b
x,c
_) = b
x

{-# INLINE thd3 #-}
thd3 :: (a,b,c) -> c
thd3 :: (a, b, c) -> c
thd3 (a
_,b
_,c
x) = c
x

{-# INLINE curry3 #-}
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (a, b, c) -> d
f a
a b
b c
c = (a, b, c) -> d
f (a
a,b
b,c
c)

{- |
This is convenient for quick hacks
but I suggest that you better define a type for an ordered pair
for your application at hand.
This way, you can clearly see from the type that a pair is ordered.
-}
sortPair, _sortPairMinMax :: (Ord a) => (a,a) -> (a,a)
sortPair :: (a, a) -> (a, a)
sortPair (a
x,a
y) = if a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
y then (a
x,a
y) else (a
y,a
x)
_sortPairMinMax :: (a, a) -> (a, a)
_sortPairMinMax (a
x,a
y) = (a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y, a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y)