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