{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE NoTypeFamilies #-}
{- | Description: TIP functions needing different LANGUAGE extensions

While NoMonoLocalBinds could be enabled in TIP.hs, the ghc manual warns
"type inference becomes less predicatable if you do so. (Read the papers!)".
These definitions don't need type families, putting these definitions in
a separate module avoids that mess.

XXX these should be implemented in terms of 'HTuple' and 'tipyProject',
which means adding
-}
module Data.HList.TIPtuple where

import Data.HList.HOccurs

{- | project a TIP (or HList) into a tuple

@tipyTuple' x = ('hOccurs' x, hOccurs x)@

behaves similarly, except @tipyTuple@ excludes
the possibility of looking up the same element
twice, which allows inferring a concrete type
in more situations. For example

> (\x y z -> tipyTuple (x .*. y .*. emptyTIP) `asTypeOf` (x, z)) () 'x'

has type @Char -> ((), Char)@. tipyTuple' would
need a type annotation to decide whether the type
should be @Char -> ((), Char)@ or @() -> ((), ())@

-}
tipyTuple :: r v -> (t, t)
tipyTuple r v
l = forall {t} {t} {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v') =>
(t -> t -> t) -> t
t (,) forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v') =>
(t -> t -> t) -> t
t (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,))
  where
  t :: (t -> t -> t) -> t
t t -> t -> t
f = case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
l of
     (t
x, r v
ly) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
ly of
         (t
y, r v'
_) -> t -> t -> t
f t
x t
y

tipyTuple3 :: r v -> (t, t, t)
tipyTuple3 r v
l = forall {t} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v') =>
(t -> t -> t -> t) -> t
t (,,)
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v') =>
(t -> t -> t -> t) -> t
t (\t
a t
b t
c -> (t
b,t
c,t
a))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v') =>
(t -> t -> t -> t) -> t
t (\t
a t
b t
c -> (t
c,t
a,t
b))
  where
  t :: (t -> t -> t -> t) -> t
t t -> t -> t -> t
f = case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
l of
    (t
x, r v
lyz) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lyz of
       (t
y, r v
lz) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lz of
          (t
z, r v'
_) -> t -> t -> t -> t
f t
x t
y t
z

tipyTuple4 :: r v -> (t, t, t, t)
tipyTuple4 r v
l = forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]}
       {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t) -> t
t (,,,)
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]}
       {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d -> (t
b,t
c,t
d,t
a))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]}
       {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d -> (t
c,t
d,t
a,t
b))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {v' :: [*]}
       {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d -> (t
d,t
a,t
b,t
c))
  where
  t :: (t -> t -> t -> t -> t) -> t
t t -> t -> t -> t -> t
f = case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
l of
    (t
a, r v
lbcd) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lbcd of
       (t
b, r v
lcd) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lcd of
          (t
c, r v
ld) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
ld of
             (t
d, r v'
_) -> t -> t -> t -> t -> t
f t
a t
b t
c t
d

tipyTuple5 :: r v -> (t, t, t, t, t)
tipyTuple5 r v
l = forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {t}
       {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t -> t) -> t
t (,,,,)
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {t}
       {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d t
e -> (t
b,t
c,t
d,t
e,t
a))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {t}
       {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d t
e -> (t
c,t
d,t
e,t
a,t
b))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {t}
       {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d t
e -> (t
d,t
e,t
a,t
b,t
c))
          forall a. a -> a -> a
`asTypeOf` forall {t} {t} {v :: [*]} {t} {v :: [*]} {t} {v :: [*]} {t}
       {v :: [*]} {v' :: [*]} {t}.
(HOccurs t (r v), HOccurs t (r v), HOccurs t (r v),
 HOccurs t (r v), HOccurs t (r v), HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v,
 HDeleteAtLabel r t v v, HDeleteAtLabel r t v v') =>
(t -> t -> t -> t -> t -> t) -> t
t (\t
a t
b t
c t
d t
e -> (t
e,t
a,t
b,t
c,t
d))
  where
  t :: (t -> t -> t -> t -> t -> t) -> t
t t -> t -> t -> t -> t -> t
f = case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
l of
    (t
a, r v
lbcde) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lbcde of
       (t
b, r v
lcde) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lcde of
          (t
c, r v
lde) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
lde of
            (t
d, r v
le) -> case forall {l} {r :: [*] -> *} {v :: [*]} {v' :: [*]}.
(HOccurs l (r v), HDeleteAtLabel r l v v') =>
r v -> (l, r v')
hOccursRest r v
le of
               (t
e, r v'
_) -> t -> t -> t -> t -> t -> t
f t
a t
b t
c t
d t
e