{- |

 Description : curry / uncurry

 Convert between functions taking HLists and functions taking many arguments

-}
module Data.HList.HCurry where

import Data.HList.FakePrelude
import Data.HList.HList
import Data.HList.TypeEqO () -- Arity instance

{- | 'curry'/'uncurry' for many arguments and HLists instead of tuples

XXX the last FD @xs -> n@ is needed to make hCompose infer the right types:
arguably it shouldn't be needed

-}
class HLengthEq xs n => HCurry' (n :: HNat) f xs r
          | f xs -> r, r xs -> f, n f -> xs, xs -> n where
    hUncurry' :: Proxy n -> f -> HList xs -> r
    hCurry' :: Proxy n -> (HList xs -> r) -> f

instance HCurry' HZero b '[] b where
    hUncurry' :: Proxy 'HZero -> b -> HList '[] -> b
hUncurry' Proxy 'HZero
_ b
b HList '[]
_ = b
b
    hCurry' :: Proxy 'HZero -> (HList '[] -> b) -> b
hCurry' Proxy 'HZero
_ HList '[] -> b
f = HList '[] -> b
f HList '[]
HNil

instance (HCurry' n b xs r) => HCurry' (HSucc n) (x -> b) (x ': xs) r where
    hUncurry' :: Proxy ('HSucc n) -> (x -> b) -> HList (x : xs) -> r
hUncurry' Proxy ('HSucc n)
n x -> b
f (HCons x
x HList xs
xs) = forall (n :: HNat) f (xs :: [*]) r.
HCurry' n f xs r =>
Proxy n -> f -> HList xs -> r
hUncurry' (forall (n :: HNat). Proxy ('HSucc n) -> Proxy n
hPred Proxy ('HSucc n)
n) (x -> b
f x
x) HList xs
xs
    hCurry' :: Proxy ('HSucc n) -> (HList (x : xs) -> r) -> x -> b
hCurry' Proxy ('HSucc n)
n HList (x : xs) -> r
f x
x = forall (n :: HNat) f (xs :: [*]) r.
HCurry' n f xs r =>
Proxy n -> (HList xs -> r) -> f
hCurry' (forall (n :: HNat). Proxy ('HSucc n) -> Proxy n
hPred Proxy ('HSucc n)
n) (HList (x : xs) -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons x
x)

hUncurry :: f -> HList xs -> r
hUncurry f
f = forall (n :: HNat) f (xs :: [*]) r.
HCurry' n f xs r =>
Proxy n -> f -> HList xs -> r
hUncurry' (forall f (n :: HNat). Arity f n => f -> Proxy n
arityOf f
f) f
f

-- | Note: with ghc-7.10 the Arity constraint added here does not work
-- properly with hCompose, so it is possible that other uses of 'hCurry'
-- are better served by @hCurry' Proxy@.
hCurry :: (HList xs -> r) -> f
hCurry HList xs -> r
f = let f' :: f
f' = forall (n :: HNat) f (xs :: [*]) r.
HCurry' n f xs r =>
Proxy n -> (HList xs -> r) -> f
hCurry' (forall f (n :: HNat). Arity f n => f -> Proxy n
arityOf f
f') HList xs -> r
f
           in f
f'

{- | compose two functions that take multiple arguments. The result of the
second function is the first argument to the first function. An example is
probably clearer:

>>> let f = hCompose (,,) (,)
>>> :t f
f :: ... -> ... -> ... -> ... -> ((..., ...), ..., ...)

>>> f 1 2 3 4
((1,2),3,4)

Note: polymorphism can make it confusing as to how many parameters a function
actually takes. For example, the first two ids are @id :: (a -> b) -> (a -> b)@ in

>>> (.) id id id 'y'
'y'

>>> hCompose id id id 'y'
'y'

still typechecks, but in that case @hCompose i1 i2 i3 x == i1 ((i2 i3) x)@
has id with different types than @(.) i1 i2 i3 x == (i1 (i2 i3)) x

Prompted by <http://stackoverflow.com/questions/28932054/can-hlistelim-be-composed-with-another-function>

-}
hCompose :: (x -> b) -> f -> f
hCompose x -> b
f f
g = forall (n :: HNat) f (xs :: [*]) r.
HCurry' n f xs r =>
Proxy n -> (HList xs -> r) -> f
hCurry' forall {k} (t :: k). Proxy t
Proxy forall a b. (a -> b) -> a -> b
$ \HList xsys
xs -> case forall (n :: HNat) (xsys :: [*]) (xs :: [*]) (ys :: [*]).
HSplitAt n xsys xs ys =>
Proxy n -> HList xsys -> (HList xs, HList ys)
hSplitAt forall {k} (t :: k). Proxy t
Proxy HList xsys
xs of
        (HList xs
xg,HList xs
xf) -> forall {n :: HNat} {f} {xs :: [*]} {r}.
(HCurry' n f xs r, ArityFwd f n, ArityRev f n) =>
f -> HList xs -> r
hUncurry x -> b
f (forall {n :: HNat} {f} {xs :: [*]} {r}.
(HCurry' n f xs r, ArityFwd f n, ArityRev f n) =>
f -> HList xs -> r
hUncurry f
g HList xs
xg forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList xs
xf)


arityOf :: Arity f n => f -> Proxy n
arityOf :: forall f (n :: HNat). Arity f n => f -> Proxy n
arityOf f
_ = forall {k} (t :: k). Proxy t
Proxy