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