-- | Generic arity curry/ uncurry
module Calamity.Internal.GenericCurry
    ( Curry(..)
    , Uncurry(..) ) where

import           Data.Typeable

import           GHC.TypeNats

class Curry t where
  type Curried t
  type Parameters t

  curryG :: t -> Curried t

type family CurryInstanceSelector t :: Nat where
  CurryInstanceSelector (a -> b -> c -> d -> e -> f -> r) = 6
  CurryInstanceSelector (a -> b -> c -> d -> e -> r) = 5
  CurryInstanceSelector (a -> b -> c -> d -> r) = 4
  CurryInstanceSelector (a -> b -> c -> r) = 3
  CurryInstanceSelector (a -> b -> r) = 2
  CurryInstanceSelector (a -> r) = 1

class Curry' (flag :: Nat) t where
  type Curried' (flag :: Nat) t
  type Parameters' (flag :: Nat) t

  curryG' :: Proxy flag -> t -> Curried' flag t

instance (CurryInstanceSelector t ~ flag, Curry' flag t) => Curry t where
  type Curried t = Curried' (CurryInstanceSelector t) t
  type Parameters t = Parameters' (CurryInstanceSelector t) t

  curryG :: t -> Curried t
curryG = Proxy flag -> t -> Curried' flag t
forall (flag :: Nat) t.
Curry' flag t =>
Proxy flag -> t -> Curried' flag t
curryG' (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag)

instance Curry' 6 ((a, b, c, d, e, f) -> r) where
  type Curried' 6 ((a, b, c, d, e, f) -> r) = a -> b -> c -> d -> e -> f -> r
  type Parameters' 6 ((a, b, c, d, e, f) -> r) = (a, b, c, d, e, f)

  curryG' :: Proxy 6
-> ((a, b, c, d, e, f) -> r)
-> Curried' 6 ((a, b, c, d, e, f) -> r)
curryG' _ fn :: (a, b, c, d, e, f) -> r
fn a :: a
a b :: b
b c :: c
c d :: d
d e :: e
e f :: f
f = (a, b, c, d, e, f) -> r
fn (a
a, b
b, c
c, d
d, e
e, f
f)

instance Curry' 5 ((a, b, c, d, e) -> r) where
  type Curried' 5 ((a, b, c, d, e) -> r) = a -> b -> c -> d -> e -> r
  type Parameters' 5 ((a, b, c, d, e) -> r) = (a, b, c, d, e)

  curryG' :: Proxy 5
-> ((a, b, c, d, e) -> r) -> Curried' 5 ((a, b, c, d, e) -> r)
curryG' _ fn :: (a, b, c, d, e) -> r
fn a :: a
a b :: b
b c :: c
c d :: d
d e :: e
e = (a, b, c, d, e) -> r
fn (a
a, b
b, c
c, d
d, e
e)

instance Curry' 4 ((a, b, c, d) -> r) where
  type Curried' 4 ((a, b, c, d) -> r) = a -> b -> c -> d -> r
  type Parameters' 4 ((a, b, c, d) -> r) = (a, b, c, d)

  curryG' :: Proxy 4 -> ((a, b, c, d) -> r) -> Curried' 4 ((a, b, c, d) -> r)
curryG' _ fn :: (a, b, c, d) -> r
fn a :: a
a b :: b
b c :: c
c d :: d
d = (a, b, c, d) -> r
fn (a
a, b
b, c
c, d
d)

instance Curry' 3 ((a, b, c) -> r) where
  type Curried' 3 ((a, b, c) -> r) = a -> b -> c -> r
  type Parameters' 3 ((a, b, c) -> r) = (a, b, c)

  curryG' :: Proxy 3 -> ((a, b, c) -> r) -> Curried' 3 ((a, b, c) -> r)
curryG' _ fn :: (a, b, c) -> r
fn a :: a
a b :: b
b c :: c
c = (a, b, c) -> r
fn (a
a, b
b, c
c)

instance Curry' 2 ((a, b) -> r) where
  type Curried' 2 ((a, b) -> r) = a -> b -> r
  type Parameters' 2 ((a, b) -> r) = (a, b)

  curryG' :: Proxy 2 -> ((a, b) -> r) -> Curried' 2 ((a, b) -> r)
curryG' _ fn :: (a, b) -> r
fn a :: a
a b :: b
b = (a, b) -> r
fn (a
a, b
b)

instance Curry' 1 (a -> r) where
  type Curried' 1 (a -> r) = a -> r
  type Parameters' 1 (a -> r) = a

  curryG' :: Proxy 1 -> (a -> r) -> Curried' 1 (a -> r)
curryG' _ fn :: a -> r
fn = Curried' 1 (a -> r)
a -> r
fn

class Uncurry t where
  type Uncurried t

  uncurryG :: t -> Uncurried t

class Uncurry' (flag :: Nat) t where
  type Uncurried' (flag :: Nat) t

  uncurryG' :: Proxy flag -> t -> Uncurried' flag t

instance (CurryInstanceSelector t ~ flag, Uncurry' flag t) => Uncurry t where
  type Uncurried t = Uncurried' (CurryInstanceSelector t) t

  uncurryG :: t -> Uncurried t
uncurryG = Proxy flag -> t -> Uncurried' flag t
forall (flag :: Nat) t.
Uncurry' flag t =>
Proxy flag -> t -> Uncurried' flag t
uncurryG' (Proxy flag
forall k (t :: k). Proxy t
Proxy @flag)

instance Uncurry' 6 (a -> b -> c -> d -> e -> f -> r) where
  type Uncurried' 6 (a -> b -> c -> d -> e -> f -> r) = (a, b, c, d, e, f) -> r

  uncurryG' :: Proxy 6
-> (a -> b -> c -> d -> e -> f -> r)
-> Uncurried' 6 (a -> b -> c -> d -> e -> f -> r)
uncurryG' _ fn :: a -> b -> c -> d -> e -> f -> r
fn (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f) = a -> b -> c -> d -> e -> f -> r
fn a
a b
b c
c d
d e
e f
f

instance Uncurry' 5 (a -> b -> c -> d -> e -> r) where
  type Uncurried' 5 (a -> b -> c -> d -> e -> r) = (a, b, c, d, e) -> r

  uncurryG' :: Proxy 5
-> (a -> b -> c -> d -> e -> r)
-> Uncurried' 5 (a -> b -> c -> d -> e -> r)
uncurryG' _ f :: a -> b -> c -> d -> e -> r
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e) = a -> b -> c -> d -> e -> r
f a
a b
b c
c d
d e
e

