-- | Tuple functions.
--
-- Uniform tuples have types 'T2', 'T3' etc. and functions names are
-- prefixed @t2_@ etc.
--
-- Heterogenous tuples (products) are prefixed @p2_@ etc.
module Music.Theory.Tuple where

import Data.List {- base -}
import Data.Monoid {- base -}

-- * P2 (2-product)

p2_from_list :: (t -> t1,t -> t2) -> [t] -> (t1,t2)
p2_from_list :: forall t t1 t2. (t -> t1, t -> t2) -> [t] -> (t1, t2)
p2_from_list (t -> t1
f1,t -> t2
f2) [t]
l =
  case [t]
l of
    [t
c1,t
c2] -> (t -> t1
f1 t
c1,t -> t2
f2 t
c2)
    [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"p2_from_list"

-- | Swap elements of P2
--
-- > p2_swap (1,2) == (2,1)
p2_swap :: (s,t) -> (t,s)
p2_swap :: forall s t. (s, t) -> (t, s)
p2_swap (s
i,t
j) = (t
j,s
i)

-- * T2 (2-tuple, regular)

-- | Uniform two-tuple.
type T2 a = (a,a)

t2_from_list :: [t] -> T2 t
t2_from_list :: forall t. [t] -> T2 t
t2_from_list [t]
l = case [t]
l of {[t
p,t
q] -> (t
p,t
q);[t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t2_from_list"}

t2_to_list :: T2 a -> [a]
t2_to_list :: forall a. T2 a -> [a]
t2_to_list (a
i,a
j) = [a
i,a
j]

t2_swap :: T2 t -> T2 t
t2_swap :: forall t. T2 t -> T2 t
t2_swap = forall s t. (s, t) -> (t, s)
p2_swap

t2_map :: (p -> q) -> T2 p -> T2 q
t2_map :: forall p q. (p -> q) -> T2 p -> T2 q
t2_map p -> q
f (p
p,p
q) = (p -> q
f p
p,p -> q
f p
q)

t2_zipWith :: (p -> q -> r) -> T2 p -> T2 q -> T2 r
t2_zipWith :: forall p q r. (p -> q -> r) -> T2 p -> T2 q -> T2 r
t2_zipWith p -> q -> r
f (p
p,p
q) (q
p',q
q') = (p -> q -> r
f p
p q
p',p -> q -> r
f p
q q
q')

t2_infix :: (a -> a -> b) -> T2 a -> b
t2_infix :: forall a b. (a -> a -> b) -> T2 a -> b
t2_infix a -> a -> b
f (a
i,a
j) = a
i a -> a -> b
`f` a
j

-- | 't2_infix' 'mappend'.
--
-- > t2_join ([1,2],[3,4]) == [1,2,3,4]
t2_join :: Data.Monoid.Monoid m => T2 m -> m
t2_join :: forall m. Monoid m => T2 m -> m
t2_join = forall a b. (a -> a -> b) -> T2 a -> b
t2_infix forall a. Monoid a => a -> a -> a
mappend

-- | 't2_map' 'mconcat' of 'unzip'
--
-- > t2_concat [("ab","cd"),("ef","gh")] == ("abef","cdgh")
t2_concat :: Data.Monoid.Monoid m => [T2 m] -> T2 m
t2_concat :: forall m. Monoid m => [T2 m] -> T2 m
t2_concat = forall p q. (p -> q) -> T2 p -> T2 q
t2_map forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
unzip

-- | 'sort'
--
-- > t2_sort (2,1) == (1,2)
t2_sort :: Ord t => (t,t) -> (t,t)
t2_sort :: forall t. Ord t => (t, t) -> (t, t)
t2_sort (t
p,t
q) = (forall a. Ord a => a -> a -> a
min t
p t
q,forall a. Ord a => a -> a -> a
max t
p t
q)

-- | 'sum'
t2_sum :: Num n => (n,n) -> n
t2_sum :: forall n. Num n => (n, n) -> n
t2_sum (n
i,n
j) = n
i forall a. Num a => a -> a -> a
+ n
j

-- | 'mapM'
t2_mapM :: Monad m => (t -> m u) -> (t,t) -> m (u,u)
t2_mapM :: forall (m :: * -> *) t u.
Monad m =>
(t -> m u) -> (t, t) -> m (u, u)
t2_mapM t -> m u
f (t
i,t
j) = t -> m u
f t
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \u
p -> t -> m u
f t
j forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \u
q -> forall (m :: * -> *) a. Monad m => a -> m a
return (u
p,u
q)

-- | 'mapM_'
t2_mapM_ :: Monad m => (t -> m u) -> (t,t) -> m ()
t2_mapM_ :: forall (m :: * -> *) t u. Monad m => (t -> m u) -> (t, t) -> m ()
t2_mapM_ t -> m u
f (t
i,t
j) = t -> m u
f t
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> m u
f t
j forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * P3 (3-product)

-- | Left rotation.
--
-- > p3_rotate_left (1,2,3) == (2,3,1)
p3_rotate_left :: (s,t,u) -> (t,u,s)
p3_rotate_left :: forall s t u. (s, t, u) -> (t, u, s)
p3_rotate_left (s
i,t
j,u
k) = (t
j,u
k,s
i)

p3_fst :: (a,b,c) -> a
p3_fst :: forall a b c. (a, b, c) -> a
p3_fst (a
a,b
_,c
_) = a
a

p3_snd :: (a,b,c) -> b
p3_snd :: forall a b c. (a, b, c) -> b
p3_snd (a
_,b
b,c
_) = b
b

p3_third :: (a,b,c) -> c
p3_third :: forall a b c. (a, b, c) -> c
p3_third (a
_,b
_,c
c) = c
c

-- * T3 (3 triple, regular)

type T3 a = (a,a,a)

t3_from_list :: [t] -> T3 t
t3_from_list :: forall t. [t] -> T3 t
t3_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r] -> (t
p,t
q,t
r);[t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t3_from_list"}

t3_to_list :: T3 a -> [a]
t3_to_list :: forall a. T3 a -> [a]
t3_to_list (a
i,a
j,a
k) = [a
i,a
j,a
k]

t3_rotate_left :: T3 t -> T3 t
t3_rotate_left :: forall t. T3 t -> T3 t
t3_rotate_left = forall s t u. (s, t, u) -> (t, u, s)
p3_rotate_left

t3_fst :: T3 t -> t
t3_fst :: forall t. T3 t -> t
t3_fst = forall a b c. (a, b, c) -> a
p3_fst

t3_snd :: T3 t -> t
t3_snd :: forall t. T3 t -> t
t3_snd = forall a b c. (a, b, c) -> b
p3_snd

t3_third :: T3 t -> t
t3_third :: forall t. T3 t -> t
t3_third = forall a b c. (a, b, c) -> c
p3_third

t3_map :: (p -> q) -> T3 p -> T3 q
t3_map :: forall p q. (p -> q) -> T3 p -> T3 q
t3_map p -> q
f (p
p,p
q,p
r) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r)

t3_zipWith :: (p -> q -> r) -> T3 p -> T3 q -> T3 r
t3_zipWith :: forall p q r. (p -> q -> r) -> T3 p -> T3 q -> T3 r
t3_zipWith p -> q -> r
f (p
p,p
q,p
r) (q
p',q
q',q
r') = (p -> q -> r
f p
p q
p',p -> q -> r
f p
q q
q',p -> q -> r
f p
r q
r')

t3_infix :: (a -> a -> a) -> T3 a -> a
t3_infix :: forall a. (a -> a -> a) -> T3 a -> a
t3_infix a -> a -> a
f (a
i,a
j,a
k) = (a
i a -> a -> a
`f` a
j) a -> a -> a
`f` a
k

t3_join :: T3 [a] -> [a]
t3_join :: forall a. T3 [a] -> [a]
t3_join = forall a. (a -> a -> a) -> T3 a -> a
t3_infix forall a. [a] -> [a] -> [a]
(++)

t3_sort :: Ord t => (t,t,t) -> (t,t,t)
t3_sort :: forall t. Ord t => (t, t, t) -> (t, t, t)
t3_sort = forall t. [t] -> T3 t
t3_from_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. T3 a -> [a]
t3_to_list

-- * P4 (4-product)

p4_fst :: (a,b,c,d) -> a
p4_fst :: forall a b c d. (a, b, c, d) -> a
p4_fst (a
a,b
_,c
_,d
_) = a
a

p4_snd :: (a,b,c,d) -> b
p4_snd :: forall a b c d. (a, b, c, d) -> b
p4_snd (a
_,b
b,c
_,d
_) = b
b

p4_third :: (a,b,c,d) -> c
p4_third :: forall a b c d. (a, b, c, d) -> c
p4_third (a
_,b
_,c
c,d
_) = c
c

p4_fourth :: (a,b,c,d) -> d
p4_fourth :: forall a b c d. (a, b, c, d) -> d
p4_fourth (a
_,b
_,c
_,d
d) = d
d

p4_zip :: (a,b,c,d) -> (e,f,g,h) -> ((a,e),(b,f),(c,g),(d,h))
p4_zip :: forall a b c d e f g h.
(a, b, c, d) -> (e, f, g, h) -> ((a, e), (b, f), (c, g), (d, h))
p4_zip (a
a,b
b,c
c,d
d) (e
e,f
f,g
g,h
h) = ((a
a,e
e),(b
b,f
f),(c
c,g
g),(d
d,h
h))

-- * T4 (4-tuple, regular)

type T4 a = (a,a,a,a)

t4_from_list :: [t] -> T4 t
t4_from_list :: forall t. [t] -> T4 t
t4_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r,t
s] -> (t
p,t
q,t
r,t
s); [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t4_from_list"}

t4_to_list :: T4 t -> [t]
t4_to_list :: forall t. T4 t -> [t]
t4_to_list (t
p,t
q,t
r,t
s) = [t
p,t
q,t
r,t
s]

t4_fst :: T4 t -> t
t4_fst :: forall t. T4 t -> t
t4_fst = forall a b c d. (a, b, c, d) -> a
p4_fst

t4_snd :: T4 t -> t
t4_snd :: forall t. T4 t -> t
t4_snd = forall a b c d. (a, b, c, d) -> b
p4_snd

t4_third :: T4 t -> t
t4_third :: forall t. T4 t -> t
t4_third = forall a b c d. (a, b, c, d) -> c
p4_third

t4_fourth :: T4 t -> t
t4_fourth :: forall t. T4 t -> t
t4_fourth = forall a b c d. (a, b, c, d) -> d
p4_fourth

t4_map :: (p -> q) -> T4 p -> T4 q
t4_map :: forall p q. (p -> q) -> T4 p -> T4 q
t4_map p -> q
f (p
p,p
q,p
r,p
s) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s)

t4_zipWith :: (p -> q -> r) -> T4 p -> T4 q -> T4 r
t4_zipWith :: forall p q r. (p -> q -> r) -> T4 p -> T4 q -> T4 r
t4_zipWith p -> q -> r
f (p
p,p
q,p
r,p
s) (q
p',q
q',q
r',q
s') = (p -> q -> r
f p
p q
p',p -> q -> r
f p
q q
q',p -> q -> r
f p
r q
r',p -> q -> r
f p
s q
s')

t4_infix :: (a -> a -> a) -> T4 a -> a
t4_infix :: forall a. (a -> a -> a) -> T4 a -> a
t4_infix a -> a -> a
f (a
i,a
j,a
k,a
l) = ((a
i a -> a -> a
`f` a
j) a -> a -> a
`f` a
k) a -> a -> a
`f` a
l

t4_join :: T4 [a] -> [a]
t4_join :: forall a. T4 [a] -> [a]
t4_join = forall a. (a -> a -> a) -> T4 a -> a
t4_infix forall a. [a] -> [a] -> [a]
(++)

-- * P5 (5-product)

p5_fst :: (a,b,c,d,e) -> a
p5_fst :: forall a b c d e. (a, b, c, d, e) -> a
p5_fst (a
a,b
_,c
_,d
_,e
_) = a
a

p5_snd :: (a,b,c,d,e) -> b
p5_snd :: forall a b c d e. (a, b, c, d, e) -> b
p5_snd (a
_,b
b,c
_,d
_,e
_) = b
b

p5_third :: (a,b,c,d,e) -> c
p5_third :: forall a b c d e. (a, b, c, d, e) -> c
p5_third (a
_,b
_,c
c,d
_,e
_) = c
c

p5_fourth :: (a,b,c,d,e) -> d
p5_fourth :: forall a b c d e. (a, b, c, d, e) -> d
p5_fourth (a
_,b
_,c
_,d
d,e
_) = d
d

p5_fifth :: (a,b,c,d,e) -> e
p5_fifth :: forall a b c d e. (a, b, c, d, e) -> e
p5_fifth (a
_,b
_,c
_,d
_,e
e) = e
e

p5_from_list :: (t -> t1, t -> t2, t -> t3, t -> t4, t -> t5) -> [t] -> (t1,t2,t3,t4,t5)
p5_from_list :: forall t t1 t2 t3 t4 t5.
(t -> t1, t -> t2, t -> t3, t -> t4, t -> t5)
-> [t] -> (t1, t2, t3, t4, t5)
p5_from_list (t -> t1
f1,t -> t2
f2,t -> t3
f3,t -> t4
f4,t -> t5
f5) [t]
l =
  case [t]
l of
    [t
c1,t
c2,t
c3,t
c4,t
c5] -> (t -> t1
f1 t
c1,t -> t2
f2 t
c2,t -> t3
f3 t
c3,t -> t4
f4 t
c4,t -> t5
f5 t
c5)
    [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"p5_from_list"

p5_to_list :: (t1 -> t, t2 -> t, t3 -> t, t4 -> t, t5 -> t) -> (t1, t2, t3, t4, t5) -> [t]
p5_to_list :: forall t1 t t2 t3 t4 t5.
(t1 -> t, t2 -> t, t3 -> t, t4 -> t, t5 -> t)
-> (t1, t2, t3, t4, t5) -> [t]
p5_to_list (t1 -> t
f1,t2 -> t
f2,t3 -> t
f3,t4 -> t
f4,t5 -> t
f5) (t1
c1,t2
c2,t3
c3,t4
c4,t5
c5) = [t1 -> t
f1 t1
c1,t2 -> t
f2 t2
c2,t3 -> t
f3 t3
c3,t4 -> t
f4 t4
c4,t5 -> t
f5 t5
c5]

-- * T5 (5-tuple, regular)

type T5 a = (a,a,a,a,a)

t5_from_list :: [t] -> T5 t
t5_from_list :: forall t. [t] -> T5 t
t5_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r,t
s,t
t] -> (t
p,t
q,t
r,t
s,t
t); [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t5_from_list"}

t5_to_list :: T5 t -> [t]
t5_to_list :: forall t. T5 t -> [t]
t5_to_list (t
p,t
q,t
r,t
s,t
t) = [t
p,t
q,t
r,t
s,t
t]

t5_map :: (p -> q) -> T5 p -> T5 q
t5_map :: forall p q. (p -> q) -> T5 p -> T5 q
t5_map p -> q
f (p
p,p
q,p
r,p
s,p
t) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t)

t5_fst :: T5 t -> t
t5_fst :: forall t. T5 t -> t
t5_fst (t
p,t
_,t
_,t
_,t
_) = t
p

t5_snd :: T5 t -> t
t5_snd :: forall t. T5 t -> t
t5_snd (t
_,t
q,t
_,t
_,t
_) = t
q

t5_fourth :: T5 t -> t
t5_fourth :: forall t. T5 t -> t
t5_fourth (t
_,t
_,t
_,t
t,t
_) = t
t

t5_fifth :: T5 t -> t
t5_fifth :: forall t. T5 t -> t
t5_fifth (t
_,t
_,t
_,t
_,t
u) = t
u

t5_infix :: (a -> a -> a) -> T5 a -> a
t5_infix :: forall a. (a -> a -> a) -> T5 a -> a
t5_infix a -> a -> a
f (a
i,a
j,a
k,a
l,a
m) = (((a
i a -> a -> a
`f` a
j) a -> a -> a
`f` a
k) a -> a -> a
`f` a
l) a -> a -> a
`f` a
m

t5_join :: T5 [a] -> [a]
t5_join :: forall a. T5 [a] -> [a]
t5_join = forall a. (a -> a -> a) -> T5 a -> a
t5_infix forall a. [a] -> [a] -> [a]
(++)

-- * P6 (6-product)

p6_fst :: (a,b,c,d,e,f) -> a
p6_fst :: forall a b c d e f. (a, b, c, d, e, f) -> a
p6_fst (a
a,b
_,c
_,d
_,e
_,f
_) = a
a

p6_snd :: (a,b,c,d,e,f) -> b
p6_snd :: forall a b c d e f. (a, b, c, d, e, f) -> b
p6_snd (a
_,b
b,c
_,d
_,e
_,f
_) = b
b

p6_third :: (a,b,c,d,e,f) -> c
p6_third :: forall a b c d e f. (a, b, c, d, e, f) -> c
p6_third (a
_,b
_,c
c,d
_,e
_,f
_) = c
c

p6_fourth :: (a,b,c,d,e,f) -> d
p6_fourth :: forall a b c d e f. (a, b, c, d, e, f) -> d
p6_fourth (a
_,b
_,c
_,d
d,e
_,f
_) = d
d

p6_fifth :: (a,b,c,d,e,f) -> e
p6_fifth :: forall a b c d e f. (a, b, c, d, e, f) -> e
p6_fifth (a
_,b
_,c
_,d
_,e
e,f
_) = e
e

p6_sixth :: (a,b,c,d,e,f) -> f
p6_sixth :: forall a b c d e f. (a, b, c, d, e, f) -> f
p6_sixth (a
_,b
_,c
_,d
_,e
_,f
f) = f
f

-- * T6 (6-tuple, regular)

type T6 a = (a,a,a,a,a,a)

t6_from_list :: [t] -> T6 t
t6_from_list :: forall t. [t] -> T6 t
t6_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r,t
s,t
t,t
u] -> (t
p,t
q,t
r,t
s,t
t,t
u);[t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t6_from_list"}

t6_to_list :: T6 t -> [t]
t6_to_list :: forall t. T6 t -> [t]
t6_to_list (t
p,t
q,t
r,t
s,t
t,t
u) = [t
p,t
q,t
r,t
s,t
t,t
u]

t6_map :: (p -> q) -> T6 p -> T6 q
t6_map :: forall p q. (p -> q) -> T6 p -> T6 q
t6_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u)

t6_sum :: Num t => T6 t -> t
t6_sum :: forall t. Num t => T6 t -> t
t6_sum (t
a,t
b,t
c,t
d,t
e,t
f) = t
a forall a. Num a => a -> a -> a
+ t
b forall a. Num a => a -> a -> a
+ t
c forall a. Num a => a -> a -> a
+ t
d forall a. Num a => a -> a -> a
+ t
e forall a. Num a => a -> a -> a
+ t
f

-- * T7 (7-tuple, regular)

type T7 a = (a,a,a,a,a,a,a)

t7_to_list :: T7 t -> [t]
t7_to_list :: forall t. T7 t -> [t]
t7_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v]

t7_map :: (p -> q) -> T7 p -> T7 q
t7_map :: forall p q. (p -> q) -> T7 p -> T7 q
t7_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u,p
v) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u,p -> q
f p
v)

