{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
module Data.Poset.Internal where

import qualified Data.List as List
import qualified GHC.Types as Types
import qualified Prelude
import Prelude hiding (Ordering(..), Ord(..))
import Data.Semigroup
import Data.Monoid

data Ordering = LT | EQ | GT | NC
              deriving (Ordering -> Ordering -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ordering -> Ordering -> Bool
$c/= :: Ordering -> Ordering -> Bool
== :: Ordering -> Ordering -> Bool
$c== :: Ordering -> Ordering -> Bool
Eq, Int -> Ordering -> ShowS
[Ordering] -> ShowS
Ordering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ordering] -> ShowS
$cshowList :: [Ordering] -> ShowS
show :: Ordering -> String
$cshow :: Ordering -> String
showsPrec :: Int -> Ordering -> ShowS
$cshowsPrec :: Int -> Ordering -> ShowS
Show, ReadPrec [Ordering]
ReadPrec Ordering
Int -> ReadS Ordering
ReadS [Ordering]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ordering]
$creadListPrec :: ReadPrec [Ordering]
readPrec :: ReadPrec Ordering
$creadPrec :: ReadPrec Ordering
readList :: ReadS [Ordering]
$creadList :: ReadS [Ordering]
readsPrec :: Int -> ReadS Ordering
$creadsPrec :: Int -> ReadS Ordering
Read, Ordering
forall a. a -> a -> Bounded a
maxBound :: Ordering
$cmaxBound :: Ordering
minBound :: Ordering
$cminBound :: Ordering
Bounded, Int -> Ordering
Ordering -> Int
Ordering -> [Ordering]
Ordering -> Ordering
Ordering -> Ordering -> [Ordering]
Ordering -> Ordering -> Ordering -> [Ordering]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Ordering -> Ordering -> Ordering -> [Ordering]
$cenumFromThenTo :: Ordering -> Ordering -> Ordering -> [Ordering]
enumFromTo :: Ordering -> Ordering -> [Ordering]
$cenumFromTo :: Ordering -> Ordering -> [Ordering]
enumFromThen :: Ordering -> Ordering -> [Ordering]
$cenumFromThen :: Ordering -> Ordering -> [Ordering]
enumFrom :: Ordering -> [Ordering]
$cenumFrom :: Ordering -> [Ordering]
fromEnum :: Ordering -> Int
$cfromEnum :: Ordering -> Int
toEnum :: Int -> Ordering
$ctoEnum :: Int -> Ordering
pred :: Ordering -> Ordering
$cpred :: Ordering -> Ordering
succ :: Ordering -> Ordering
$csucc :: Ordering -> Ordering
Enum)

instance Semigroup Ordering where
  Ordering
EQ <> :: Ordering -> Ordering -> Ordering
<> Ordering
x = Ordering
x
  Ordering
NC <> Ordering
_ = Ordering
NC
  Ordering
LT <> Ordering
_ = Ordering
LT
  Ordering
GT <> Ordering
_ = Ordering
GT

-- Lexicographic ordering.
instance Monoid Ordering where
  mempty :: Ordering
mempty = Ordering
EQ

-- | Internal-use function to convert our Ordering to the ordinary one.
totalOrder :: Ordering -> Types.Ordering
totalOrder :: Ordering -> Ordering
totalOrder Ordering
LT = Ordering
Types.LT
totalOrder Ordering
EQ = Ordering
Types.EQ
totalOrder Ordering
GT = Ordering
Types.GT
totalOrder Ordering
NC = forall a. HasCallStack => String -> a
error String
"Uncomparable elements in total order."

-- | Internal-use function to convert the ordinary Ordering to ours.
partialOrder :: Types.Ordering -> Ordering
partialOrder :: Ordering -> Ordering
partialOrder Ordering
Types.LT = Ordering
LT
partialOrder Ordering
Types.EQ = Ordering
EQ
partialOrder Ordering
Types.GT = Ordering
GT

-- | Class for partially ordered data types.
-- Instances should satisfy the following laws for all values a, b and c:
--
-- * @a <= a@.
--
-- * @a <= b@ and @b <= a@ implies @a == b@.
--
-- * @a <= b@ and @b <= c@ implies @a <= c@
--
-- But note that the floating point instances don't satisfy the first rule.
--
-- Minimal complete definition: 'compare' or '<='
class Eq a => Poset a where
  compare :: a -> a -> Ordering
  -- | Is comparable to.
  (<==>) :: a -> a -> Bool
  -- | Is not comparable to.
  (</=>) :: a -> a -> Bool
  (<)  :: a -> a -> Bool
  (<=) :: a -> a -> Bool
  (>=) :: a -> a -> Bool
  (>)  :: a -> a -> Bool

  a
