]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Syntaxes/Derive.hs
impl: rename type variable `repr` to `sem`
[haskell/symantic-base.git] / src / Symantic / Syntaxes / Derive.hs
1 {-# LANGUAGE ConstraintKinds #-} -- For type class synonyms
2 {-# LANGUAGE PolyKinds #-}
3 {-# LANGUAGE DefaultSignatures #-} -- For adding LiftDerived* constraints
4 module Symantic.Derive where
5
6 import Data.Function ((.))
7 import Data.Kind (Type)
8
9 -- * Type family 'Derived'
10 -- | The next 'Semantic' that @(sem)@ derives to.
11 type family Derived (sem :: Semantic) :: Semantic
12
13 -- * Class 'Derivable'
14 -- | Derive an interpreter to another interpreter
15 -- determined by the 'Derived' open type family.
16 -- This is mostly useful when running the interpreter stack,
17 -- but also when going back from an initial encoding to a final one.
18 --
19 -- Note that 'derive' and 'liftDerived' are not necessarily reciprocical functions.
20 class Derivable sem where
21 derive :: sem a -> Derived sem a
22
23 -- * Class 'LiftDerived'
24 -- | Lift the 'Derived' interpreter of an interpreter, to that interpreter.
25 -- This is mostly useful to give default values to class methods
26 -- in order to skip their definition for interpreters
27 -- where 'liftDerived' can already apply the right semantic.
28 --
29 -- Note that 'derive' and 'liftDerived' are not necessarily reciprocical functions.
30 class LiftDerived sem where
31 liftDerived :: Derived sem a -> sem a
32
33 -- * Class 'LiftDerived1'
34 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with a single argument.
35 class LiftDerived1 sem where
36 liftDerived1 ::
37 (Derived sem a -> Derived sem b) ->
38 sem a -> sem b
39 liftDerived1 f = liftDerived . f . derive
40 default liftDerived1 ::
41 LiftDerived sem => Derivable sem =>
42 (Derived sem a -> Derived sem b) ->
43 sem a -> sem b
44
45 -- * Class 'LiftDerived2'
46 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with two arguments.
47 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived1'.
48 class LiftDerived2 sem where
49 liftDerived2 ::
50 (Derived sem a -> Derived sem b -> Derived sem c) ->
51 sem a -> sem b -> sem c
52 liftDerived2 f a b = liftDerived (f (derive a) (derive b))
53 default liftDerived2 ::
54 LiftDerived sem => Derivable sem =>
55 (Derived sem a -> Derived sem b -> Derived sem c) ->
56 sem a -> sem b -> sem c
57
58 -- * Class 'LiftDerived3'
59 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with three arguments.
60 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived2'.
61 class LiftDerived3 sem where
62 liftDerived3 ::
63 (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d) ->
64 sem a -> sem b -> sem c -> sem d
65 liftDerived3 f a b c = liftDerived (f (derive a) (derive b) (derive c))
66 default liftDerived3 ::
67 LiftDerived sem => Derivable sem =>
68 (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d) ->
69 sem a -> sem b -> sem c -> sem d
70
71 -- * Class 'LiftDerived4'
72 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with three arguments.
73 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived3'.
74 class LiftDerived4 sem where
75 liftDerived4 ::
76 (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d -> Derived sem e) ->
77 sem a -> sem b -> sem c -> sem d -> sem e
78 liftDerived4 f a b c d = liftDerived (f (derive a) (derive b) (derive c) (derive d))
79 default liftDerived4 ::
80 LiftDerived sem => Derivable sem =>
81 (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d -> Derived sem e) ->
82 sem a -> sem b -> sem c -> sem d -> sem e
83
84 -- * Type synonyms @FromDerived*@
85 -- | Convenient type synonym for using 'liftDerived' on 'Syntax' @(syn)@.
86 type FromDerived syn sem = ( LiftDerived sem, syn (Derived sem) )
87 type FromDerived1 syn sem = ( LiftDerived1 sem, syn (Derived sem) )
88 type FromDerived2 syn sem = ( LiftDerived2 sem, syn (Derived sem) )
89 type FromDerived3 syn sem = ( LiftDerived3 sem, syn (Derived sem) )
90 type FromDerived4 syn sem = ( LiftDerived4 sem, syn (Derived sem) )