-- * T8 (8-tuple, regular)

type T8 a = (a,a,a,a,a,a,a,a)

t8_to_list :: T8 t -> [t]
t8_to_list :: forall t. T8 t -> [t]
t8_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w]

t8_map :: (p -> q) -> T8 p -> T8 q
t8_map :: forall p q. (p -> q) -> T8 p -> T8 q
t8_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u,p
v,p
w) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u,p -> q
f p
v,p -> q
f p
w)

-- * P8 (8-product)

p8_third :: (a,b,c,d,e,f,g,h) -> c
p8_third :: forall a b c d e f g h. (a, b, c, d, e, f, g, h) -> c
p8_third (a
_,b
_,c
c,d
_,e
_,f
_,g
_,h
_) = c
c

-- * T9 (9-tuple, regular)

type T9 a = (a,a,a,a,a,a,a,a,a)

t9_to_list :: T9 t -> [t]
t9_to_list :: forall t. T9 t -> [t]
t9_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x]

t9_from_list :: [t] -> T9 t
t9_from_list :: forall t. [t] -> T9 t
t9_from_list [t]
l = case [t]
l of {[t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x] -> (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x); [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t9_from_list?"}

t9_map :: (p -> q) -> T9 p -> T9 q
t9_map :: forall p q. (p -> q) -> T9 p -> T9 q
t9_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u,p
v,p
w,p
x) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u,p -> q
f p
v,p -> q
f p
w,p -> q
f p
x)

