{-# Language Safe #-}
{-# Language DeriveFunctor #-}
{-# Language DeriveGeneric #-}
module Data.Order.Extended (
type Lifted
, type Lowered
, Extended(..)
, extended
, liftMaybe
, liftEitherL
, liftEitherR
, liftExtended
) where
import safe Data.Order
import safe Data.Order.Syntax
import safe GHC.Generics
import safe Prelude hiding (Eq(..), Ord(..),Bounded)
type Lifted = Either ()
type Lowered a = Either a ()
data Extended a = Bottom | Extended a | Top
deriving ( Eq, Ord, Show, Generic, Functor, Generic1 )
extended :: b -> b -> (a -> b) -> Extended a -> b
extended b _ _ Bottom = b
extended _ t _ Top = t
extended _ _ f (Extended x) = f x
liftMaybe :: (a -> Bool) -> (a -> b) -> a -> Maybe b
liftMaybe p f = g where
g i | p i = Nothing
| otherwise = Just $ f i
liftEitherL :: (a -> Bool) -> (a -> b) -> a -> Lifted b
liftEitherL p f = g where
g i | p i = Left ()
| otherwise = Right $ f i
liftEitherR :: (a -> Bool) -> (a -> b) -> a -> Lowered b
liftEitherR p f = g where
g i | p i = Right ()
| otherwise = Left $ f i
liftExtended :: (a -> Bool) -> (a -> Bool) -> (a -> b) -> a -> Extended b
liftExtended p q f = g where
g i | p i = Bottom
| q i = Top
| otherwise = Extended $ f i
instance Preorder a => Preorder (Extended a) where
_ <~ Top = True
Top <~ _ = False
Bottom <~ _ = True
_ <~ Bottom = False
Extended x <~ Extended y = x <~ y