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