{-|
    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, modNoCN, divINoCN, divIModNoCN
  -- * Rounding
  , CanRound(..), HasIntegerBounds(..)
  -- ** Tests
  , specCanDivIMod, specCanRound, specHasIntegerBounds
)
where

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
-- import Control.CollectErrors

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.Ring

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

class CanDivIMod t1 t2 where
  type DivIType t1 t2
  type DivIType t1 t2 = CN Integer
  type ModType t1 t2
  type ModType t1 t2 = EnsureCN t1
  divIMod :: t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
  mod :: t1 -> t2 -> ModType t1 t2
  mod t1
a t2
b = (DivIType t1 t2, ModType t1 t2) -> ModType t1 t2
forall a b. (a, b) -> b
snd ((DivIType t1 t2, ModType t1 t2) -> ModType t1 t2)
-> (DivIType t1 t2, ModType t1 t2) -> ModType t1 t2
forall a b. (a -> b) -> a -> b
$ t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
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 = (DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2
forall a b. (a, b) -> a
fst ((DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2)
-> (DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2
forall a b. (a -> b) -> a -> b
$ t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
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, CanEnsureCN t, DivIType t t ~ CN Integer, ModType t t ~ EnsureCN t)

modNoCN :: 
  (CanDivIMod t1 t2
  , ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1)
  => 
  t1 -> t2 -> t1
modNoCN :: t1 -> t2 -> t1
modNoCN t1
x t2
m = 
  case EnsureCN t1 -> Either NumErrors t1
forall v. CanEnsureCN v => EnsureCN v -> Either NumErrors v
deEnsureCN (EnsureCN t1 -> Either NumErrors t1)
-> EnsureCN t1 -> Either NumErrors t1
forall a b. (a -> b) -> a -> b
$ t1
x t1 -> t2 -> ModType t1 t2
forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> ModType t1 t2
`mod` t2
m of
    Left NumErrors
err -> [Char] -> t1
forall a. HasCallStack => [Char] -> a
error ([Char] -> t1) -> [Char] -> t1
forall a b. (a -> b) -> a -> b
$ NumErrors -> [Char]
forall a. Show a => a -> [Char]
show NumErrors
err
    Right t1
xm -> t1
xm

divINoCN :: 
  (CanDivIMod t1 t2, DivIType t1 t2 ~ CN Integer)
  => 
  t1 -> t2 -> Integer
divINoCN :: t1 -> t2 -> Integer
divINoCN t1
x t2
m = CN Integer -> EnsureNoCN (CN Integer)
forall v. (CanEnsureCN v, Show v) => v -> EnsureNoCN v
(~!) (CN Integer -> EnsureNoCN (CN Integer))
-> CN Integer -> EnsureNoCN (CN Integer)
forall a b. (a -> b) -> a -> b
$ t1
x t1 -> t2 -> DivIType t1 t2
forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> DivIType t1 t2
`divI` t2
m

divIModNoCN :: 
  (CanDivIMod t1 t2
  , ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1
  , DivIType t1 t2 ~ CN Integer)
  => 
  t1 -> t2 -> (Integer, t1)
divIModNoCN :: t1 -> t2 -> (Integer, t1)
divIModNoCN t1
x t2
m = 
  case EnsureCN t1 -> Either NumErrors t1
forall v. CanEnsureCN v => EnsureCN v -> Either NumErrors v
deEnsureCN EnsureCN t1
xm of
    Left NumErrors
err -> [Char] -> (Integer, t1)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Integer, t1)) -> [Char] -> (Integer, t1)
forall a b. (a -> b) -> a -> b
$ NumErrors -> [Char]
forall a. Show a => a -> [Char]
show NumErrors
err
    Right t1
xm2 -> (CN Integer -> EnsureNoCN (CN Integer)
forall v. (CanEnsureCN v, Show v) => v -> EnsureNoCN v
(~!) CN Integer
d, t1
xm2)
  where
  (CN Integer
d,EnsureCN t1
xm) = t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
x t2
m

instance CanDivIMod Integer Integer where
  divIMod :: Integer
-> Integer -> (DivIType Integer Integer, ModType Integer Integer)
divIMod Integer
x Integer
m 
    | Integer
m Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
xm)
    | Bool
otherwise = (EnsureCN Integer
DivIType Integer Integer
err, EnsureCN Integer
ModType Integer Integer
err)
    where
    (Integer
d,Integer
xm) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
P.divMod Integer
x Integer
m
    err :: EnsureCN Integer
err = Maybe Integer -> NumError -> EnsureCN Integer
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe Integer
sample_v (NumError -> EnsureCN Integer) -> NumError -> EnsureCN Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
m
    sample_v :: Maybe Integer
sample_v = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x

instance CanDivIMod Rational Rational where
  divIMod :: Rational
-> Rational
-> (DivIType Rational Rational, ModType Rational Rational)
divIMod Rational
x Rational
m 
    | Rational
m Rational -> Integer -> OrderCompareType Rational Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Rational -> EnsureCN Rational
forall v. CanEnsureCN v => v -> EnsureCN v
cn Rational
xm)
    | Bool
