{-# 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 -> (a, b)
tipyTuple r v
l = (a -> b -> (a, b)) -> (a, b)
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 (,) (a, b) -> (a, b) -> (a, b)
forall a. a -> a -> a
`asTypeOf` (b -> a -> (a, b)) -> (a, b)
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 ((a -> b -> (a, b)) -> b -> a -> (a, b)
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 -> (a, b, c)
tipyTuple3 r v
l = (a -> b -> c -> (a, b, c)) -> (a, b, c)
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 (,,)
          (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. a -> a -> a
`asTypeOf` (c -> a -> b -> (a, b, c)) -> (a, b, c)
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 (\c
a a
b b
c -> (a
b,b
c,c
a))
          (a, b, c) -> (a, b, c) -> (a, b, c)
forall a. a -> a -> a
`asTypeOf` (b -> c -> a -> (a, b, c)) -> (a, b, c)
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 (\b
a c
b a
c -> (a
c,b
a,c
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 -> (a, b, c, d)
tipyTuple4 r v
l = (a -> b -> c -> d -> (a, b, c, d)) -> (a, b, c, d)
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 (,,,)
          (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
forall a. a -> a -> a
`asTypeOf` (d -> a -> b -> c -> (a, b, c, d)) -> (a, b, c, d)
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 (\d
a a
b b
c c
d -> (a
b,b
c,c
d,d
a))
          (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
forall a. a -> a -> a
`asTypeOf` (c -> d -> a -> b -> (a, b, c, d)) -> (a, b, c, d)
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 (\c
a d
b a
c b
d -> (a
c,b
d,c
a,d
b))
          (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
forall a. a -> a -> a
`asTypeOf` (b -> c -> d -> a -> (a, b, c, d)) -> (a, b, c, d)
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 (\b
a c
b d
c a
d -> (a
d,b
a,c
b,d
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 -> (a, b, c, d, e)
tipyTuple5 r v
l = (a -> b -> c -> d -> e -> (a, b, c, d, e)) -> (a, b, c, d, e)
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 (,,,,)
          (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. a -> a -> a
`asTypeOf` (e -> a -> b -> c -> d -> (a, b, c, d, e)) -> (a, b, c, d, e)
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 (\e
a a
b b
c c
d d
e -> (a
b,b
c,c
d,d
e,e
a))
          (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. a -> a -> a
`asTypeOf` (d -> e -> a -> b -> c -> (a, b, c, d, e)) -> (a, b, c, d, e)
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 (\d
a e
b a
c b
d c
e -> (a
c,b
d,c
e,d
a,e
b))
          (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. a -> a -> a
`asTypeOf` (c -> d -> e -> a -> b -> (a, b, c, d, e)) -> (a, b, c, d, e)
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 (\c
a d
b e
c a
d b
e -> (a
d,b
e,c
a,d
b,e
c))
          (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
forall a. a -> a -> a
`asTypeOf` (b -> c -> d -> e -> a -> (a, b, c, d, e)) -> (a, b, c, d, e)
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 (\b
a c
b d
c e
d a
e -> (a
e,b
a,c
b,d
c,e
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