Internal.hs

{-
 - Copyright (C) 2009-2010 Nick Bowler.
 -
 - License BSD2:  2-clause BSD license.  See LICENSE for full terms.
 - This is free software: you are free to change and redistribute it.
 - There is NO WARRANTY, to the extent permitted by law.
 -}

module Data.Poset.Internal where

import Data.Monoid

-- | Are two elements of the underlying comparabale or not; if they
-- are, then Ordering tell the relation between them.
data PosetOrd = Comp Ordering | NComp
    deriving (Eq, Show, Read)

instance Bounded PosetOrd where
    minBound = Comp $ minBound 
    maxBound = NComp

instance Enum PosetOrd where
    toEnum n | n >= 0 && n < 3 = Comp $ toEnum n
             | n == 3 = NComp
             | otherwise = error "Data.Poset.toEnum: bad argument"

    fromEnum (Comp c) = fromEnum c
    fromEnum NComp = 3

-- Lexicographic ordering.

instance Monoid PosetOrd where
    mempty = Comp EQ
    mappend (Comp EQ) x = x
    mappend NComp _ = NComp
    mappend (Comp LT) _ = Comp LT
    mappend (Comp GT) _ = Comp GT

-- | Internal-use function to convert the ordinary Ordering to ours.
partialOrder :: Ordering -> PosetOrd
partialOrder = Comp

-- | Class for partially ordered data types.  Instances should satisfy the
-- following laws for all values a, b and c:
--
-- * @a `leq` a@.
--
-- * @a `leq` b@ and @b `leq` a@ implies @a == b@.
--
-- * @a `leq` b@ and @b `leq` c@ implies @a `leq` c@.
--
-- But note that the floating point instances don't satisfy the first rule.
--
-- Minimal definition: posetCmp or leq.
class Eq a => Poset a where
    posetCmp :: a -> a -> PosetOrd
    -- | Is comparable to.
    (<==>)  :: a -> a -> Bool
    -- | Is not comparable to.
    (</=>)  :: a -> a -> Bool
    -- | Less than or equal.
    leq :: a -> a -> Bool
    -- | Greater than or equal.
    geq :: a -> a -> Bool
    -- | Strict less than.
    lt :: a -> a -> Bool
    -- | Strict greater than.
    gt :: a -> a -> Bool

    a `posetCmp` b
        | a == b = Comp EQ
        | a `leq` b = Comp LT
        | b `leq` a = Comp GT
        | otherwise = NComp

    a <==> b = a `posetCmp` b /= NComp
    a </=> b = a `posetCmp` b == NComp

    a `lt` b = a `posetCmp` b == Comp LT
    a `gt` b = a `posetCmp` b == Comp GT

    a `leq` b | a <==> b = a `posetCmp` b /= Comp GT
              | otherwise = False
    a `geq` b | a <==> b = a `posetCmp` b /= Comp LT
              | otherwise = False

infixl 4 <==>,</=>