{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Ord
    Description :  Bottom-up typed order comparisons
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

-}

module Numeric.MixedTypes.Ord
(
  -- * Comparisons in numeric order
  HasOrder, HasOrderAsymmetric(..), (>), (<), (<=), (>=)
  , HasOrderCertainlyAsymmetric, HasOrderCertainly
  , (?<=?), (?<?), (?>=?), (?>?)
  , (!<=!), (!<!), (!>=!), (!>!)
  -- ** Tests
  , specHasOrder, specHasOrderNotMixed
  -- ** Specific comparisons
  , CanTestPosNeg(..)
)
where

import Utils.TH.DeclForTypes

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf

import Test.Hspec
import qualified Test.QuickCheck as QC

import Control.CollectErrors ( CollectErrors, CanBeErrors )
import qualified Control.CollectErrors as CE

import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
-- import Numeric.MixedTypes.Eq

infix  4  <, <=, >=, >
infix 4 ?<=?, ?<?, ?>=?, ?>?
infix 4 !<=!, !<!, !>=!, !>!

{---- Inequality -----}

type HasOrder t1 t2 =
  (HasOrderAsymmetric t1 t2, HasOrderAsymmetric t2 t1,
   OrderCompareType t1 t2 ~ OrderCompareType t2 t1)

type HasOrderCertainly t1 t2 =
  (HasOrder t1 t2, CanTestCertainly (OrderCompareType t1 t2))

type HasOrderCertainlyAsymmetric t1 t2 =
  (HasOrderAsymmetric t1 t2, CanTestCertainly (OrderCompareType t1 t2))

class (IsBool (OrderCompareType a b)) => HasOrderAsymmetric a b where
    type OrderCompareType a b
    type OrderCompareType a b = Bool -- default
    lessThan :: a -> b -> (OrderCompareType a b)
    -- default lessThan via Prelude for Bool:
    default lessThan :: (OrderCompareType a b ~ Bool, a~b, P.Ord a) => a -> b -> OrderCompareType a b
    lessThan = forall a. Ord a => a -> a -> Bool
(P.<)
    greaterThan :: a -> b -> (OrderCompareType a b)
    default greaterThan ::
      (HasOrder b a, OrderCompareType b a ~ OrderCompareType a b) =>
      a -> b -> (OrderCompareType a b)
    greaterThan a
a b
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan b
b a
a
    leq :: a -> b -> (OrderCompareType a b)
    -- default lessThan via Prelude for Bool:
    default leq :: (OrderCompareType a b ~ Bool, a~b, P.Ord a) => a -> b -> OrderCompareType a b
    leq = forall a. Ord a => a -> a -> Bool
(P.<=)
    geq :: a -> b -> (OrderCompareType a b)
    default geq ::
      (HasOrder b a, OrderCompareType b a ~ OrderCompareType a b) =>
      a -> b -> (OrderCompareType a b)
    geq a
a b
b = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq b
b a
a

(>) :: (HasOrderAsymmetric a b) => a -> b -> OrderCompareType a b
> :: forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
(>) = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
(<) :: (HasOrderAsymmetric a b) => a -> b -> OrderCompareType a b
< :: forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
(<) = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan

(>=) :: (HasOrderAsymmetric a b) => a -> b -> OrderCompareType a b
>= :: forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
(>=) = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq
(<=) :: (HasOrderAsymmetric a b) => a -> b -> OrderCompareType a b
<= :: forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
(<=) = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

(?>?) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a ?>? :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?>? b
b = forall t. CanTestCertainly t => t -> Bool
isNotFalse forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> b
b

(?<?) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a ?<? :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? b
b = forall t. CanTestCertainly t => t -> Bool
isNotFalse forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< b
b

(?>=?) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a ?>=? :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?>=? b
b = forall t. CanTestCertainly t => t -> Bool
isNotFalse forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= b
b

(?<=?) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a ?<=? :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? b
b = forall t. CanTestCertainly t => t -> Bool
isNotFalse forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= b
b

(!>!) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a !>! :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> b
b

(!<!) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a !<! :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< b
b

(!>=!) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a !>=! :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>=! b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= b
b