instance Uncurry' 4 (a -> b -> c -> d -> r) where
  type Uncurried' 4 (a -> b -> c -> d -> r) = (a, b, c, d) -> r

  uncurryG' :: Proxy 4
-> (a -> b -> c -> d -> r) -> Uncurried' 4 (a -> b -> c -> d -> r)
uncurryG' _ f :: a -> b -> c -> d -> r
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d) = a -> b -> c -> d -> r
f a
a b
b c
c d
d

instance Uncurry' 3 (a -> b -> c -> r) where
  type Uncurried' 3 (a -> b -> c -> r) = (a, b, c) -> r

  uncurryG' :: Proxy 3 -> (a -> b -> c -> r) -> Uncurried' 3 (a -> b -> c -> r)
uncurryG' _ f :: a -> b -> c -> r
f (a :: a
a, b :: b
b, c :: c
c) = a -> b -> c -> r
f a
a b
b c
c

instance Uncurry' 2 (a -> b -> r) where
  type Uncurried' 2 (a -> b -> r) = (a, b) -> r

  uncurryG' :: Proxy 2 -> (a -> b -> r) -> Uncurried' 2 (a -> b -> r)
uncurryG' _ f :: a -> b -> r
f (a :: a
a, b :: b
b) = a -> b -> r
f a
a b
b

instance Uncurry' 1 (a -> r) where
  type Uncurried' 1 (a -> r) = a -> r

  uncurryG' :: Proxy 1 -> (a -> r) -> Uncurried' 1 (a -> r)
uncurryG' _ f :: a -> r
f = Uncurried' 1 (a -> r)
a -> r
f