{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Round
    Description :  Bottom-up typed round, floor, etc.
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

-}

module Numeric.MixedTypes.Round
(
  -- * Rounded division + modulus
  CanDivIMod(..)
  , CanDivIModIntegerSameType
  , CanDivIModIntegerSameTypeCN
  -- * Rounding
  , CanRound(..), HasIntegerBounds(..)
  -- ** Tests
  , specCanDivIMod, specCanRound, specHasIntegerBounds
)
where

import Utils.TH.DeclForTypes

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Data.Fixed (divMod')

-- import qualified Data.List as List

import Test.Hspec
import Test.QuickCheck as QC

import Numeric.CollectErrors ( CN )
import qualified Numeric.CollectErrors as CN

import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
-- import Numeric.MixedTypes.MinMaxAbs
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Mul

{----  rounded division + modulo -----}

class CanDivIMod t1 t2 where
  type DivIType t1 t2
  type ModType t1 t2
  type ModType t1 t2 = t1
  divIMod :: t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
  mod :: t1 -> t2 -> ModType t1 t2
  mod t1
a t2
b = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
a t2
b
  divI :: t1 -> t2 -> DivIType t1 t2
  divI t1
a t2
b = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
a t2
b

type CanDivIModIntegerSameType t =
  (CanDivIMod t t, DivIType t t ~ Integer, ModType t t ~ t)

type CanDivIModIntegerSameTypeCN t =
  (CanDivIMod t t, DivIType t t ~ CN Integer, ModType t t ~ t)

instance CanDivIMod Integer Integer where
  type DivIType Integer Integer = Integer
  divIMod :: Integer
-> Integer -> (DivIType Integer Integer, ModType Integer Integer)
divIMod = forall a. Integral a => a -> a -> (a, a)
P.divMod

instance CanDivIMod Integer Int where
  type DivIType Integer Int = Integer
  divIMod :: Integer -> Int -> (DivIType Integer Int, ModType Integer Int)
divIMod Integer
x Int
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Integer
x (forall t. CanBeInteger t => t -> Integer
integer Int
m)

instance CanDivIMod Int Integer where
  type ModType Int Integer = Integer
  type DivIType Int Integer = Integer
  divIMod :: Int -> Integer -> (DivIType Int Integer, ModType Int Integer)
divIMod Int
x Integer
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod (forall t. CanBeInteger t => t -> Integer
integer Int
x) Integer
m

instance CanDivIMod Int Int where
  type ModType Int Int = Integer
  type DivIType Int Int = Integer
  divIMod :: Int -> Int -> (DivIType Int Int, ModType Int Int)
divIMod Int
x Int
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod (forall t. CanBeInteger t => t -> Integer
integer Int
x) (forall t. CanBeInteger t => t -> Integer
integer Int
m)

instance (CanDivIMod t1 t2, CanTestPosNeg t2) => CanDivIMod (CN t1) (CN t2) where
  type DivIType (CN t1) (CN t2) = (CN (DivIType t1 t2))
  type ModType (CN t1) (CN t2) = (CN (ModType t1 t2))
  divIMod :: CN t1
-> CN t2 -> (DivIType (CN t1) (CN t2), ModType (CN t1) (CN t2))
divIMod CN t1
x CN t2
m
    | forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive CN t2
m = (CollectErrors NumErrors (DivIType t1 t2)
d, CollectErrors NumErrors (ModType t1 t2)
xm)
    | forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative CN t2
m = (forall v. CN v -> CN v
noval CollectErrors NumErrors (DivIType t1 t2)
d, forall v. CN v -> CN v
noval CollectErrors NumErrors (ModType t1 t2)
xm)
    | Bool
otherwise = (forall v. CN v -> CN v
errPote CollectErrors NumErrors (DivIType t1 t2)
d, forall v. CN v -> CN v
errPote CollectErrors NumErrors (ModType t1 t2)
xm)
    where
    (CollectErrors NumErrors (DivIType t1 t2)
d,CollectErrors NumErrors (ModType t1 t2)
xm) = forall es a b c d.
Monoid es =>
(a -> b -> (c, d))
-> CollectErrors es a
-> CollectErrors es b
-> (CollectErrors es c, CollectErrors es d)
CN.lift2pair forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod CN t1
x CN t2
m

noval :: CN v -> CN v
noval :: forall v. CN v -> CN v
noval = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t. CN t -> NumError -> CN t
CN.removeValueErrorCertain NumError
err
errPote :: CN t -> CN t
errPote :: forall v. CN v -> CN v
errPote = forall t. NumError -> CN t -> CN t
CN.prependErrorPotential NumError
err
err :: CN.NumError
err :: NumError
err = String -> NumError
CN.OutOfDomain String
"divIMod: modulus not positive"

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

    instance (CanDivIMod t1 $t) => CanDivIMod (CN t1) $t where
      type DivIType (CN t1) $t = (CN (DivIType t1 $t))
      type ModType (CN t1) $t = (CN (ModType t1 $t))
      divIMod x m
        | isCertainlyPositive m = (d, xm)
        | isCertainlyNegative m = (noval d, noval xm)
        | otherwise = (errPote d, errPote xm)
        where
        (d,xm) = CN.lift1Tpair divIMod x m

    instance (CanDivIMod $t t2, CanTestPosNeg t2) => CanDivIMod $t (CN t2) where
      type DivIType $t (CN t2) = (CN (DivIType $t t2))
      type ModType $t (CN t2) = (CN (ModType $t t2))
      divIMod x m
        | isCertainlyPositive m = (d, xm)
        | isCertainlyNegative m = (noval d, noval xm)
        | otherwise = (errPote d, errPote xm)
        where
        (d,xm) = CN.liftT1pair divIMod x m
  |]))