-- * T10 (10-tuple, regular)

type T10 a = (a,a,a,a,a,a,a,a,a,a)

t10_to_list :: T10 t -> [t]
t10_to_list :: forall t. T10 t -> [t]
t10_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y]

t10_map :: (p -> q) -> T10 p -> T10 q
t10_map :: forall p q. (p -> q) -> T10 p -> T10 q
t10_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u,p
v,p
w,p
x,p
y) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u,p -> q
f p
v,p -> q
f p
w,p -> q
f p
x,p -> q
f p
y)

-- * T11 (11-tuple, regular)

type T11 a = (a,a,a,a,a,a,a,a,a,a,a)

t11_to_list :: T11 t -> [t]
t11_to_list :: forall t. T11 t -> [t]
t11_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z]

t11_map :: (p -> q) -> T11 p -> T11 q
t11_map :: forall p q. (p -> q) -> T11 p -> T11 q
t11_map p -> q
f (p
p,p
q,p
r,p
s,p
t,p
u,p
v,p
w,p
x,p
y,p
z) = (p -> q
f p
p,p -> q
f p
q,p -> q
f p
r,p -> q
f p
s,p -> q
f p
t,p -> q
f p
u,p -> q
f p
v,p -> q
f p
w,p -> q
f p
x,p -> q
f p
y,p -> q
f p
z)