(!<=!) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a !<=! :: forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= b
b

{-|
  HSpec properties that each implementation of 'HasOrder' should satisfy.
 -}
specHasOrder ::
  _ => T t1 -> T t2 -> T t3 -> Spec
specHasOrder :: T t1 -> T t2 -> T t3 -> Spec
specHasOrder (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) (T String
typeName3 :: T t3) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"HasOrd %s %s, HasOrd %s %s" String
typeName1 String
typeName2 String
typeName2 String
typeName3) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has reflexive >=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyFalse (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has reflexive <=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyFalse (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has anti-reflexive >" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has anti-reflexive <" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"> stronly implies >=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t2
y)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"< stronly implies <=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t2
y)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly equivalent > and <" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly equivalent >= and <=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly transitive <" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
QC.property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) -> ((t1
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2
y forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t3
z)) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t2
y forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t3
z)

{-|
  HSpec properties that each implementation of 'HasOrder' should satisfy.
 -}
specHasOrderNotMixed ::
  _ => T t -> Spec
specHasOrderNotMixed :: T t -> Spec
specHasOrderNotMixed (T t
t :: T t) = forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3, Show t1, Show t2,
 Show t3,
 CanTestCertainly
   (AndOrType (OrderCompareType t1 t2) (OrderCompareType t2 t3)),
 CanTestCertainly (OrderCompareType t1 t1),
 CanTestCertainly (OrderCompareType t1 t2),
 CanTestCertainly (OrderCompareType t2 t1),
 CanTestCertainly (OrderCompareType t2 t3),
 HasOrderAsymmetric t1 t1, HasOrderAsymmetric t1 t2,
 HasOrderAsymmetric t2 t1, HasOrderAsymmetric t2 t3,
 CanAndOrAsymmetric
   (OrderCompareType t1 t2) (OrderCompareType t2 t3)) =>
T t1 -> T t2 -> T t3 -> Spec
specHasOrder T t
t T t
t T t
t

instance HasOrderAsymmetric () () where
  lessThan :: () -> () -> OrderCompareType () ()
lessThan ()
_ ()
_ = Bool
False
  leq :: () -> () -> OrderCompareType () ()
leq ()
_ ()
_ = Bool
True

instance HasOrderAsymmetric Int Int
instance HasOrderAsymmetric Integer Integer
instance HasOrderAsymmetric Rational Rational
instance HasOrderAsymmetric Double Double

instance HasOrderAsymmetric Int Integer where
  lessThan :: Int -> Integer -> OrderCompareType Int Integer
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Int -> Integer -> OrderCompareType Int Integer
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Integer Int where
  lessThan :: Integer -> Int -> OrderCompareType Integer Int
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Integer -> Int -> OrderCompareType Integer Int
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance HasOrderAsymmetric Int Rational where
  lessThan :: Int -> Rational -> OrderCompareType Int Rational
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Int -> Rational -> OrderCompareType Int Rational
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Rational Int where
  lessThan :: Rational -> Int -> OrderCompareType Rational Int
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Rational -> Int -> OrderCompareType Rational Int
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance HasOrderAsymmetric Integer Rational where
  lessThan :: Integer -> Rational -> OrderCompareType Integer Rational
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Integer -> Rational -> OrderCompareType Integer Rational
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Rational Integer where
  lessThan :: Rational -> Integer -> OrderCompareType Rational Integer
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Rational -> Integer -> OrderCompareType Rational Integer
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance HasOrderAsymmetric Integer Double where
  lessThan :: Integer -> Double -> OrderCompareType Integer Double
lessThan Integer
n Double
d = (Integer
n forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= (forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer)) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
n forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< (forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer))
  leq :: Integer -> Double -> OrderCompareType Integer Double
leq Integer
n Double
d = (Integer
n forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= (forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer))
instance HasOrderAsymmetric Double Integer where
  lessThan :: Double -> Integer -> OrderCompareType Double Integer
lessThan Double
d Integer
n = ((forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer) forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
n) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& ((forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer) forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
n)
  leq :: Double -> Integer -> OrderCompareType Double Integer
leq Double
d Integer
n = ((forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer) forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
n)

instance HasOrderAsymmetric Int Double where
  lessThan :: Int -> Double -> OrderCompareType Int Double
lessThan Int
n Double
d = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (forall t. CanBeInteger t => t -> Integer
integer Int
n) Double
d
  leq :: Int -> Double -> OrderCompareType Int Double
leq Int
n Double
d = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (forall t. CanBeInteger t => t -> Integer
integer Int
n) Double
d
instance HasOrderAsymmetric Double Int where
  lessThan :: Double -> Int -> OrderCompareType Double Int
lessThan Double
d Int
n = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan Double
d (forall t. CanBeInteger t => t -> Integer
integer Int
n)
  leq :: Double -> Int -> OrderCompareType Double Int
leq Double
d Int
n = forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq Double
d (forall t. CanBeInteger t => t -> Integer
integer Int
n)

instance
  (HasOrderAsymmetric a b, CanBeErrors es, CanTestCertainly (OrderCompareType a b))
  =>
  HasOrderAsymmetric (CollectErrors es a) (CollectErrors es b)
  where
  type OrderCompareType (CollectErrors es a) (CollectErrors es b) =
    CollectErrors es (OrderCompareType a b)
  lessThan :: CollectErrors es a
-> CollectErrors es b
-> OrderCompareType (CollectErrors es a) (CollectErrors es b)
lessThan = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: CollectErrors es a
-> CollectErrors es b
-> OrderCompareType (CollectErrors es a) (CollectErrors es b)
leq = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
  greaterThan :: CollectErrors es a
-> CollectErrors es b
-> OrderCompareType (CollectErrors es a) (CollectErrors es b)
greaterThan = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
  geq :: CollectErrors es a
-> CollectErrors es b
-> OrderCompareType (CollectErrors es a) (CollectErrors es b)
geq = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
  (\ t -> [d|

    instance
      (HasOrderAsymmetric $t b, CanBeErrors es, CanTestCertainly (OrderCompareType $t b))
      =>
      HasOrderAsymmetric $t (CollectErrors es  b)
      where
      type OrderCompareType $t (CollectErrors es  b) =
        CollectErrors es (OrderCompareType $t b)
      lessThan = CE.liftT1 lessThan
      leq = CE.liftT1 leq
      greaterThan = CE.liftT1 greaterThan
      geq = CE.liftT1 geq

    instance
      (HasOrderAsymmetric a $t, CanBeErrors es, CanTestCertainly (OrderCompareType a $t))
      =>
      HasOrderAsymmetric (CollectErrors es a) $t
      where
      type OrderCompareType (CollectErrors es  a) $t =
        CollectErrors es (OrderCompareType a $t)
      lessThan = CE.lift1T lessThan
      leq = CE.lift1T leq
      greaterThan = CE.lift1T greaterThan
      geq = CE.lift1T geq

  |]))

class CanTestPosNeg t where
    isCertainlyPositive :: t -> Bool
    isCertainlyNonNegative :: t -> Bool
    isCertainlyNegative :: t -> Bool
    isCertainlyNonPositive :: t -> Bool
    default isCertainlyPositive :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyPositive t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ t
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0
    default isCertainlyNonNegative :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNonNegative t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ t
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0
    default isCertainlyNegative :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNegative t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ t
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0
    default isCertainlyNonPositive :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNonPositive t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ t
a forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Integer
0

instance CanTestPosNeg Int
instance CanTestPosNeg Integer
instance CanTestPosNeg Rational
instance CanTestPosNeg Double

instance (CanTestPosNeg t, CanBeErrors es) => (CanTestPosNeg (CollectErrors es t)) where
  isCertainlyPositive :: CollectErrors es t -> Bool
isCertainlyPositive = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive
  isCertainlyNonNegative :: CollectErrors es t -> Bool
isCertainlyNonNegative = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative
  isCertainlyNegative :: CollectErrors es t -> Bool
isCertainlyNegative = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative
  isCertainlyNonPositive :: CollectErrors es t -> Bool
isCertainlyNonPositive = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonPositive