{- |
Module      : Antelude.Tuple.Trio
Description : Contains some functions for a three-member Tuple (a Trio).
Maintainer  : dneavesdev@pm.me
-}
module Antelude.Tuple.Trio
    ( Trio
    , curry
    , cycleCCW
    , cycleCW
    , first
    , mapFirst
    , mapSecond
    , mapThird
    , pack
    , reverse
    , second
    , third
    , uncurry
    ) where

import safe           Antelude.Internal.TypesClasses ( Trio )


-- | Get the first item of a 'Trio' Tuple
first :: Trio a b c -> a
first :: forall a b c. Trio a b c -> a
first (a
a, b
_, c
_) = a
a


-- | Get the second item of a 'Trio' Tuple
second :: Trio a b c -> b
second :: forall a b c. Trio a b c -> b
second (a
_, b
b, c
_) = b
b


-- | Get the third item of a 'Trio' Tuple
third :: Trio a b c -> c
third :: forall a b c. Trio a b c -> c
third (a
_, b
_, c
c) = c
c


-- | Apply a function to the first item of a 'Trio' Tuple
mapFirst :: (a -> z) -> Trio a b c -> Trio z b c
mapFirst :: forall a z b c. (a -> z) -> Trio a b c -> Trio z b c
mapFirst a -> z
fn (a
a, b
b, c
c) = (a -> z
fn a
a, b
b, c
c)


-- | Apply a function to the second item of a 'Trio' Tuple
mapSecond :: (b -> z) -> Trio a b c -> Trio a z c
mapSecond :: forall b z a c. (b -> z) -> Trio a b c -> Trio a z c
mapSecond b -> z
fn (a
a, b
b, c
c) = (a
a, b -> z
fn b
b, c
c)


-- | Apply a function to the third item of a 'Trio' Tuple
mapThird :: (c -> z) -> Trio a b c -> Trio a b z
mapThird :: forall c z a b. (c -> z) -> Trio a b c -> Trio a b z
mapThird c -> z
fn (a
a, b
b, c
c) = (a
a, b
b, c -> z
fn c
c)


{- |
   Rotates the item of a 'Trio' Tuple, moving to the right.
   The last item loops back to the first
-}
cycleCW :: Trio a b c -> Trio c a b
cycleCW :: forall a b c. Trio a b c -> Trio c a b
cycleCW (a
a, b
b, c
c) = (c
c, a
a, b
b)


{- |
   Rotates the item of a 'Trio' Tuple, moving to the left.
   The first item loops back to the last
-}
cycleCCW :: Trio a b c -> Trio b c a
cycleCCW :: forall a b c. Trio a b c -> Trio b c a
cycleCCW (a
a, b
b, c
c) = (b
b, c
c, a
a)


-- | Flip the 'Trio' Tuple around, so the first becomes the last and vice versa.
reverse :: Trio a b c -> Trio c b a
reverse :: forall a b c. Trio a b c -> Trio c b a
reverse (a
a, b
b, c
c) = (c
c, b
b, a
a)


-- | Pack all three arguments into a 'Trio' Tuple
pack :: a -> b -> c -> Trio a b c
pack :: forall a b c. a -> b -> c -> Trio a b c
pack a
a b
b c
c = (a
a, b
b, c
c)

-- | convert an uncurried function into a curried function
curry :: ((a, b, c) -> d) -> a -> b -> c -> d
curry :: forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry (a, b, c) -> d
fn a
a b
b c
c = (a, b, c) -> d
fn (a
a, b
b, c
c)

-- | convert a curried function to a function on a 'Trio'
uncurry :: (a -> b -> c -> d) -> (a, b, c) -> d
uncurry :: forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry a -> b -> c -> d
fn (a
a, b
b, c
c) = a -> b -> c -> d
fn a
a b
b c
c