src/Symantic/Typed/Trans.hs

   1 {-# LANGUAGE ConstraintKinds #-} -- For type class synonyms
   2 {-# LANGUAGE PolyKinds #-}
   3 {-# LANGUAGE DefaultSignatures #-} -- For adding Trans constraints
   4 module Symantic.Typed.Trans where
   5
   6 import Data.Function ((.))
   7 import Data.Kind (Type)
   8
   9 -- * Type family 'Unlifted'
  10 type family Unlifted (repr :: Type -> Type) :: Type -> Type
  11
  12 -- * Class 'Trans'
  13 -- | A 'trans'formation from an interpreter @(from)@ to an interpreter @(to)@.
  14 class Trans from to where
  15   trans :: from a -> to a
  16
  17 -- * Class 'BiTrans'
  18 -- | Convenient type class synonym.
  19 -- Note that this is not necessarily a bijective 'trans'lation,
  20 -- a 'trans' being not necessarily injective nor surjective.
  21 type BiTrans from to = (Trans from to, Trans to from)
  22
  23 -- ** Class 'Liftable'
  24 -- | Convenient type class synonym for using 'Unlifted'
  25 type Liftable repr = Trans (Unlifted repr) repr
  26 lift :: forall repr a.
  27   Liftable repr =>
  28   Unlifted repr a -> repr a
  29 lift = trans @(Unlifted repr)
  30 {-# INLINE lift #-}
  31
  32 unlift :: forall repr a.
  33   Trans repr (Unlifted repr) =>
  34   repr a -> Unlifted repr a
  35 unlift = trans @repr
  36 {-# INLINE unlift #-}
  37
  38 -- ** Class 'Unliftable'
  39 -- | Convenient type class synonym for using 'Unlifted'
  40 type Unliftable repr = Trans repr (Unlifted repr)
  41
  42 -- * Class 'Trans1'
  43 class Trans1 from to where
  44   trans1 ::
  45     (from a -> from b) ->
  46     to a -> to b
  47   default trans1 ::
  48     BiTrans from to =>
  49     (from a -> from b) ->
  50     to a -> to b
  51   trans1 f = trans . f . trans
  52   {-# INLINE trans1 #-}
  53
  54 -- ** Class 'Liftable1'
  55 -- | Convenient type class synonym for using 'Unlifted'
  56 type Liftable1 repr = Trans1 (Unlifted repr) repr
  57 lift1 :: forall repr a b.
  58   Liftable1 repr =>
  59   (Unlifted repr a -> Unlifted repr b) ->
  60   repr a -> repr b
  61 lift1 = trans1 @(Unlifted repr)
  62 {-# INLINE lift1 #-}
  63
  64 -- * Class 'Trans2'
  65 class Trans2 from to where
  66   trans2 ::
  67     (from a -> from b -> from c) ->
  68     to a -> to b -> to c
  69   default trans2 ::
  70     BiTrans from to =>
  71     (from a -> from b -> from c) ->
  72     to a -> to b -> to c
  73   trans2 f a b = trans (f (trans a) (trans b))
  74   {-# INLINE trans2 #-}
  75
  76 -- ** Class 'Liftable2'
  77 -- | Convenient type class synonym for using 'Unlifted'
  78 type Liftable2 repr = Trans2 (Unlifted repr) repr
  79 lift2 :: forall repr a b c.
  80   Liftable2 repr =>
  81   (Unlifted repr a -> Unlifted repr b -> Unlifted repr c) ->
  82   repr a -> repr b -> repr c
  83 lift2 = trans2 @(Unlifted repr)
  84 {-# INLINE lift2 #-}
  85
  86 -- * Class 'Trans3'
  87 class Trans3 from to where
  88   trans3 ::
  89     (from a -> from b -> from c -> from d) ->
  90     to a -> to b -> to c -> to d
  91   default trans3 ::
  92     BiTrans from to =>
  93     (from a -> from b -> from c -> from d) ->
  94     to a -> to b -> to c -> to d
  95   trans3 f a b c = trans (f (trans a) (trans b) (trans c))
  96   {-# INLINE trans3 #-}
  97
  98 -- ** Class 'Liftable3'
  99 -- | Convenient type class synonym for using 'Unlifted'
 100 type Liftable3 repr = Trans3 (Unlifted repr) repr
 101 lift3 :: forall repr a b c d.
 102   Liftable3 repr =>
 103   (Unlifted repr a -> Unlifted repr b -> Unlifted repr c -> Unlifted repr d) ->
 104   repr a -> repr b -> repr c -> repr d
 105 lift3 = trans3 @(Unlifted repr)
 106 {-# INLINE lift3 #-}
 107
 108 {-
 109 -- * Type 'Any'
 110 -- | 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.
 111 newtype Any repr a = Any { unAny :: repr a }
 112 type instance Unlifted (Any repr) = repr
 113 instance Trans (Any repr) repr where
 114   trans = unAny
 115 instance Trans1 (Any repr) repr
 116 instance Trans2 (Any repr) repr
 117 instance Trans3 (Any repr) repr
 118 instance Trans repr (Any repr) where
 119   trans = Any
 120 instance Trans1 repr (Any repr)
 121 instance Trans2 repr (Any repr)
 122 instance Trans3 repr (Any repr)
 123 -}