{-# LANGUAGE RankNTypes, ConstraintKinds, KindSignatures, AllowAmbiguousTypes, ExplicitForAll #-}

-- | For something like tBothmap and its cousins, consider importing Hextra.Bifunctor instead
-- To solely import dupe, write import Hextra.Tuple (dupe)
module Hextra.Tuple where

import Data.Kind as Kind

tSort :: forall a. Ord a => (a, a) -> (a, a)
tSort :: (a, a) -> (a, a)
tSort (a
x, a
y) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> (a
x, a
y)
    Ordering
EQ -> (a
x, a
y)
    Ordering
GT -> (a
y, a
x)
-- ^ Sorts a tuple

tSort' :: forall a. Ord a => (a, a) -> (a, a)
tSort' :: (a, a) -> (a, a)
tSort' (a
x, a
y) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of
    Ordering
LT -> (a
y, a
x)
    Ordering
EQ -> (a
x, a
y)
    Ordering
GT -> (a
x, a
y)
-- ^ Sorts a tuple, reversed

tReverse :: forall a b. (a, b) -> (b, a)
tReverse :: (a, b) -> (b, a)
tReverse (a
x, b
y) = (b
y, a
x)

dupe :: forall a. a -> (a, a)
dupe :: a -> (a, a)
dupe a
a = (a
a, a
a)
-- ^ Creates a tuple with identical elements.
-- "Duplicates" the value.

dupe' :: forall b c. (forall a. a) -> (b, c)
dupe' :: (forall a. a) -> (b, c)
dupe' forall a. a
a = (b
forall a. a
a, c
forall a. a
a)
-- ^ Creates a tuple from a universally polymorphic value.
-- Like dupe, but for universally polymorphic values
-- universally polymorphic = exists for any type

dupeC :: forall (f :: Type -> Constraint) b c. (f b, f c) => (forall a. f a => a) -> (b, c)
dupeC :: (forall a. f a => a) -> (b, c)
dupeC forall a. f a => a
a = (b
forall a. f a => a
a, c
forall a. f a => a
a)
-- ^ Like dupe and dupe', but for constrainedly polymorphic values, results in a constrainedly polymorphic tuple
-- constrained = instance of a given class, or here, in the case of a tuple, containing them

tBothmap :: forall a b. (a -> b) -> (a, a) -> (b, b)
tBothmap :: (a -> b) -> (a, a) -> (b, b)
tBothmap a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)
-- ^ Maps a function onto a homogenous tuple.
-- homogenous = same type in both slots

tBothmap' :: forall b x y. (forall a. a -> b) -> (x, y) -> (b, b)
tBothmap' :: (forall a. a -> b) -> (x, y) -> (b, b)
tBothmap' forall a. a -> b
f (x
x, y
y) = (x -> b
forall a. a -> b
f x
x, y -> b
forall a. a -> b
f y
y)
-- ^ Maps a universally polymorphic over any (even heterogenous) tuple.
-- universally polymorphic = works for any type

tBothmapC :: forall b (f :: Type -> Constraint) x y. (f x, f y) => (forall a. f a => a -> b) -> (x, y) -> (b, b)
tBothmapC :: (forall a. f a => a -> b) -> (x, y) -> (b, b)
tBothmapC forall a. f a => a -> b
f (x
x, y
y) = (x -> b
forall a. f a => a -> b
f x
x, y -> b
forall a. f a => a -> b
f y
y)
-- ^ Maps a constrainedly polymorphic over a constrained tuple.
-- constrained = instance of a given class, or here, in the case of a tuple, containing them

tBothmapB :: forall (f :: Type -> Type -> Constraint) x y z w. (f x z, f y w) => (forall a b. f a b => a -> b) -> (x, y) -> (z, w)
tBothmapB :: (forall a b. f a b => a -> b) -> (x, y) -> (z, w)
tBothmapB forall a b. f a b => a -> b
f (x
x, y
y) = (x -> z
forall a b. f a b => a -> b
f x
x, y -> w
forall a b. f a b => a -> b
f y
y)
-- ^ Maps a coercion function over a tuple of coercibles.
-- coercion = function from something to something else