src/Symantic/Syntaxes/Derive.hs

   1 -- For type class synonyms
   2 {-# LANGUAGE ConstraintKinds #-}
   3 -- For Semantic
   4 {-# LANGUAGE DataKinds #-}
   5 -- For adding LiftDerived* constraints
   6 {-# LANGUAGE DefaultSignatures #-}
   7 {-# LANGUAGE PolyKinds #-}
   8
   9 module Symantic.Syntaxes.Derive where
  10
  11 import Data.Function ((.))
  12 import Data.Kind (Type)
  13
  14 -- * Type 'Semantic'
  15
  16 -- | The kind of @sem@(antics) throughout this library.
  17 type Semantic = Type -> Type
  18
  19 -- * Type family 'Derived'
  20
  21 -- | The next 'Semantic' that @(sem)@ derives to.
  22 type family Derived (sem :: Semantic) :: Semantic
  23
  24 -- * Class 'Derivable'
  25
  26 -- | Derive from a semantic @(sem)@
  27 -- another semantic determined by the 'Derived' open type family.
  28 -- This is mostly useful when running a semantic stack,
  29 -- but also when going back from an initial encoding to a final one.
  30 --
  31 -- Note that 'derive' and 'liftDerived' are not necessarily reciprocical functions.
  32 class Derivable sem where
  33   derive :: sem a -> Derived sem a
  34
  35 -- * Class 'LiftDerived'
  36
  37 -- | Lift the 'Derived' interpreter of an interpreter, to that interpreter.
  38 -- This is mostly useful to give default values to class methods
  39 -- in order to skip their definition for interpreters
  40 -- where 'liftDerived' can already apply the right semantic.
  41 --
  42 -- Note that 'derive' and 'liftDerived' are not necessarily reciprocical functions.
  43 class LiftDerived sem where
  44   liftDerived :: Derived sem a -> sem a
  45
  46 -- * Class 'LiftDerived1'
  47
  48 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with a single argument.
  49 class LiftDerived1 sem where
  50   liftDerived1 ::
  51     (Derived sem a -> Derived sem b) ->
  52     sem a ->
  53     sem b
  54   liftDerived1 f = liftDerived . f . derive
  55   default liftDerived1 ::
  56     LiftDerived sem =>
  57     Derivable sem =>
  58     (Derived sem a -> Derived sem b) ->
  59     sem a ->
  60     sem b
  61
  62 -- * Class 'LiftDerived2'
  63
  64 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with two arguments.
  65 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived1'.
  66 class LiftDerived2 sem where
  67   liftDerived2 ::
  68     (Derived sem a -> Derived sem b -> Derived sem c) ->
  69     sem a ->
  70     sem b ->
  71     sem c
  72   liftDerived2 f a b = liftDerived (f (derive a) (derive b))
  73   default liftDerived2 ::
  74     LiftDerived sem =>
  75     Derivable sem =>
  76     (Derived sem a -> Derived sem b -> Derived sem c) ->
  77     sem a ->
  78     sem b ->
  79     sem c
  80
  81 -- * Class 'LiftDerived3'
  82
  83 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with three arguments.
  84 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived2'.
  85 class LiftDerived3 sem where
  86   liftDerived3 ::
  87     (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d) ->
  88     sem a ->
  89     sem b ->
  90     sem c ->
  91     sem d
  92   liftDerived3 f a b c = liftDerived (f (derive a) (derive b) (derive c))
  93   default liftDerived3 ::
  94     LiftDerived sem =>
  95     Derivable sem =>
  96     (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d) ->
  97     sem a ->
  98     sem b ->
  99     sem c ->
 100     sem d
 101
 102 -- * Class 'LiftDerived4'
 103
 104 -- | Convenient wrapper of 'derive' and 'liftDerived' for functions with three arguments.
 105 -- Note that the default instance relies upon 'LiftDerived', not 'LiftDerived3'.
 106 class LiftDerived4 sem where
 107   liftDerived4 ::
 108     (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d -> Derived sem e) ->
 109     sem a ->
 110     sem b ->
 111     sem c ->
 112     sem d ->
 113     sem e
 114   liftDerived4 f a b c d = liftDerived (f (derive a) (derive b) (derive c) (derive d))
 115   default liftDerived4 ::
 116     LiftDerived sem =>
 117     Derivable sem =>
 118     (Derived sem a -> Derived sem b -> Derived sem c -> Derived sem d -> Derived sem e) ->
 119     sem a ->
 120     sem b ->
 121     sem c ->
 122     sem d ->
 123     sem e
 124
 125 -- * Type synonyms @FromDerived*@
 126
 127 -- | Convenient type synonym for using 'liftDerived' on 'Syntax' @(syn)@.
 128 type FromDerived syn sem = (LiftDerived sem, syn (Derived sem))
 129
 130 type FromDerived1 syn sem = (LiftDerived1 sem, syn (Derived sem))
 131 type FromDerived2 syn sem = (LiftDerived2 sem, syn (Derived sem))
 132 type FromDerived3 syn sem = (LiftDerived3 sem, syn (Derived sem))
 133 type FromDerived4 syn sem = (LiftDerived4 sem, syn (Derived sem))