a `compare` a
b
        | a
a forall a. Eq a => a -> a -> Bool
== a
b = Ordering
EQ
        | a
a forall a. Poset a => a -> a -> Bool
<= a
b = Ordering
LT
        | a
b forall a. Poset a => a -> a -> Bool
<= a
a = Ordering
GT
        | Bool
otherwise = Ordering
NC

  a
a < a
b = a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
== Ordering
LT
  a
a > a
b = a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
== Ordering
GT
  a
a <==> a
b = a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
/= Ordering
NC
  a
a </=> a
b = a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
== Ordering
NC
  a
a <= a
b = a
a forall a. Poset a => a -> a -> Bool
< a
b Bool -> Bool -> Bool
|| a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  a
a >= a
b = a
a forall a. Poset a => a -> a -> Bool
> a
b Bool -> Bool -> Bool
|| a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b forall a. Eq a => a -> a -> Bool
== Ordering
EQ

-- | Class for partially ordered data types where sorting makes sense.
-- This includes all totally ordered sets and floating point types.
-- Instances should satisfy the following laws:
--
-- * The set of elements for which 'isOrdered' returns true is totally ordered.
--
-- * The max (or min) of an insignificant element and a significant element
-- is the significant one.
--
-- * The result of sorting a list should contain only significant elements.
--
-- * @max a b@ = @max b a@
--
-- * @min a b@ = @min b a@
--
-- The idea comes from floating point types, where non-comparable elements
-- (NaN) are the exception rather than the rule.
-- For these types, we can define 'max', 'min' and 'sortBy' to ignore insignificant elements.
-- Thus, a sort of floating point values will discard all NaNs and order the remaining elements.
--
-- Minimal complete definition: 'isOrdered'
class Poset a => Sortable a where
    sortBy :: (a -> a -> Ordering) -> [a] -> [a]
    isOrdered :: a -> Bool
    max :: a -> a -> a
    min :: a -> a -> a

    sortBy a -> a -> Ordering
f = forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((Ordering -> Ordering
totalOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> Ordering
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Sortable a => a -> Bool
isOrdered
    max a
a a
b = case a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b of
      Ordering
LT -> a
b
      Ordering
EQ -> a
a
      Ordering
GT -> a
a
      Ordering
NC -> if forall a. Sortable a => a -> Bool
isOrdered a
a then a
a else if forall a. Sortable a => a -> Bool
isOrdered a
b then a
b else a
a
    min a
a a
b = case a
a forall a. Poset a => a -> a -> Ordering
`compare` a
b of
      Ordering
LT -> a
a
      Ordering
EQ -> a
b
      Ordering
GT -> a
b
      Ordering
NC -> if forall a. Sortable a => a -> Bool
isOrdered a
a then a
a else if forall a. Sortable a => a -> Bool
isOrdered a
b then a
b else a
a

-- | Class for totally ordered data types.
-- Instances should satisfy @isOrdered a = True@ for all @a@.
class Sortable a => Ord a

-- This hack allows us to leverage existing data structures defined in terms of 'Prelude.Ord'.
instance  {-# OVERLAPS #-} (Eq a, Data.Poset.Internal.Ord a) => Prelude.Ord a where
  compare :: a -> a -> Ordering
compare = (Ordering -> Ordering
totalOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Poset a => a -> a -> Ordering
compare
  < :: a -> a -> Bool
(<)  = forall a. Poset a => a -> a -> Bool
(<)
  <= :: a -> a -> Bool
(<=) = forall a. Poset a => a -> a -> Bool
(<=)
  >= :: a -> a -> Bool
(>=) = forall a. Poset a => a -> a -> Bool
(>=)
  > :: a -> a -> Bool
(>)  = forall a. Poset a => a -> a -> Bool
(>)
  min :: a -> a -> a
min  = forall a. Sortable a => a -> a -> a
min
  max :: a -> a -> a
max  = forall a. Sortable a => a -> a -> a
max