instance CanDivIMod Rational Rational where
  type DivIType Rational Rational = Integer
  divIMod :: Rational
-> Rational
-> (DivIType Rational Rational, ModType Rational Rational)
divIMod = forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod'

instance CanDivIMod Rational Integer where
  type DivIType Rational Integer = Integer
  divIMod :: Rational
-> Integer -> (DivIType Rational Integer, ModType Rational Integer)
divIMod Rational
x Integer
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Rational
x (forall t. CanBeRational t => t -> Rational
rational Integer
m)

instance CanDivIMod Rational Int where
  type DivIType Rational Int = Integer
  divIMod :: Rational -> Int -> (DivIType Rational Int, ModType Rational Int)
divIMod Rational
x Int
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Rational
x (forall t. CanBeRational t => t -> Rational
rational Int
m)

instance CanDivIMod Integer Rational where
  type ModType Integer Rational = Rational
  type DivIType Integer Rational = Integer
  divIMod :: Integer
-> Rational
-> (DivIType Integer Rational, ModType Integer Rational)
divIMod Integer
x Rational
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod (forall t. CanBeRational t => t -> Rational
rational Integer
x) Rational
m

instance CanDivIMod Int Rational where
  type ModType Int Rational = Rational
  type DivIType Int Rational = Integer
  divIMod :: Int -> Rational -> (DivIType Int Rational, ModType Int Rational)
divIMod Int
x Rational
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod (forall t. CanBeRational t => t -> Rational
rational Int
x) Rational
m

instance CanDivIMod Double Double where
  type DivIType Double Double = Integer
  divIMod :: Double -> Double -> (DivIType Double Double, ModType Double Double)
divIMod = forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod'

instance CanDivIMod Double Integer where
  type DivIType Double Integer = Integer
  divIMod :: Double
-> Integer -> (DivIType Double Integer, ModType Double Integer)
divIMod Double
x Integer
m = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Double
x (forall t. CanBeDouble t => t -> Double
double Integer
m)

{-|
  HSpec properties that each implementation of CanRound should satisfy.
 -}
specCanDivIMod ::
  _ => T t -> Spec
specCanDivIMod :: T t -> Spec
specCanDivIMod (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanDivMod %s %s" String
typeName String
typeName) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds 0 <= x `mod` m < m" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t)  (t
m :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 forall prop. Testable prop => Bool -> prop -> Property
==>
          let xm :: ModType t t
