{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.Ord
(
HasOrder, HasOrderAsymmetric(..), (>), (<), (<=), (>=)
, HasOrderCertainlyAsymmetric, HasOrderCertainly
, (?<=?), (?<?), (?>=?), (?>?)
, (!<=!), (!<!), (!>=!), (!>!)
, specHasOrder, specHasOrderNotMixed
, 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
infix 4 <, <=, >=, >
infix 4 ?<=?, ?<?, ?>=?, ?>?
infix 4 !<=!, !<!, !>=!, !>!
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
lessThan :: a -> b -> (OrderCompareType a b)
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 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
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)
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)
=>
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)
=>
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)
=>
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