{-# LANGUAGE DefaultSignatures #-} module Symantic.Base.Univariant where -- TODO: move to symantic-base import Data.Function ((.)) -- * Type family 'Unlift' type family Unlift (repr :: * -> *) :: * -> * -- * Class 'Unliftable' class Unliftable repr where unlift :: repr a -> Unlift repr a -- * Class 'Liftable' class Liftable repr where lift :: Unlift repr a -> repr a lift1 :: (Unlift repr a -> Unlift repr b) -> repr a -> repr b lift2 :: (Unlift repr a -> Unlift repr b -> Unlift repr c) -> repr a -> repr b -> repr c lift3 :: (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) -> repr a -> repr b -> repr c -> repr d default lift1 :: Unliftable repr => (Unlift repr a -> Unlift repr b) -> repr a -> repr b default lift2 :: Unliftable repr => (Unlift repr a -> Unlift repr b -> Unlift repr c) -> repr a -> repr b -> repr c default lift3 :: Unliftable repr => (Unlift repr a -> Unlift repr b -> Unlift repr c -> Unlift repr d) -> repr a -> repr b -> repr c -> repr d lift1 f = lift . f . unlift lift2 f a b = lift (f (unlift a) (unlift b)) lift3 f a b c = lift (f (unlift a) (unlift b) (unlift c)) {-# INLINE lift1 #-} {-# INLINE lift2 #-} {-# INLINE lift3 #-}