-- * T12 (12-tuple, regular)

type T12 t = (t,t,t,t,t,t,t,t,t,t,t,t)

t12_to_list :: T12 t -> [t]
t12_to_list :: forall t. T12 t -> [t]
t12_to_list (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z,t
a) = [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z,t
a]

t12_from_list :: [t] -> T12 t
t12_from_list :: forall t. [t] -> T12 t
t12_from_list [t]
l =
    case [t]
l of
      [t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z,t
a] -> (t
p,t
q,t
r,t
s,t
t,t
u,t
v,t
w,t
x,t
y,t
z,t
a)
      [t]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"t12_from_list"

-- | 'foldr1' of 't12_to_list'.
--
-- > t12_foldr1 (+) (1,2,3,4,5,6,7,8,9,10,11,12) == 78
t12_foldr1 :: (t -> t -> t) -> T12 t -> t
t12_foldr1 :: forall t. (t -> t -> t) -> T12 t -> t
t12_foldr1 t -> t -> t
f = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 t -> t -> t
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. T12 t -> [t]
t12_to_list

-- | 'sum' of 't12_to_list'.
--
-- > t12_sum (1,2,3,4,5,6,7,8,9,10,11,12) == 78
t12_sum :: Num n => T12 n -> n
t12_sum :: forall n. Num n => T12 n -> n
t12_sum T12 n
t =
    let (n
n1,n
n2,n
n3,n
n4,n
n5,n
n6,n
n7,n
n8,n
n9,n
n10,n
n11,n
n12) = T12 n
t
    in n
