]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Syntaxes/CurryN.hs
impl: gather in submodules
[haskell/symantic-base.git] / src / Symantic / Syntaxes / CurryN.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DataKinds #-}
3 module Symantic.CurryN where
4
5 import Data.Function (($), (.))
6 import Data.Kind (Type)
7
8 import Symantic.ADT (Tuples)
9
10 -- * Class 'CurryN'
11 -- | Produce and consume 'Tuples'.
12 -- Not actually useful for the Generic side of this module,
13 -- but related through the use of 'Tuples'.
14 class CurryN args where
15 -- Like 'curry' but for an arbitrary number of nested 2-tuples.
16 curryN :: (Tuples args -> res) -> args-..->res
17 -- Like 'uncurry' but for an arbitrary number of nested 2-tuples.
18 uncurryN :: (args-..->res) -> Tuples args -> res
19 -- Like 'fmap' on @('->')@ but for an arbitrary number of arguments.
20 mapresultN :: (a->b) -> (args-..->a) -> args-..->b
21 instance CurryN '[a] where
22 curryN = ($)
23 uncurryN = ($)
24 mapresultN = (.)
25 instance CurryN (b ': as) => CurryN (a ': b ': as) where
26 curryN f x = curryN @(b ': as) (\xs -> f (x, xs))
27 uncurryN f (x, xs) = uncurryN @(b ': as) (f x) xs
28 mapresultN f as2r = mapresultN @(b ': as) f . as2r
29
30 -- ** Type family ('-..->')
31 type family (args :: [Type]) -..-> (r :: Type) :: Type where
32 '[] -..-> r = r
33 (a : args) -..-> r = a -> args -..-> r
34 -- ** Type family 'Args'
35 type family Args (f :: Type) :: [Type] where
36 Args (a -> r) = a : Args r
37 Args r = '[]
38 -- ** Type family 'Result'
39 type family Result (as :: Type) :: Type where
40 Result (a -> r) = Result r
41 Result r = r