src/Symantic/Base/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   x <.> y = noTrans (unTrans x <.> unTrans y)
  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 = noTrans . void a . unTrans
  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
  38 -- ** Type 'IdentityTrans'
  39 -- | A 'Transformable' that does nothing.
  40 newtype IdentityTrans repr a k
  41  =      IdentityTrans
  42  {    unIdentityTrans :: repr a k }
  43 instance Transformable (IdentityTrans repr) where
  44   type UnTrans (IdentityTrans repr) = repr
  45   noTrans = IdentityTrans
  46   unTrans = unIdentityTrans
  47
  48 -- * Class 'Dimapable'
  49 class Dimapable repr where
  50   default dimap :: Transformable repr => Dimapable (UnTrans repr) =>
  51            (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
  52   dimap :: (a->b) -> (b->a) -> repr (a->k) k -> repr (b->k) k
  53   dimap a2b b2a = noTrans . dimap a2b b2a . unTrans