-----------------------------------------------------------------------------
--
-- Module      :  Data.Tuple.Util
-- Copyright   :  (c) 2012-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <b.w.bush@acm.org>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | Functions for manipulating tuples, supplementing "Data.Tuple".
--
-----------------------------------------------------------------------------


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe             #-}


module Data.Tuple.Util (
-- * Functions on pairs.
  ($$)
-- * Functions on triplets.
, curry3
, uncurry3
, fst3
, snd3
, trd3
, first3
, second3
, third3
-- * Functions on quadruplets.
, curry4
, uncurry4
, fst4
, snd4
, trd4
, fth4
, first4
, second4
, third4
, fourth4
) where


import Control.Arrow (Arrow, arr, first)
import Control.Category ((>>>))
import Control.Monad (liftM2)


-- | Apply a pair of functions to a value.
($$) :: (Monad ((->) a)) => (a -> b, a -> c) -> a -> (b, c)
($$) = uncurry (liftM2 (,))


-- | Curry a triplet.
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f x y z = f (x, y, z)


-- | Uncurry a triplet.
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (x, y, z) = f x y z


-- | Extract the first entry of a triplet.
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x


-- | Extract the second entry of a triplet.
snd3 :: (a, b, c) -> b
snd3 (_, x, _) = x


-- | Extract the third entry of a triplet.
trd3 :: (a, b, c) -> c
trd3 (_, _, x) = x


-- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.
first3 :: Arrow a => a b c -> a (b, d, e) (c, d, e)
first3 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z) = (x, (y, z))
      unpack ~(x, (y, z)) = (x, y, z)


-- | Send the second component of the input through the argument arrow, and copy the rest unchanged to the output.
second3 :: Arrow a => a b c -> a (d, b, e) (d, c, e)
second3 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z) = (y, (x, z))
      unpack ~(y, (x, z)) = (x, y, z)


-- | Send the third component of the input through the argument arrow, and copy the rest unchanged to the output.
third3 :: Arrow a => a b c -> a (d, e, b) (d, e, c)
third3 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z) = (z, (x, y))
      unpack ~(z, (x, y)) = (x, y, z)


-- | Curry a quadruplet.
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 f x y z w = f (x, y, z, w)


-- | Uncurry a quadruplet.
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f (x, y, z, w) = f x y z w


-- | Extract the first entry of a quadruplet.
fst4 :: (a, b, c, d) -> a
fst4 (x, _, _, _) = x


-- | Extract the second entry of a quadruplet.
snd4 :: (a, b, c, d) -> b
snd4 (_, x, _, _) = x


-- | Extract the third entry of a quadruplet.
trd4 :: (a, b, c, d) -> c
trd4 (_, _, x, _) = x


-- | Extract the fourth entry of a quadruplet.
fth4 :: (a, b, c, d) -> d
fth4 (_, _, _, x) = x


-- | Send the first component of the input through the argument arrow, and copy the rest unchanged to the output.
first4 :: Arrow a => a b c -> a (b, d, e, f) (c, d, e, f)
first4 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z, w) = (x, (y, z, w))
      unpack ~(x, (y, z, w)) = (x, y, z, w)


-- | Send the second component of the input through the argument arrow, and copy the rest unchanged to the output.
second4 :: Arrow a => a b c -> a (d, b, e, f) (d, c, e, f)
second4 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z, w) = (y, (x, z, w))
      unpack ~(y, (x, z, w)) = (x, y, z, w)


-- | Send the third component of the input through the argument arrow, and copy the rest unchanged to the output.
third4 :: Arrow a => a b c -> a (d, e, b, f) (d, e, c, f)
third4 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z, w) = (z, (x, y, w))
      unpack ~(z, (x, y, w)) = (x, y, z, w)


-- | Send the fourth component of the input through the argument arrow, and copy the rest unchanged to the output.
fourth4 :: Arrow a => a b c -> a (d, e, f, b) (d, e, f, c)
fourth4 f =
  arr pack >>> first f >>> arr unpack
    where
      pack ~(x, y, z, w) = (w, (x, y, z))
      unpack ~(w, (x, y, z)) = (x, y, z, w)