CurryN.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}

module Symantic.Syntaxes.CurryN where

import Data.Function (($), (.))
import Data.Kind (Type)

import Symantic.Syntaxes.EithersOfTuples (Tuples)

-- * Class 'CurryN'

-- | Produce and consume 'Tuples'.
-- Not actually useful for the Generic side of this module,
-- but related through the use of 'Tuples'.
class CurryN args where
  -- Like 'curry' but for an arbitrary number of nested 2-tuples.
  curryN :: (Tuples args -> res) -> args -..-> res

  -- Like 'uncurry' but for an arbitrary number of nested 2-tuples.
  uncurryN :: (args -..-> res) -> Tuples args -> res

  -- Like 'fmap' on @('->')@ but for an arbitrary number of arguments.
  mapresultN :: (a -> b) -> (args -..-> a) -> args -..-> b

instance CurryN '[a] where
  curryN = ($)
  uncurryN = ($)
  mapresultN = (.)
instance CurryN (b ': as) => CurryN (a ': b ': as) where
  curryN f x = curryN @(b ': as) (\xs -> f (x, xs))
  uncurryN f (x, xs) = uncurryN @(b ': as) (f x) xs
  mapresultN f as2r = mapresultN @(b ': as) f . as2r

-- ** Type family ('-..->')
type family (args :: [Type]) -..-> (r :: Type) :: Type where
  '[] -..-> r = r
  (a : args) -..-> r = a -> args -..-> r

-- ** Type family 'Args'
type family Args (f :: Type) :: [Type] where
  Args (a -> r) = a : Args r
  Args r = '[]

-- ** Type family 'Result'
type family Result (as :: Type) :: Type where
  Result (a -> r) = Result r
  Result r = r