]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Syntaxes/CurryN.hs
iface: add interpreter `LetInserter`
[haskell/symantic-base.git] / src / Symantic / Syntaxes / CurryN.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE DataKinds #-}
3
4 -- | This module gathers utilities for currying or uncurrying tuples
5 -- of size greater or equal to two.
6 module Symantic.Syntaxes.CurryN where
7
8 import Data.Function (($), (.))
9 import Data.Kind (Type)
10
11 import Symantic.Syntaxes.EithersOfTuples (Tuples)
12
13 -- * Class 'CurryN'
14
15 -- | Produce and consume 'Tuples'.
16 -- Not actually useful for 'Symantic.Syntaxes.EithersOfTuples',
17 -- but related through the use of 'Tuples'.
18 class CurryN args where
19 -- Like 'curry' but for an arbitrary number of nested 2-tuples.
20 curryN :: (Tuples args -> res) -> args -..-> res
21
22 -- Like 'uncurry' but for an arbitrary number of nested 2-tuples.
23 uncurryN :: (args -..-> res) -> Tuples args -> res
24
25 -- Like 'fmap' on @('->')@ but for an arbitrary number of arguments.
26 mapresultN :: (a -> b) -> (args -..-> a) -> args -..-> b
27
28 instance CurryN '[a] where
29 curryN = ($)
30 uncurryN = ($)
31 mapresultN = (.)
32 instance CurryN (b ': as) => CurryN (a ': b ': as) where
33 curryN f x = curryN @(b ': as) (\xs -> f (x, xs))
34 uncurryN f (x, xs) = uncurryN @(b ': as) (f x) xs
35 mapresultN f as2r = mapresultN @(b ': as) f . as2r
36
37 -- ** Type family ('-..->')
38 type family (args :: [Type]) -..-> (r :: Type) :: Type where
39 '[] -..-> r = r
40 (a : args) -..-> r = a -> args -..-> r
41
42 -- ** Type family 'Args'
43 type family Args (f :: Type) :: [Type] where
44 Args (a -> r) = a : Args r
45 Args r = '[]
46
47 -- ** Type family 'Result'
48 type family Result (as :: Type) :: Type where
49 Result (a -> r) = Result r
50 Result r = r