otherwise = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
err (Integer
d :: Integer), Rational -> EnsureCN Rational
forall v. CanEnsureCN v => v -> EnsureCN v
err Rational
xm)
    where
    (Integer
d,Rational
xm) = Rational -> Rational -> (Integer, Rational)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Rational
x Rational
m
    err :: (CanEnsureCN t) => t -> EnsureCN t
    err :: t -> EnsureCN t
err t
s = Maybe t -> NumError -> EnsureCN t
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN (t -> Maybe t
forall a. a -> Maybe a
Just t
s) (NumError -> EnsureCN t) -> NumError -> EnsureCN t
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
m

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

instance CanDivIMod Double Double where
  divIMod :: Double -> Double -> (DivIType Double Double, ModType Double Double)
divIMod Double
x Double
m 
    | Double
m Double -> Integer -> OrderCompareType Double Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Double -> EnsureCN Double
forall v. CanEnsureCN v => v -> EnsureCN v
cn Double
xm)
    | Bool
otherwise = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
err (Integer
d :: Integer), Double -> EnsureCN Double
forall v. CanEnsureCN v => v -> EnsureCN v
err Double
xm)
    where
    (Integer
d,Double
xm) = Double -> Double -> (Integer, Double)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Double
x Double
m
    err :: (CanEnsureCN t) => t -> EnsureCN t
    err :: t -> EnsureCN t
err t
s = Maybe t -> NumError -> EnsureCN t
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN (t -> Maybe t
forall a. a -> Maybe a
Just t
s) (NumError -> EnsureCN t) -> NumError -> EnsureCN t
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
m

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

type CanDivIModX t =
  (CanDivIMod t t,
   ModType t t ~ EnsureCN t,
   DivIType t t ~ CN Integer,
   EnsureNoCN t ~ t,
   CanEnsureCN t,
   CanMulBy t Integer,
   CanAddSameType t,
   HasOrderCertainly t Integer,
   HasOrderCertainly t t,
   HasEqCertainly t t,
   CanTestFinite t,
   Show t, Arbitrary t)

{-|
  HSpec properties that each implementation of CanRound should satisfy.
 -}
specCanDivIMod ::
  (CanDivIModX t, HasIntegers t)
  =>
  T t -> Spec
specCanDivIMod :: T t -> Spec
specCanDivIMod (T [Char]
typeName :: T t) =
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanDivMod %s %s" [Char]
typeName [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds 0 <= x `mod` m < m" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t)  (t
m :: t) ->
        t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          let xm :: t
xm = t
x t -> t -> t
forall t1 t2.
(CanDivIMod t1 t2, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1) =>
t1 -> t2 -> t1
`modNoCN` t
m in
          (Integer
0 Integer -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
xm) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
xm t -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<?$ t
m)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds x == (x `div'` m)*m + (x `mod` m)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t)  (t
m :: t) ->
        t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          let (Integer
d,t
xm) = t -> t -> (Integer, t)
forall t1 t2.
(CanDivIMod t1 t2, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1,
 DivIType t1 t2 ~ CN Integer) =>
t1 -> t2 -> (Integer, t1)
divIModNoCN t
x t
m in
          (t
x t -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (Integer
dInteger -> t -> MulType Integer t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
m t -> t -> AddType t t
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t
xm))
  where
  (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<=?$ :: a -> b -> Property
(?<=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
  (?<?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?<?$ :: a -> b -> Property
(?<?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<?)
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" a -> b -> Bool
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
  properFraction :: t -> (Integer, t)
  default properFraction :: (P.RealFrac t) => t -> (Integer, t)
  properFraction = t -> (Integer, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction
  truncate :: t -> Integer
  truncate = (Integer, t) -> Integer
forall a b. (a, b) -> a
fst ((Integer, t) -> Integer) -> (t -> (Integer, t)) -> t -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction
  round :: t -> Integer
  default round :: (HasOrderCertainly t Rational) => t -> Integer
  round t
x
    | -Rational
0.5 Rational -> t -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
r Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.5 = Integer
n
    | t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! -Rational
0.5 = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.5 = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = Integer
n
    | t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.0 = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.0 = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | Bool
otherwise = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"round default defn: Bad value"
    where
    (Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x
  ceiling :: t -> Integer
  default ceiling :: (CanTestPosNeg t) => t -> Integer
  ceiling t
x
    | t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive t
r = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
    | Bool
otherwise = Integer
n
    where
    (Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x
  floor :: t -> Integer
  default floor :: (CanTestPosNeg t) => t -> Integer
  floor t
x
    | t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative t
r = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
    | Bool
otherwise = Integer
n
    where
    (Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x

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

type CanRoundX t =
  (CanRound t,
   CanNegSameType t,
   CanTestPosNeg t,
   HasOrderCertainly t Integer,
   CanTestFinite t,
   Show t, Arbitrary t)

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


class HasIntegerBounds t where
  integerBounds :: t -> (Integer, Integer)
  default integerBounds :: (CanRound t) => t -> (Integer, Integer)
  integerBounds t
x = (t -> Integer
forall t. CanRound t => t -> Integer
floor t
x, t -> Integer
forall t. CanRound t => t -> Integer
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' = Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
n

type HasIntegerBoundsX t =
  (HasIntegerBounds t,
  --  CanNegSameType t,
  --  CanTestPosNeg t,
   HasOrderCertainly t Integer,
   CanTestFinite t,
   Show t, Arbitrary t)


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