module Data.PartialOrder where
import Data.Function
import Data.Map (Map)
import Data.Maybe
import Data.Set (Set)
import qualified Data.Map as Map
import qualified Data.Set as Set
class PartialOrder t where
pcompare :: t -> t -> Maybe Ordering
pcompare x y = case (lte x y, lte y x) of
(True, True) -> Just EQ
(True, False) -> Just LT
(False, True) -> Just GT
(False, False) -> Nothing
comparable :: t -> t -> Bool
comparable x y = isJust $ pcompare x y
lte :: t -> t -> Bool
lte x y =
let c = pcompare x y
in c == Just LT || c == Just EQ
gte :: t -> t -> Bool
gte x y =
let c = pcompare x y
in c == Just GT || c == Just EQ
lt :: t -> t -> Bool
lt x y = pcompare x y == Just LT
gt :: t -> t -> Bool
gt x y = pcompare x y == Just GT
eq :: t -> t -> Bool
eq x y = pcompare x y == Just EQ
instance PartialOrder () where
pcompare _ _ = Just EQ
instance PartialOrder Bool where
pcompare x y = Just $ compare x y
instance PartialOrder Int where
pcompare x y = Just $ compare x y
instance PartialOrder Integer where
pcompare x y = Just $ compare x y
instance (PartialOrder a, PartialOrder b) => PartialOrder (a, b) where
pcompare (a1,b1) (a2,b2) =
case pcompare a1 a2 of
Just LT -> Just LT
Just EQ -> pcompare b1 b2
Just GT -> Just GT
Nothing -> Nothing
group3 :: (a,b,c) -> ((a,b),c)
group3 (a,b,c) = ((a,b),c)
ungroup3 :: ((a,b),c) -> (a,b,c)
ungroup3 ((a,b),c) = (a,b,c)
group4 :: (a,b,c,d) -> ((a,b),c,d)
group4 (a,b,c,d) = ((a,b),c,d)
ungroup4 :: ((a,b),c,d) -> (a,b,c,d)
ungroup4 ((a,b),c,d) = (a,b,c,d)
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(.:) = (.) . (.)
instance
(PartialOrder a, PartialOrder b, PartialOrder c)
=> PartialOrder (a, b, c)
where
pcompare = pcompare `on` group3
instance
(PartialOrder a, PartialOrder b, PartialOrder c, PartialOrder d)
=> PartialOrder (a, b, c, d)
where
pcompare = pcompare `on` group4
instance (PartialOrder a, PartialOrder b) => PartialOrder (Either a b) where
pcompare (Left a1) (Left a2) = pcompare a1 a2
pcompare (Left _) (Right _) = Just LT
pcompare (Right _) (Left _) = Just GT
pcompare (Right b1) (Right b2) = pcompare b1 b2
instance (Ord a) => PartialOrder (Set a) where
lte = Set.isSubsetOf
instance (Ord k, PartialOrder v) => PartialOrder (Map k v) where
lte = Map.isSubmapOfBy lte