Data/Poset/Internal.hs

   1 {-# LANGUAGE FlexibleInstances, OverlappingInstances, UndecidableInstances #-}
   2 module Data.Poset.Internal where
   3
   4 import qualified Data.List as List
   5 import qualified Prelude
   6 import Prelude hiding (Ordering(..), Ord(..))
   7
   8 import Data.Monoid
   9
  10 data Ordering = LT | EQ | GT | NC
  11     deriving (Eq, Show, Read, Bounded, Enum)
  12
  13 -- Lexicographic ordering.
  14 instance Monoid Ordering where
  15     mempty = EQ
  16     mappend EQ x = x
  17     mappend NC _ = NC
  18     mappend LT _ = LT
  19     mappend GT _ = GT
  20
  21 -- | Internal-use function to convert our Ordering to the ordinary one.
  22 totalOrder :: Ordering -> Prelude.Ordering
  23 totalOrder LT = Prelude.LT
  24 totalOrder EQ = Prelude.EQ
  25 totalOrder GT = Prelude.GT
  26 totalOrder NC = error "Uncomparable elements in total order."
  27
  28 -- | Internal-use function to convert the ordinary Ordering to ours.
  29 partialOrder :: Prelude.Ordering -> Ordering
  30 partialOrder Prelude.LT = LT
  31 partialOrder Prelude.EQ = EQ
  32 partialOrder Prelude.GT = GT
  33
  34 -- | Class for partially ordered data types.  Instances should satisfy the
  35 -- following laws for all values a, b and c:
  36 --
  37 -- * @a <= a@.
  38 --
  39 -- * @a <= b@ and @b <= a@ implies @a == b@.
  40 --
  41 -- * @a <= b@ and @b <= c@ implies @a <= c@.
  42 --
  43 -- But note that the floating point instances don't satisfy the first rule.
  44 --
  45 -- Minimal complete definition: 'compare' or '<='.
  46 class Eq a => Poset a where
  47     compare :: a -> a -> Ordering
  48     -- | Is comparable to.
  49     (<==>)  :: a -> a -> Bool
  50     -- | Is not comparable to.
  51     (</=>)  :: a -> a -> Bool
  52     (<)     :: a -> a -> Bool
  53     (<=)    :: a -> a -> Bool
  54     (>=)    :: a -> a -> Bool
  55     (>)     :: a -> a -> Bool
  56
  57     a `compare` b
  58         | a == b = EQ
  59         | a <= b = LT
  60         | b <= a = GT
  61         | otherwise = NC
  62
  63     a <    b = a `compare` b == LT
  64     a >    b = a `compare` b == GT
  65     a <==> b = a `compare` b /= NC
  66     a </=> b = a `compare` b == NC
  67     a <=   b = a < b || a `compare` b == EQ
  68     a >=   b = a > b || a `compare` b == EQ
  69
  70 -- | Class for partially ordered data types where sorting makes sense.
  71 -- This includes all totally ordered sets and floating point types.  Instances
  72 -- should satisfy the following laws:
  73 --
  74 -- * The set of elements for which 'isOrdered' returns true is totally ordered.
  75 --
  76 -- * The max (or min) of an insignificant element and a significant element
  77 -- is the significant one.
  78 --
  79 -- * The result of sorting a list should contain only significant elements.
  80 --
  81 -- * @max a b@ = @max b a@
  82 --
  83 -- * @min a b@ = @min b a@
  84 --
  85 -- The idea comes from floating point types, where non-comparable elements
  86 -- (NaNs) are the exception rather than the rule.  For these types, we can
  87 -- define 'max', 'min' and 'sortBy' to ignore insignificant elements.  Thus, a
  88 -- sort of floating point values will discard all NaNs and order the remaining
  89 -- elements.
  90 --
  91 -- Minimal complete definition: 'isOrdered'
  92 class Poset a => Sortable a where
  93     sortBy :: (a -> a -> Ordering) -> [a] -> [a]
  94     isOrdered :: a -> Bool
  95     max :: a -> a -> a
  96     min :: a -> a -> a
  97
  98     sortBy f = List.sortBy ((totalOrder .) . f) . filter isOrdered
  99     max a b = case a `compare` b of
 100         LT -> b
 101         EQ -> a
 102         GT -> a
 103         NC -> if isOrdered a then a else if isOrdered b then b else a
 104     min a b = case a `compare` b of
 105         LT -> a
 106         EQ -> b
 107         GT -> b
 108         NC -> if isOrdered a then a else if isOrdered b then b else a
 109
 110 -- | Class for totally ordered data types.  Instances should satisfy
 111 -- @isOrdered a = True@ for all @a@.
 112 class Sortable a => Ord a
 113
 114 -- This hack allows us to leverage existing data structures defined in terms
 115 -- of 'Prelude.Ord'.
 116 instance Data.Poset.Internal.Ord a => Prelude.Ord a where
 117     compare = (totalOrder .) . compare
 118     (<)     = (<)
 119     (<=)    = (<=)
 120     (>=)    = (>=)
 121     (>)     = (>)
 122     min     = min
 123     max     = max