{-# 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 = (t -> t -> (t, t)) -> (t, t)
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 (,) (t, t) -> (t, t) -> (t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> (t, t)) -> (t, t)
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 ((t -> t -> (t, 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 r v -> (t, r v)
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 r v -> (t, r v')
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 = (t -> t -> t -> (t, t, t)) -> (t, t, t)
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, t, t) -> (t, t, t) -> (t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> (t, t, t)) -> (t, t, t)
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))
          (t, t, t) -> (t, t, t) -> (t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> (t, t, t)) -> (t, t, t)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v')
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 = (t -> t -> t -> t -> (t, t, t, t)) -> (t, t, t, t)
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, t, t, t) -> (t, t, t, t) -> (t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> (t, t, t, t)) -> (t, t, t, t)
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))
          (t, t, t, t) -> (t, t, t, t) -> (t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> (t, t, t, t)) -> (t, t, t, t)
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))
          (t, t, t, t) -> (t, t, t, t) -> (t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> (t, t, t, t)) -> (t, t, t, t)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v')
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 = (t -> t -> t -> t -> t -> (t, t, t, t, t)) -> (t, t, t, t, t)
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, t, t, t, t) -> (t, t, t, t, t) -> (t, t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> t -> (t, t, t, t, t)) -> (t, t, t, t, t)
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))
          (t, t, t, t, t) -> (t, t, t, t, t) -> (t, t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> t -> (t, t, t, t, t)) -> (t, t, t, t, t)
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))
          (t, t, t, t, t) -> (t, t, t, t, t) -> (t, t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> t -> (t, t, t, t, t)) -> (t, t, t, t, t)
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))
          (t, t, t, t, t) -> (t, t, t, t, t) -> (t, t, t, t, t)
forall a. a -> a -> a
`asTypeOf` (t -> t -> t -> t -> t -> (t, t, t, t, t)) -> (t, t, t, t, t)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v)
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 r v -> (t, r v')
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