]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Derive.hs
copyright: fix REUSE
[haskell/symantic-base.git] / src / Symantic / 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 representation that @(repr)@ derives to.
11 type family Derived (repr :: Type -> Type) :: Type -> Type
12
13 -- * Class 'Derivable'
14 -- | Derivable an interpreter to a 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 repr where
21 derive :: repr a -> Derived repr 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 repr where
31 liftDerived :: Derived repr a -> repr a
32
33 -- * Class 'LiftDerived1'
34 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with a single argument.
35 class LiftDerived1 repr where
36 liftDerived1 ::
37 (Derived repr a -> Derived repr b) ->
38 repr a -> repr b
39 liftDerived1 f = liftDerived . f . derive
40 default liftDerived1 ::
41 LiftDerived repr => Derivable repr =>
42 (Derived repr a -> Derived repr b) ->
43 repr a -> repr 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 repr where
49 liftDerived2 ::
50 (Derived repr a -> Derived repr b -> Derived repr c) ->
51 repr a -> repr b -> repr c
52 liftDerived2 f a b = liftDerived (f (derive a) (derive b))
53 default liftDerived2 ::
54 LiftDerived repr => Derivable repr =>
55 (Derived repr a -> Derived repr b -> Derived repr c) ->
56 repr a -> repr b -> repr 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 repr where
62 liftDerived3 ::
63 (Derived repr a -> Derived repr b -> Derived repr c -> Derived repr d) ->
64 repr a -> repr b -> repr c -> repr d
65 liftDerived3 f a b c = liftDerived (f (derive a) (derive b) (derive c))
66 default liftDerived3 ::
67 LiftDerived repr => Derivable repr =>
68 (Derived repr a -> Derived repr b -> Derived repr c -> Derived repr d) ->
69 repr a -> repr b -> repr c -> repr 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 repr where
75 liftDerived4 ::
76 (Derived repr a -> Derived repr b -> Derived repr c -> Derived repr d -> Derived repr e) ->
77 repr a -> repr b -> repr c -> repr d -> repr e
78 liftDerived4 f a b c d = liftDerived (f (derive a) (derive b) (derive c) (derive d))
79 default liftDerived4 ::
80 LiftDerived repr => Derivable repr =>
81 (Derived repr a -> Derived repr b -> Derived repr c -> Derived repr d -> Derived repr e) ->
82 repr a -> repr b -> repr c -> repr d -> repr e
83
84 -- * Type synonyms @FromDerived*@
85 -- | Convenient type synonym for using 'liftDerived' on symantic class @(sym)@.
86 type FromDerived sym repr = ( LiftDerived repr, sym (Derived repr) )
87 type FromDerived1 sym repr = ( LiftDerived1 repr, sym (Derived repr) )
88 type FromDerived2 sym repr = ( LiftDerived2 repr, sym (Derived repr) )
89 type FromDerived3 sym repr = ( LiftDerived3 repr, sym (Derived repr) )
90 type FromDerived4 sym repr = ( LiftDerived4 repr, sym (Derived repr) )