1 {-# LANGUAGE ConstraintKinds #-} -- For type class synonyms
2 {-# LANGUAGE DefaultSignatures #-} -- For adding Trans* constraints
3 module Symantic.Univariant.Trans where
5 -- TODO: move to symantic-univariant
7 import Data.Function ((.))
9 -- * Type family 'Unlift'
10 type family Unlift (repr :: * -> *) :: * -> *
13 -- | A 'trans'lation from an interpreter @(from)@ to an interpreter @(to)@.
14 class Trans from to where
15 trans :: from a -> to a
18 -- | Convenient type class synonym.
19 -- Note that this is not necessarily a bijective 'trans'lation, a 'trans' being not necessarily injective nor surjective.
20 type BiTrans from to = (Trans from to, Trans to from)
22 -- ** Class 'Liftable'
23 -- | Convenient type class synonym for using 'Unlift'
24 type Liftable repr = Trans (Unlift repr) repr
25 lift :: forall repr a.
27 Unlift repr a -> repr a
28 lift = trans @(Unlift repr)
31 -- ** Class 'Unliftable'
32 -- | Convenient type class synonym for using 'Unlift'
33 type Unliftable repr = Trans repr (Unlift repr)
36 class Trans1 from to where
44 trans1 f = trans . f . trans
47 -- ** Class 'Liftable1'
48 -- | Convenient type class synonym for using 'Unlift'
49 type Liftable1 repr = Trans1 (Unlift repr) repr
50 lift1 :: forall repr a b.
52 (Unlift repr a -> Unlift repr b) ->
54 lift1 = trans1 @(Unlift repr)
58 class Trans2 from to where
60 (from a -> from b -> from c) ->
64 (from a -> from b -> from c) ->
66 trans2 f a b = trans (f (trans a) (trans b))
69 -- ** Class 'Liftable2'
70 -- | Convenient type class synonym for using 'Unlift'
71 type Liftable2 repr = Trans2 (Unlift repr) repr
72 lift2 :: forall repr a b c.
74 (Unlift repr a -> Unlift repr b -> Unlift repr c) ->
75 repr a -> repr b -> repr c
76 lift2 = trans2 @(Unlift repr)
80 class Trans3 from to where
82 (from a -> from b -> from c -> from d) ->
83 to a -> to b -> to c -> to d
86 (from a -> from b -> from c -> from d) ->
87 to a -> to b -> to c -> to d
88 trans3 f a b c = trans (f (trans a) (trans b) (trans c))
91 -- ** Class 'Liftable3'
92 -- | Convenient type class synonym for using 'Unlift'
93 type Liftable3 repr = Trans3 (Unlift repr) repr
94 lift3 :: forall repr a b c d.
96 (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) ->
97 repr a -> repr b -> repr c -> repr d
98 lift3 = trans3 @(Unlift repr)
102 -- | A newtype to disambiguate the 'Trans' instance to any other interpreter when there is also one or more 'Trans's to other interpreters with a different interpretation than the generic one.
103 newtype Any repr a = Any { unAny :: repr a }
104 type instance Unlift (Any repr) = repr
105 instance Trans (Any repr) repr where
107 instance Trans1 (Any repr) repr
108 instance Trans2 (Any repr) repr
109 instance Trans3 (Any repr) repr
110 instance Trans repr (Any repr) where
112 instance Trans1 repr (Any repr)
113 instance Trans2 repr (Any repr)
114 instance Trans3 repr (Any repr)