xm = t
x forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> ModType t1 t2
`mod` t
m in
          (Integer
0 forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ ModType t t
xm) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (ModType t t
xm forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<?$ t
m)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds x == (x `div'` m)*m + (x `mod` m)" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t)  (t
m :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 forall prop. Testable prop => Bool -> prop -> Property
==>
          let (DivIType t t
d,ModType t t
xm) = forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t
x t
m in
          (t
x forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (DivIType t t
dforall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
m forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ ModType t t
xm))
  where
  (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<=?$ :: forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?<=?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?<=?" forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
  (?<?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<?$ :: forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?<?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?<?" forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<?)
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?==?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)

{----  rounding -----}

{-|
  A replacement for Prelude's `P.RealFrac` operations, such as round in
  which the result type is fixed to Integer.

  If @RealFrac t@ and @CanTestPosNeg t@,
  then one can use the default implementation to mirror Prelude's @round@, etc.

  In other cases, it is sufficient to define `properFraction`.
-}
class CanRound t where
  type RoundType t
  type RoundType t = Integer
  properFraction :: t -> (RoundType t, t)
  default properFraction :: (P.RealFrac t, RoundType t ~ Integer) => t -> (RoundType t, t)
  properFraction = forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction
  truncate :: t -> RoundType t
  truncate = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanRound t => t -> (RoundType t, t)
properFraction
  round :: t -> RoundType t
  default round :: (HasOrderCertainly t Rational, RoundType t ~ Integer) => t -> RoundType t
  round t
x
    | -Rational
0.5 forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
r forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
r forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.5 = RoundType t
n
    | t
r forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! -Rational
0.5 = RoundType t
n forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | t
r forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.5 = RoundType t
n forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | forall a. Integral a => a -> Bool
even RoundType t
n = RoundType t
n
    | t
r forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.0 = RoundType t
n forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | t
r forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.0 = RoundType t
n forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"round default defn: Bad value"
    where
    (RoundType t
n,t
r) = forall t. CanRound t => t -> (RoundType t, t)
properFraction t
x
  ceiling :: t -> RoundType t
  default ceiling :: (CanTestPosNeg t, RoundType t ~ Integer) => t -> RoundType t
  ceiling t
x
    | forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive t
r = RoundType t
n forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | Bool
otherwise = RoundType t
n
    where
    (RoundType t
n,t
r) = forall t. CanRound t => t -> (RoundType t, t)
properFraction t
x
  floor :: t -> RoundType t
  default floor :: (CanTestPosNeg t, RoundType t ~ Integer) => t -> RoundType t
  floor t
x
    | forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative t
r = RoundType t
n forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | Bool
otherwise = RoundType t
n
    where
    (RoundType t
n,t
r) = forall t. CanRound t => t -> (RoundType t, t)
properFraction t
x

instance CanRound Rational
instance CanRound Double where
  round :: Double -> RoundType Double
round = forall a b. (RealFrac a, Integral b) => a -> b
P.round
  ceiling :: Double -> RoundType Double
ceiling = forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
  floor :: Double -> RoundType Double
floor = forall a b. (RealFrac a, Integral b) => a -> b
P.floor

{-|
  HSpec properties that each implementation of CanRound should satisfy.
 -}
specCanRound ::
  _ => T t -> Spec
specCanRound :: T t -> Spec
specCanRound (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanRound %s" String
typeName) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds floor x <= x <= ceiling x" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall prop. Testable prop => Bool -> prop -> Property
==>
          (forall t. CanRound t => t -> RoundType t
floor t
x forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
x) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
x forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ forall t. CanRound t => t -> RoundType t
ceiling t
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds floor x <= round x <= ceiling x" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall prop. Testable prop => Bool -> prop -> Property
==>
          (forall t. CanRound t => t -> RoundType t
floor t
x forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!<=!$ forall t. CanRound t => t -> RoundType t
round t
x) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (forall t. CanRound t => t -> RoundType t
round t
x forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!<=!$ forall t. CanRound t => t -> RoundType t
ceiling t
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"0 <= ceiling x - floor x <= 1" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall prop. Testable prop => Bool -> prop -> Property
==>
          let diffCeilingFloorX :: SubType (RoundType t) (RoundType t)
diffCeilingFloorX = forall t. CanRound t => t -> RoundType t
ceiling t
x forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- forall t. CanRound t => t -> RoundType t
floor t
x in
          (Integer
0 forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? SubType (RoundType t) (RoundType t)
diffCeilingFloorX) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (SubType (RoundType t) (RoundType t)
diffCeilingFloorX forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? Integer
1)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds floor x = round x = ceiling x for integers" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Integer
xi :: Integer) ->
        let x :: t
x = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
xi :: t in
          (forall t. CanRound t => t -> RoundType t
floor t
x forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!==!$ forall t. CanRound t => t -> RoundType t
round t
x) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (forall t. CanRound t => t -> RoundType t
round t
x forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!==!$ forall t. CanRound t => t -> RoundType t
ceiling t
x)
  where
  (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<=?$ :: forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?<=?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?<=?" forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
  (!<=!$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  !<=!$ :: forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(!<=!$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"!<=!" forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(!<=!)
  (!==!$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  !==!$ :: forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(!==!$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"!==!" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(!==!)


class HasIntegerBounds t where
  integerBounds :: t -> (Integer, Integer)
  default integerBounds :: (CanRound t, RoundType t ~ Integer) => t -> (Integer, Integer)
  integerBounds t
x = (forall t. CanRound t => t -> RoundType t
floor t
x, forall t. CanRound t => t -> RoundType t
ceiling t
x)

instance HasIntegerBounds Rational
instance HasIntegerBounds Double
instance HasIntegerBounds Integer where
  integerBounds :: Integer -> (Integer, Integer)
integerBounds Integer
n = (Integer
n,Integer
n)
instance HasIntegerBounds Int where
  integerBounds :: Int -> (Integer, Integer)
integerBounds Int
n = (Integer
n',Integer
n') where n' :: Integer
n' = forall t. CanBeInteger t => t -> Integer
integer Int
n

{-|
  HSpec properties that each implementation of CanRound should satisfy.
 -}
specHasIntegerBounds ::
  _ => T t -> Spec
specHasIntegerBounds :: T t -> Spec
specHasIntegerBounds (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"HasIntegerBounds %s" String
typeName) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"holds l <= x <= r" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        forall t. CanTestFinite t => t -> Bool
isFinite t
x forall prop. Testable prop => Bool -> prop -> Property
==>
          let (Integer
l,Integer
r) = forall t. HasIntegerBounds t => t -> (Integer, Integer)
integerBounds t
x in
          (Integer
l forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
x) forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
x forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ Integer
r)
  where
  (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<=?$ :: forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?<=?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?<=?" forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)