]> Git — Sourcephile - haskell/symantic-base.git/blob - src/Symantic/Dityped/Composable.hs
rename Symantic.{Base => Dityped}
[haskell/symantic-base.git] / 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)