-- | This module provides the 'POrder' and related classes
module Data.POrder where

import Data.Monoid
import qualified Data.Set as S
import Numeric.Natural
import Data.Function

-- | This class indicates that the type @a@ is partially ordered by some relation ⊑.
--
-- The class does not actually have a method for ⊑, because we do not need it at runtime.
-- Nevertheless the order better exists for the safety of this API.
--
-- This order may be unrelated to the total order given by 'Ord'.
class POrder a where
    -- | The `eqOfLe` method checks _related_ elements for equality.
    --
    -- Formally: For all @x ⊑ y@, @eqOfLe x y == True@ iff @x == y@.
    --
    -- This can be more efficient than testing for equality. For example for
    -- sets, '(==)' needs to compare the elements, but @eqOfLe@ only needs to
    -- compare sizes. It is always ok to use '(==)' here.
    eqOfLe :: a -> a -> Bool

-- | A class indicating that the type @a@ is has a bottom
-- element.
class Bottom a where bottom :: a

-- | A class indicating that the type @a@ is has a top
-- element.
class POrder a => Top a where top :: a

-- | The dual order
instance POrder a => POrder (Dual a) where
    eqOfLe :: Dual a -> Dual a -> Bool
eqOfLe (Dual a
x) (Dual a
y) = a -> a -> Bool
forall a. POrder a => a -> a -> Bool
eqOfLe a
y a
x

-- | Bottom is the 'top' of @a@
instance Top a => Bottom (Dual a) where bottom :: Dual a
bottom = a -> Dual a
forall a. a -> Dual a
Dual a
forall a. Top a => a
top

-- Annoyingly, we have to give all instances here, to avoid orphans

-- | Arbitrary using the @False < True@ order
instance POrder Bool where eqOfLe :: Bool -> Bool -> Bool
eqOfLe = Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Bottom is 'False'
instance Bottom Bool where bottom :: Bool
bottom = Bool
False

-- | Top is 'True'
instance Top Bool where top :: Bool
top = Bool
True

-- | Ordered by 'S.subsetOf'
instance POrder (S.Set a) where eqOfLe :: Set a -> Set a -> Bool
eqOfLe = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Set a -> Int) -> Set a -> Set a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Set a -> Int
forall a. Set a -> Int
S.size

-- | Bottom is 'S.empty'
instance Bottom (S.Set a) where bottom :: Set a
bottom = Set a
forall a. Set a
S.empty

-- | Ordered by '(<=)f'
instance POrder Natural where eqOfLe :: Natural -> Natural -> Bool
eqOfLe = Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Bottom is 0
instance Bottom Natural where bottom :: Natural
bottom = Natural
0

-- | Adds 'Nothing' as a least element to an existing partial order
instance POrder a => POrder (Maybe a) where
    eqOfLe :: Maybe a -> Maybe a -> Bool
eqOfLe Maybe a
Nothing Maybe a
Nothing = Bool
True
    eqOfLe Maybe a
Nothing (Just a
_) = Bool
False
    eqOfLe (Just a
x) (Just a
y) = a -> a -> Bool
forall a. POrder a => a -> a -> Bool
eqOfLe a
x a
y
    eqOfLe (Just a
_) Maybe a
Nothing = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"eqOfLe/Maybe used with unrelated arguments"

-- | Bottom is 'Nothing'
instance POrder a => Bottom (Maybe a) where bottom :: Maybe a
bottom = Maybe a
forall a. Maybe a
Nothing