{-# 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 #-}