{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe #-}
module Data.Order.Extended (
Lifted,
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 (Bounded, Eq (..), Ord (..))
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