{-# LANGUAGE CPP
           , FlexibleInstances
           , UndecidableInstances
           #-}

#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif

{-# OPTIONS_GHC -Wall -fwarn-tabs #-}

----------------------------------------------------------------
--                                                  ~ 2021.10.17
-- |
-- Module      :  Data.Number.PartialOrd
-- Copyright   :  Copyright (c) 2007--2021 wren gayle romano
-- License     :  BSD3
-- Maintainer  :  wren@cpan.org
-- Stability   :  stable
-- Portability :  semi-portable (OverlappingInstances,...)
--
-- The Prelude's 'Ord' class for dealing with ordered types is often
-- onerous to use because it requires 'Eq' as well as a total
-- ordering. While such total orderings are common, partial orderings
-- are more so. This module presents a class for partially ordered
-- types.
----------------------------------------------------------------
module Data.Number.PartialOrd
    (
    -- * Partial Ordering
      PartialOrd(..)
    -- * Functions
    , comparingPO
    ) where

-- Bugfix for Hugs (September 2006), see note below.
import Prelude hiding (isNaN)
import Hugs.RealFloat (isNaN)

----------------------------------------------------------------
-- | This class defines a partially ordered type. The method names
-- were chosen so as not to conflict with 'Ord' and 'Eq'. We use
-- 'Maybe' instead of defining new types @PartialOrdering@ and
-- @FuzzyBool@ because this way should make the class easier to
-- use.
--
-- Minimum complete definition: 'cmp'

class PartialOrd a where
    -- | like 'compare'
    cmp   :: a -> a -> Maybe Ordering

    -- | like ('>')
    gt    :: a -> a -> Maybe Bool
    gt a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
GT -> forall a. a -> Maybe a
Just Bool
True
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
False
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like ('>=')
    ge    :: a -> a -> Maybe Bool
    ge a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
LT -> forall a. a -> Maybe a
Just Bool
False
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
True
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like ('==')
    eq    :: a -> a -> Maybe Bool
    eq a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
EQ -> forall a. a -> Maybe a
Just Bool
True
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
False
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like ('/=')
    ne    :: a -> a -> Maybe Bool
    ne a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
EQ -> forall a. a -> Maybe a
Just Bool
False
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
True
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like ('<=')
    le    :: a -> a -> Maybe Bool
    le a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
GT -> forall a. a -> Maybe a
Just Bool
False
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
True
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like ('<')
    lt    :: a -> a -> Maybe Bool
    lt a
x a
y = case a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y of
             Just Ordering
LT -> forall a. a -> Maybe a
Just Bool
True
             Just Ordering
_  -> forall a. a -> Maybe a
Just Bool
False
             Maybe Ordering
Nothing -> forall a. Maybe a
Nothing

    -- | like 'max'. The default instance returns the left argument
    -- when they're equal.
    maxPO    :: a -> a -> Maybe a
    maxPO a
x a
y = do Ordering
o <- a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y
                   case Ordering
o of
                       Ordering
GT -> forall a. a -> Maybe a
Just a
x
                       Ordering
EQ -> forall a. a -> Maybe a
Just a
x
                       Ordering
LT -> forall a. a -> Maybe a
Just a
y

    -- | like 'min'. The default instance returns the left argument
    -- when they're equal.
    minPO    :: a -> a -> Maybe a
    minPO a
x a
y = do Ordering
o <- a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a
y
                   case Ordering
o of
                       Ordering
GT -> forall a. a -> Maybe a
Just a
y
                       Ordering
EQ -> forall a. a -> Maybe a
Just a
x
                       Ordering
LT -> forall a. a -> Maybe a
Just a
x

infix 4 `gt`, `ge`, `eq`, `ne`, `le`, `lt`, `maxPO`, `minPO`

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPABLE #-}
#endif
    (Ord a) => PartialOrd a where
    cmp :: a -> a -> Maybe Ordering
cmp   a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> Ordering
`compare` a
y
    gt :: a -> a -> Maybe Bool
gt    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> Bool
>  a
y
    ge :: a -> a -> Maybe Bool
ge    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> Bool
>= a
y
    eq :: a -> a -> Maybe Bool
eq    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Eq a => a -> a -> Bool
== a
y
    ne :: a -> a -> Maybe Bool
ne    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Eq a => a -> a -> Bool
/= a
y
    le :: a -> a -> Maybe Bool
le    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> Bool
<= a
y
    lt :: a -> a -> Maybe Bool
lt    a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> Bool
<  a
y
    maxPO :: a -> a -> Maybe a
maxPO a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> a
`max` a
y
    minPO :: a -> a -> Maybe a
minPO a
x a
y = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! a
x forall a. Ord a => a -> a -> a
`min` a
y


-- N.B. Hugs (Sept 2006) has a buggy definition for 'isNaN' which
-- always returns @False@. We use a fixed version, provided the CPP
-- was run with the right arguments. See "Hugs.RealFloat". If 'cmp'
-- returns @Just Eq@ for @notANumber@ then CPP was run wrongly.
--
-- The instances inherited from Ord are wrong. So we'll fix them.
instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PartialOrd Float where
    cmp :: Float -> Float -> Maybe Ordering
cmp Float
x Float
y | forall a. RealFloat a => a -> Bool
isNaN Float
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN Float
y = forall a. Maybe a
Nothing
            | Bool
otherwise          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Float
x forall a. Ord a => a -> a -> Ordering
`compare` Float
y

instance
#if __GLASGOW_HASKELL__ >= 710
    {-# OVERLAPPING #-}
#endif
    PartialOrd Double where
    cmp :: Double -> Double -> Maybe Ordering
cmp Double
x Double
y | forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN Double
y = forall a. Maybe a
Nothing
            | Bool
otherwise          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Double
x forall a. Ord a => a -> a -> Ordering
`compare` Double
y

----------------------------------------------------------------
-- TODO? add maximumPO\/minimumPO via left or right fold?

-- BUG: Haddock doesn't link the `comparing`
--
-- | Like @Data.Ord.comparing@. Helpful in conjunction with the
-- @xxxBy@ family of functions from "Data.List"
comparingPO :: (PartialOrd b) => (a -> b) -> a -> a -> Maybe Ordering
comparingPO :: forall b a. PartialOrd b => (a -> b) -> a -> a -> Maybe Ordering
comparingPO a -> b
p a
x a
y = a -> b
p a
x forall a. PartialOrd a => a -> a -> Maybe Ordering
`cmp` a -> b
p a
y

----------------------------------------------------------------
----------------------------------------------------------- fin.