1 {-# LANGUAGE DefaultSignatures #-}
2 module Symantic.Univariant.Liftable where
4 -- TODO: move to symantic-univariant
6 import Data.Function ((.))
8 -- * Type family 'Unlift'
9 type family Unlift (repr :: * -> *) :: * -> *
11 -- * Class 'Unliftable'
12 class Unliftable repr where
13 unlift :: repr a -> Unlift repr a
16 class Liftable repr where
17 lift :: Unlift repr a -> repr a
19 (Unlift repr a -> Unlift repr b) ->
22 (Unlift repr a -> Unlift repr b -> Unlift repr c) ->
23 repr a -> repr b -> repr c
25 (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) ->
26 repr a -> repr b -> repr c -> repr d
29 (Unlift repr a -> Unlift repr b) ->
33 (Unlift repr a -> Unlift repr b -> Unlift repr c) ->
34 repr a -> repr b -> repr c
37 (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) ->
38 repr a -> repr b -> repr c -> repr d
39 lift1 f = lift . f . unlift
40 lift2 f a b = lift (f (unlift a) (unlift b))
41 lift3 f a b c = lift (f (unlift a) (unlift b) (unlift c))
47 class Symantic from to where