n1 forall a. Num a => a -> a -> a
+ n
n2 forall a. Num a => a -> a -> a
+ n
n3 forall a. Num a => a -> a -> a
+ n
n4 forall a. Num a => a -> a -> a
+ n
n5 forall a. Num a => a -> a -> a
+ n
n6 forall a. Num a => a -> a -> a
+ n
n7 forall a. Num a => a -> a -> a
+ n
n8 forall a. Num a => a -> a -> a
+ n
n9 forall a. Num a => a -> a -> a
+ n
n10 forall a. Num a => a -> a -> a
+ n
n11 forall a. Num a => a -> a -> a
+ n
n12

-- * Family of 'uncurry' functions.

uncurry3 :: (a->b->c -> z) -> (a,b,c) -> z
uncurry3 :: forall a b c z. (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 a -> b -> c -> z
fn (a
a,b
b,c
c) = a -> b -> c -> z
fn a
a b
b c
c
uncurry4 :: (a->b->c->d -> z) -> (a,b,c,d) -> z
uncurry4 :: forall a b c d z. (a -> b -> c -> d -> z) -> (a, b, c, d) -> z
uncurry4 a -> b -> c -> d -> z
fn (a
a,b
b,c
c,d
d) = a -> b -> c -> d -> z
fn a
a b
b c
c d
d
uncurry5 :: (a->b->c->d->e -> z) -> (a,b,c,d,e) -> z
uncurry5 :: forall a b c d e z.
(a -> b -> c -> d -> e -> z) -> (a, b, c, d, e) -> z
uncurry5 a -> b -> c -> d -> e -> z
fn (a
a,b
b,c
c,d
d,e
e) = a -> b -> c -> d -> e -> z
fn a
a b
b c
c d
d e
e
uncurry6 :: (a->b->c->d->e->f -> z) -> (a,b,c,d,e,f) -> z
uncurry6 :: forall a b c d e f z.
(a -> b -> c -> d -> e -> f -> z) -> (a, b, c, d, e, f) -> z
uncurry6 a -> b -> c -> d -> e -> f -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f) = a -> b -> c -> d -> e -> f -> z
fn a
a b
b c
c d
d e
e f
f
uncurry7 :: (a->b->c->d->e->f->g -> z) -> (a,b,c,d,e,f,g) -> z
uncurry7 :: forall a b c d e f g z.
(a -> b -> c -> d -> e -> f -> g -> z)
-> (a, b, c, d, e, f, g) -> z
uncurry7 a -> b -> c -> d -> e -> f -> g -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = a -> b -> c -> d -> e -> f -> g -> z
fn a
a b
b c
c d
d e
e f
f g
g
uncurry8 :: (a->b->c->d->e->f->g->h -> z) -> (a,b,c,d,e,f,g,h) -> z
uncurry8 :: forall a b c d e f g h z.
(a -> b -> c -> d -> e -> f -> g -> h -> z)
-> (a, b, c, d, e, f, g, h) -> z
uncurry8 a -> b -> c -> d -> e -> f -> g -> h -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = a -> b -> c -> d -> e -> f -> g -> h -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h
uncurry9 :: (a->b->c->d->e->f->g->h->i -> z) -> (a,b,c,d,e,f,g,h,i) -> z
uncurry9 :: forall a b c d e f g h i z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> z)
-> (a, b, c, d, e, f, g, h, i) -> z
uncurry9 a -> b -> c -> d -> e -> f -> g -> h -> i -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) = a -> b -> c -> d -> e -> f -> g -> h -> i -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i
uncurry10 :: (a->b->c->d->e->f->g->h->i->j -> z) -> (a,b,c,d,e,f,g,h,i,j) -> z
uncurry10 :: forall a b c d e f g h i j z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z)
-> (a, b, c, d, e, f, g, h, i, j) -> z
uncurry10 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j
uncurry11 :: (a->b->c->d->e->f->g->h->i->j->k -> z) -> (a,b,c,d,e,f,g,h,i,j,k) -> z
uncurry11 :: forall a b c d e f g h i j k z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z)
-> (a, b, c, d, e, f, g, h, i, j, k) -> z
uncurry11 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k) = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k
uncurry12 :: (a->b->c->d->e->f->g->h->i->j->k->l -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l) -> z
uncurry12 :: forall a b c d e f g h i j k l z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l) -> z
uncurry12 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l) = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l
uncurry13 :: (a->b->c->d->e->f->g->h->i->j->k->l->m -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m) -> z
uncurry13 :: forall a b c d e f g h i j k l m z.
(a
 -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> z
uncurry13 a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m) = a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m -> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m
uncurry14 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> z
uncurry14 :: forall a b c d e f g h i j k l m n z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> z
uncurry14 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n
uncurry15 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) -> z
uncurry15 :: forall a b c d e f g h i j k l m n o z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> z
uncurry15 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o
uncurry16 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> z
uncurry16 :: forall a b c d e f g h i j k l m n o p z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p) -> z
uncurry16 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p
uncurry17 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) -> z
uncurry17 :: forall a b c d e f g h i j k l m n o p q z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q) -> z
uncurry17 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q
uncurry18 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) -> z
uncurry18 :: forall a b c d e f g h i j k l m n o p q r z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r) -> z
uncurry18 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r
uncurry19 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) -> z
uncurry19 :: forall a b c d e f g h i j k l m n o p q r s z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s) -> z
uncurry19 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s
uncurry20 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) -> z
uncurry20 :: forall a b c d e f g h i j k l m n o p q r s t z.
(a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
-> z
uncurry20 a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> z
fn (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t) = a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> z
fn a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t

-- Local Variables:
-- truncate-lines:t
-- End: