{-# 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 = a -> b -> OrderCompareType a b
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 = b -> a -> OrderCompareType b a
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 = a -> b -> OrderCompareType a b
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 = b -> a -> OrderCompareType b a
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq b
b a
a

(>) :: (HasOrderAsymmetric a b) => a -> b -> OrderCompareType a b
> :: a -> b -> OrderCompareType 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
< :: a -> b -> OrderCompareType 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
>= :: a -> b -> OrderCompareType 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
<= :: a -> b -> OrderCompareType 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 ?>? :: a -> b -> Bool
?>? b
b = OrderCompareType a b -> Bool
forall t. CanTestCertainly t => t -> Bool
isNotFalse (OrderCompareType a b -> Bool) -> OrderCompareType a b -> Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> b -> OrderCompareType a b
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> b
b

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

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

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

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

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

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

(!<=!) :: (HasOrderCertainlyAsymmetric a b) => a -> b -> Bool
a
a !<=! :: a -> b -> Bool
!<=! b
b = OrderCompareType a b -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (OrderCompareType a b -> Bool) -> OrderCompareType a b -> Bool
forall a b. (a -> b) -> a -> b
$ a
a a -> b -> OrderCompareType a b
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) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"HasOrd %s %s, HasOrd %s %s" String
typeName1 String
typeName2 String
typeName2 String
typeName3) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has reflexive >=" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> Bool) -> Property) -> (t1 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> NegType Bool) -> Bool -> NegType Bool
forall a b. (a -> b) -> a -> b
$ OrderCompareType t1 t1 -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyFalse (t1
x t1 -> t1 -> OrderCompareType t1 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has reflexive <=" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> Bool) -> Property) -> (t1 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> NegType Bool) -> Bool -> NegType Bool
forall a b. (a -> b) -> a -> b
$ OrderCompareType t1 t1 -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyFalse (t1
x t1 -> t1 -> OrderCompareType t1 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has anti-reflexive >" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> Bool) -> Property) -> (t1 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> NegType Bool) -> Bool -> NegType Bool
forall a b. (a -> b) -> a -> b
$ OrderCompareType t1 t1 -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t1
x t1 -> t1 -> OrderCompareType t1 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has anti-reflexive <" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> Bool) -> Property) -> (t1 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> NegType Bool) -> Bool -> NegType Bool
forall a b. (a -> b) -> a -> b
$ OrderCompareType t1 t1 -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t1
x t1 -> t1 -> OrderCompareType t1 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"> stronly implies >=" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> t2 -> Bool) -> Property) -> (t1 -> t2 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t2
y) OrderCompareType t1 t2 -> OrderCompareType t1 t2 -> Bool
forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t2
y)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"< stronly implies <=" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> t2 -> Bool) -> Property) -> (t1 -> t2 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) OrderCompareType t1 t2 -> OrderCompareType t1 t2 -> Bool
forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t2
y)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly equivalent > and <" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> t2 -> Bool) -> Property) -> (t1 -> t2 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) OrderCompareType t1 t2 -> OrderCompareType t2 t1 -> Bool
forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y t2 -> t1 -> OrderCompareType t2 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly equivalent >= and <=" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> t2 -> Bool) -> Property) -> (t1 -> t2 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= t2
y) OrderCompareType t1 t2 -> OrderCompareType t2 t1 -> Bool
forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y t2 -> t1 -> OrderCompareType t2 t1
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly transitive <" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> t3 -> Bool) -> Property
forall prop. Testable prop => prop -> Property
QC.property ((t1 -> t2 -> t3 -> Bool) -> Property)
-> (t1 -> t2 -> t3 -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) -> ((t1
x t1 -> t2 -> OrderCompareType t1 t2
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t2
y) OrderCompareType t1 t2
-> OrderCompareType t2 t3
-> AndOrType (OrderCompareType t1 t2) (OrderCompareType t2 t3)
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2
y t2 -> t3 -> OrderCompareType t2 t3
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< t3
z)) AndOrType (OrderCompareType t1 t2) (OrderCompareType t2 t3)
-> OrderCompareType t2 t3 -> Bool
forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t2
y t2 -> t3 -> OrderCompareType t2 t3
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) = T t -> T t -> T t -> Spec
forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3, Show t1, Show t2,
 Show t3, CanTestCertainly (OrderCompareType t1 t1),
 CanTestCertainly (OrderCompareType t1 t2),
 CanTestCertainly (OrderCompareType t2 t1),
 CanTestCertainly
   (AndOrType (OrderCompareType t1 t2) (OrderCompareType t2 t3)),
 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
OrderCompareType () ()
False
  leq :: () -> () -> OrderCompareType () ()
leq ()
_ ()
_ = Bool
OrderCompareType () ()
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 = (Integer -> Integer -> Bool) -> Int -> Integer -> Bool
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Integer -> Integer -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Int -> Integer -> OrderCompareType Int Integer
leq = (Integer -> Integer -> Bool) -> Int -> Integer -> Bool
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Integer -> Integer -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Integer Int where
  lessThan :: Integer -> Int -> OrderCompareType Integer Int
lessThan = (Integer -> Integer -> Bool) -> Integer -> Int -> Bool
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Integer -> Integer -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Integer -> Int -> OrderCompareType Integer Int
leq = (Integer -> Integer -> Bool) -> Integer -> Int -> Bool
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Integer -> Integer -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

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

instance HasOrderAsymmetric Integer Rational where
  lessThan :: Integer -> Rational -> OrderCompareType Integer Rational
lessThan = (Rational -> Rational -> Bool) -> Integer -> Rational -> Bool
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Integer -> Rational -> OrderCompareType Integer Rational
leq = (Rational -> Rational -> Bool) -> Integer -> Rational -> Bool
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Rational Integer where
  lessThan :: Rational -> Integer -> OrderCompareType Rational Integer
lessThan = (Rational -> Rational -> Bool) -> Rational -> Integer -> Bool
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Bool
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Rational -> Integer -> OrderCompareType Rational Integer
leq = (Rational -> Rational -> Bool) -> Rational -> Integer -> Bool
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Bool
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 Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer)) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
n Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< (Double -> Integer
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 Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= (Double -> Integer
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 = ((Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer) Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
n) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& ((Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer) Integer -> Integer -> OrderCompareType Integer 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 = ((Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer) Integer -> Integer -> OrderCompareType Integer 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 = Integer -> Double -> OrderCompareType Integer Double
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
n) Double
d
  leq :: Int -> Double -> OrderCompareType Int Double
leq Int
n Double
d = Integer -> Double -> OrderCompareType Integer Double
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (Int -> Integer
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 = Double -> Integer -> OrderCompareType Double Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan Double
d (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
n)
  leq :: Double -> Int -> OrderCompareType Double Int
leq Double
d Int
n = Double -> Integer -> OrderCompareType Double Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq Double
d (Int -> Integer
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 = (a -> b -> OrderCompareType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (OrderCompareType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> OrderCompareType a b
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 = (a -> b -> OrderCompareType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (OrderCompareType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> OrderCompareType a b
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 = (a -> b -> OrderCompareType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (OrderCompareType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> OrderCompareType a b
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 = (a -> b -> OrderCompareType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (OrderCompareType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> OrderCompareType a b
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 = OrderCompareType Integer t -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (OrderCompareType Integer t -> Bool)
-> OrderCompareType Integer t -> Bool
forall a b. (a -> b) -> a -> b
$ t
a t -> Integer -> OrderCompareType t Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0
    default isCertainlyNonNegative :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNonNegative t
a = OrderCompareType Integer t -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (OrderCompareType Integer t -> Bool)
-> OrderCompareType Integer t -> Bool
forall a b. (a -> b) -> a -> b
$ t
a t -> Integer -> OrderCompareType t Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Integer
0
    default isCertainlyNegative :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNegative t
a = OrderCompareType Integer t -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (OrderCompareType Integer t -> Bool)
-> OrderCompareType Integer t -> Bool
forall a b. (a -> b) -> a -> b
$ t
a t -> Integer -> OrderCompareType t Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0
    default isCertainlyNonPositive :: (HasOrderCertainly t Integer) => t -> Bool
    isCertainlyNonPositive t
a = OrderCompareType Integer t -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (OrderCompareType Integer t -> Bool)
-> OrderCompareType Integer t -> Bool
forall a b. (a -> b) -> a -> b
$ t
a t -> Integer -> OrderCompareType t Integer
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 = (es -> Bool) -> (t -> Bool) -> CollectErrors es t -> Bool
forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (Bool -> es -> Bool
forall a b. a -> b -> a
const Bool
False) t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive
  isCertainlyNonNegative :: CollectErrors es t -> Bool
isCertainlyNonNegative = (es -> Bool) -> (t -> Bool) -> CollectErrors es t -> Bool
forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (Bool -> es -> Bool
forall a b. a -> b -> a
const Bool
False) t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative
  isCertainlyNegative :: CollectErrors es t -> Bool
isCertainlyNegative = (es -> Bool) -> (t -> Bool) -> CollectErrors es t -> Bool
forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (Bool -> es -> Bool
forall a b. a -> b -> a
const Bool
False) t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative
  isCertainlyNonPositive :: CollectErrors es t -> Bool
isCertainlyNonPositive = (es -> Bool) -> (t -> Bool) -> CollectErrors es t -> Bool
forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (Bool -> es -> Bool
forall a b. a -> b -> a
const Bool
False) t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonPositive