module Data.Tuple.Util (
($$)
, curry3
, uncurry3
, fst3
, snd3
, trd3
, first3
, second3
, third3
, curry4
, uncurry4
, fst4
, snd4
, trd4
, fth4
, first4
, second4
, third4
, fourth4
) where
import Control.Arrow (Arrow, arr, first)
import Control.Category ((>>>))
import Control.Monad (liftM2)
($$) :: (Monad ((->) a)) => (a -> b, a -> c) -> a -> (b, c)
($$) = uncurry (liftM2 (,))
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 f x y z = f (x, y, z)
uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 f (x, y, z) = f x y z
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x
snd3 :: (a, b, c) -> b
snd3 (_, x, _) = x
trd3 :: (a, b, c) -> c
trd3 (_, _, x) = x
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)
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)
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)
curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e
curry4 f x y z w = f (x, y, z, w)
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 f (x, y, z, w) = f x y z w
fst4 :: (a, b, c, d) -> a
fst4 (x, _, _, _) = x
snd4 :: (a, b, c, d) -> b
snd4 (_, x, _, _) = x
trd4 :: (a, b, c, d) -> c
trd4 (_, _, x, _) = x
fth4 :: (a, b, c, d) -> d
fth4 (_, _, _, x) = x
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)
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)
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)
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)