src/Symantic/Dityped/Composable.hs

   1 module Symantic.Base.Composable where
   2
   3 import Data.Function ((.))
   4
   5 -- * Class 'Composable'
   6 class Composable repr where
   7   default (<.>) :: Transformable repr => Composable (UnTrans repr) =>
   8            repr a b -> repr b c -> repr a c
   9   (<.>) :: repr a b -> repr b c -> repr a c
  10   (<.>) = trans2 (<.>)
  11 infixr 4 <.>
  12
  13 -- * Class 'Voidable'
  14 class Voidable repr where
  15   default void :: Transformable repr => Voidable (UnTrans repr) =>
  16           a -> repr (a -> b) k -> repr b k
  17   void :: a -> repr (a -> b) k -> repr b k
  18   void a = trans1 (void a)
  19
  20 -- * Class 'Transformable'
  21 -- | Used with @DefaultSignatures@ and default methods,
  22 -- in the symantics class definition,
  23 -- it then avoids on an interpreter instance
  24 -- to define unused methods.
  25 class Transformable repr where
  26   -- | The underlying representation that @(repr)@ transforms.
  27   type UnTrans repr :: * -> * -> *
  28   -- | Lift the underlying representation to @(repr)@.
  29   -- Useful to define a combinator that does nothing
  30   -- in a transformation.
  31   noTrans :: UnTrans repr a b -> repr a b
  32   -- | Unlift a representation. Useful when a transformation
  33   -- combinator needs to access the 'UnTrans'formed representation,
  34   -- or at the end to get the underlying 'UnTrans'formed representation
  35   -- from the inferred @(repr)@ value.
  36   unTrans :: repr a b -> UnTrans repr a b
  37   -- | Convenient helper lifing an unary operator,
  38   -- but also enables to identify unary operators.
  39   trans1 :: (UnTrans repr a b -> UnTrans repr c d) -> repr a b -> repr c d
  40   trans1 f = noTrans . f . unTrans
  41   -- | Convenient helper lifting a binary operator,
  42   -- but also enables to identify binary operators.
  43   trans2 :: (UnTrans repr a b -> UnTrans repr c d -> UnTrans repr e f) -> repr a b -> repr c d -> repr e f
  44   trans2 f x y = noTrans (f (unTrans x) (unTrans y))
  45
  46 -- ** Type 'IdentityTrans'
  47 -- | A 'Transformable' that does nothing.
  48 newtype IdentityTrans repr a k
  49  =      IdentityTrans
  50  {    unIdentityTrans :: repr a k }
  51 instance Transformable (IdentityTrans repr) where
  52   type UnTrans (IdentityTrans repr) = repr
  53   noTrans = IdentityTrans
  54   unTrans = unIdentityTrans
  55
  56 -- * Class 'Dimapable'
  57 class Dimapable repr where
  58   default dimap :: Transformable repr => Dimapable (UnTrans repr) =>
  59            (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
  60   dimap :: (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
  61   dimap a2b b2a = trans1 (dimap a2b b2a)