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) )