diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,8 +1,9 @@ # mixed-types-num change log -* v 0.6.1 2024-09-21 +* v 0.6.2 2024-10-05 * Ring now requires HasIntegersWithSample instead of HasIntegers * Field now requires HasRationalsWithSample instead of HasRationals + * all test suites require HasIntegersWithSample instead of HasIntegers * v 0.5.12 2023-08-14 * compatible with ghc 9.6.2 * remove dependency on mtl diff --git a/mixed-types-num.cabal b/mixed-types-num.cabal --- a/mixed-types-num.cabal +++ b/mixed-types-num.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: mixed-types-num -version: 0.6.1 +version: 0.6.2 synopsis: Alternative Prelude with numeric and logic expressions typed bottom-up description: Please see the README on GitHub at category: Math @@ -13,7 +13,7 @@ bug-reports: https://github.com/michalkonecny/mixed-types-num/issues author: Michal Konecny maintainer: mikkonecny@gmail.com -copyright: 2015-2023 Michal Konecny +copyright: 2015-2024 Michal Konecny license: BSD3 license-file: LICENSE build-type: Simple diff --git a/src/Numeric/MixedTypes/AddSub.hs b/src/Numeric/MixedTypes/AddSub.hs --- a/src/Numeric/MixedTypes/AddSub.hs +++ b/src/Numeric/MixedTypes/AddSub.hs @@ -17,7 +17,7 @@ ( -- * Addition CanAdd, CanAddAsymmetric(..), CanAddThis, CanAddSameType - , (+), sum + , (+), sum, sumWithSample -- ** Tests , specCanAdd, specCanAddNotMixed, specCanAddSameType -- * Subtraction @@ -81,6 +81,9 @@ sum :: (CanAddSameType t, ConvertibleExactly Integer t) => [t] -> t sum xs = List.foldl' add (convertExactly 0) xs +sumWithSample :: (CanAddSameType t, ConvertibleExactlyWithSample Integer t) => t -> [t] -> t +sumWithSample sampleT xs = List.foldl' add (convertExactlyWithSample sampleT 0) xs + {-| HSpec properties that each implementation of CanAdd should satisfy. -} @@ -89,7 +92,8 @@ specCanAdd (T typeName1 :: T t1) (T typeName2 :: T t2) (T typeName3 :: T t3) = describe (printf "CanAdd %s %s, CanAdd %s %s" typeName1 typeName2 typeName2 typeName3) $ do it "absorbs 0" $ do - property $ \ (x :: t1) -> let z = (convertExactly 0 :: t1) in (x + z) ?==?$ x + property $ \ (x :: t1) (sampleT2 :: t2) -> + let z = (convertExactlyWithSample sampleT2 0 :: t2) in (x + z) ?==?$ x it "is commutative" $ do property $ \ (x :: t1) (y :: t2) -> (x + y) ?==?$ (y + x) it "is associative" $ do @@ -121,17 +125,20 @@ HSpec properties that each implementation of CanAddSameType should satisfy. -} specCanAddSameType :: - (ConvertibleExactly Integer t, Show t, - HasEqCertainly t t, CanAddSameType t) + (ConvertibleExactlyWithSample Integer t, Show t, + HasEqCertainly t t, CanAddSameType t, Arbitrary t) => T t -> Spec specCanAddSameType (T typeName :: T t) = describe (printf "CanAddSameType %s" typeName) $ do it "has sum working over integers" $ do - property $ \ (xsi :: [Integer]) -> - (sum $ (map convertExactly xsi :: [t])) ?==?$ (convertExactly (sum xsi) :: t) + property $ \ (xsi :: [Integer]) (sampleT :: t) -> + (sumWithSample sampleT $ (map (convertExactlyWithSample sampleT) xsi :: [t])) + ?==?$ + (convertExactlyWithSample sampleT (sum xsi) :: t) it "has sum [] = 0" $ do - (sum ([] :: [t])) ?==?$ (convertExactly 0 :: t) + property $ \ (sampleT :: t) -> + (sumWithSample sampleT ([] :: [t])) ?==?$ (convertExactlyWithSample sampleT 0 :: t) where (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property (?==?$) = printArgsIfFails2 "?==?" (?==?) @@ -240,9 +247,11 @@ specCanSub (T typeName1 :: T t1) (T typeName2 :: T t2) = describe (printf "CanSub %s %s" typeName1 typeName2) $ do it "x-0 = x" $ do - property $ \ (x :: t1) -> let z = (convertExactly 0 :: t1) in (x - z) ?==?$ x + property $ \ (x :: t1) (sampleT2 :: t2) -> + let z = (convertExactlyWithSample sampleT2 0 :: t2) in (x - z) ?==?$ x it "x-x = 0" $ do - property $ \ (x :: t1) -> let z = (convertExactly 0 :: t1) in (x - x) ?==?$ z + property $ \ (x :: t1) (sampleR :: SubType t1 t1) -> + let z = (convertExactlyWithSample sampleR 0 :: SubType t1 t1) in (x - x) ?==?$ z it "x-y = x+(-y)" $ do property $ \ (x :: t1) (y :: t2) -> (x - y) ?==?$ (x + (negate y)) diff --git a/src/Numeric/MixedTypes/Complex.hs b/src/Numeric/MixedTypes/Complex.hs --- a/src/Numeric/MixedTypes/Complex.hs +++ b/src/Numeric/MixedTypes/Complex.hs @@ -148,27 +148,27 @@ instance (HasEqAsymmetric $t b) => HasEqAsymmetric $t (Complex b) where type EqCompareType $t (Complex b) = EqCompareType $t b - equalTo n (a2 :+ i2) = (n == a2) && (convertExactlyTargetSample n 0 == i2) + equalTo n (a2 :+ i2) = (n == a2) && (convertExactlyWithSample n 0 == i2) instance (HasEqAsymmetric a $t) => HasEqAsymmetric (Complex a) $t where type EqCompareType (Complex a) $t = EqCompareType a $t - equalTo (a1 :+ i1) n = (a1 == n) && (i1 == convertExactlyTargetSample n 0) + equalTo (a1 :+ i1) n = (a1 == n) && (i1 == convertExactlyWithSample n 0) instance (CanAddAsymmetric $t b) => CanAddAsymmetric $t (Complex b) where type AddType $t (Complex b) = Complex (AddType $t b) - add n (a2 :+ i2) = (n + a2) :+ (convertExactlyTargetSample n 0 + i2) + add n (a2 :+ i2) = (n + a2) :+ (convertExactlyWithSample n 0 + i2) instance (CanAddAsymmetric a $t) => CanAddAsymmetric (Complex a) $t where type AddType (Complex a) $t = Complex (AddType a $t) - add (a1 :+ i1) n = (a1 + n) :+ (i1 + (convertExactlyTargetSample n 0)) + add (a1 :+ i1) n = (a1 + n) :+ (i1 + (convertExactlyWithSample n 0)) instance (CanSub $t b) => CanSub $t (Complex b) where type SubType $t (Complex b) = Complex (SubType $t b) - sub n (a2 :+ i2) = (n - a2) :+ (convertExactlyTargetSample n 0 - i2) + sub n (a2 :+ i2) = (n - a2) :+ (convertExactlyWithSample n 0 - i2) instance (CanSub a $t) => CanSub (Complex a) $t where type SubType (Complex a) $t = Complex (SubType a $t) - sub (a1 :+ i1) n = (a1 - n) :+ (i1 - (convertExactlyTargetSample n 0)) + sub (a1 :+ i1) n = (a1 - n) :+ (i1 - (convertExactlyWithSample n 0)) instance (CanMulAsymmetric $t b) => CanMulAsymmetric $t (Complex b) diff --git a/src/Numeric/MixedTypes/Div.hs b/src/Numeric/MixedTypes/Div.hs --- a/src/Numeric/MixedTypes/Div.hs +++ b/src/Numeric/MixedTypes/Div.hs @@ -102,15 +102,16 @@ (isCertainlyNonZero x && isCertainlyNonZero (recip x)) ==> recip (recip x) ?==?$ x it "x/1 = x" $ do - property $ \ (x :: t1) -> let one = (convertExactly 1 :: t2) in (x / one) ?==?$ x + property $ \ (x :: t1) (sampleT2 :: t2) -> + let one = (convertExactlyWithSample sampleT2 1 :: t2) in (x / one) ?==?$ x it "x/x = 1" $ do - property $ \ (x :: t1) -> + property $ \ (x :: t1) (sampleR :: DivType t1 t1) -> (isCertainlyNonZero x) ==> - let one = (convertExactly 1 :: t1) in (x / x) ?==?$ one + let one = (convertExactlyWithSample sampleR 1 :: DivType t1 t1) in (x / x) ?==?$ one it "x/y = x*(1/y)" $ do - property $ \ (x :: t1) (y :: t2) -> + property $ \ (x :: t1) (y :: t2) (sampleT1 :: t1) -> (isCertainlyNonZero y) ==> - let one = (convertExactly 1 :: t1) in (x / y) ?==?$ x * (one/y) + let one = (convertExactlyWithSample sampleT1 1 :: t1) in (x / y) ?==?$ x * (one/y) where infix 4 ?==?$ (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property diff --git a/src/Numeric/MixedTypes/Eq.hs b/src/Numeric/MixedTypes/Eq.hs --- a/src/Numeric/MixedTypes/Eq.hs +++ b/src/Numeric/MixedTypes/Eq.hs @@ -385,19 +385,20 @@ HSpec properties that each implementation of CanTestZero should satisfy. -} specCanTestZero :: - (CanTestZero t, ConvertibleExactly Integer t) + (CanTestZero t, ConvertibleExactlyWithSample Integer t, Arbitrary t, P.Show t) => T t -> Spec specCanTestZero (T typeName :: T t) = describe (printf "CanTestZero %s" typeName) $ do it "converted non-zero Integer is not isCertainlyZero" $ do - property $ \ (x :: Integer) -> - x /= 0 ==> (not $ isCertainlyZero (convertExactly x :: t)) + property $ \ (x :: Integer) (sampleT :: t) -> + x /= 0 ==> (not $ isCertainlyZero (convertExactlyWithSample sampleT x :: t)) it "converted non-zero Integer is isCertainlyNonZero" $ do - property $ \ (x :: Integer) -> - x /= 0 ==> (isCertainlyNonZero (convertExactly x :: t)) + property $ \ (x :: Integer) (sampleT :: t) -> + x /= 0 ==> (isCertainlyNonZero (convertExactlyWithSample sampleT x :: t)) it "converted 0.0 is not isCertainlyNonZero" $ do - (isCertainlyNonZero (convertExactly 0 :: t)) `shouldBe` False + property $ \ (sampleT :: t) -> + (isCertainlyNonZero (convertExactlyWithSample sampleT 0 :: t)) `shouldBe` False instance CanTestZero Int instance CanTestZero Integer @@ -434,7 +435,7 @@ HSpec properties that each implementation of CanPickNonZero should satisfy. -} specCanPickNonZero :: - (CanPickNonZero t, CanTestZero t, ConvertibleExactly Integer t, Show t, Arbitrary t) + (CanPickNonZero t, CanTestZero t, ConvertibleExactlyWithSample Integer t, Show t, Arbitrary t) => T t -> Spec specCanPickNonZero (T typeName :: T t) = @@ -447,9 +448,11 @@ Just (v, _) -> isCertainlyNonZero v _ -> False) it "returns Nothing when all the elements are 0" $ do - case pickNonZero [(convertExactly i :: t, ()) | i <- [0,0,0]] of - Nothing -> True - _ -> False + property $ \ (sampleT :: t) -> + let z = convertExactlyWithSample sampleT 0 :: t in + case pickNonZero [(z, ()), (z, ()), (z, ())] of + Nothing -> True + _ -> False instance CanPickNonZero Int instance CanPickNonZero Integer diff --git a/src/Numeric/MixedTypes/Literals.hs b/src/Numeric/MixedTypes/Literals.hs --- a/src/Numeric/MixedTypes/Literals.hs +++ b/src/Numeric/MixedTypes/Literals.hs @@ -45,7 +45,7 @@ , CanBeInt, int, ints , CanBeRational, rational, rationals, HasRationals, fromRational_, HasRationalsWithSample, fromRationalWithSample , CanBeDouble, double, doubles - , ConvertibleExactly(..), convertExactly, convertExactlyTargetSample + , ConvertibleExactly(..), convertExactly, convertExactlyWithSample , ConvertResult, ConvertError, convError -- * Prelude List operations versions without Int , (!!), length, replicate, take, drop, splitAt @@ -56,7 +56,7 @@ , printArgsIfFails2 -- * Helper functions , convertFirst, convertSecond - , convertFirstUsing, convertSecondUsing + , convertFirstUsing, convertSecondUsing, ConvertibleExactlyWithSample ) where @@ -136,9 +136,9 @@ data WithSample s t = WithSample s t -type HasIntegersWithSample t = ConvertibleExactly (WithSample t Integer) t +type HasIntegersWithSample t = ConvertibleExactlyWithSample Integer t fromIntegerWithSample :: (HasIntegersWithSample t) => t -> Integer -> t -fromIntegerWithSample sampleT n = convertExactly (WithSample sampleT n) +fromIntegerWithSample sampleT n = convertExactlyWithSample sampleT n (!!) :: (CanBeInteger n) => [a] -> n -> a list !! ix = List.genericIndex list (integer ix) @@ -197,9 +197,9 @@ fromRational_ :: (HasRationals t) => Rational -> t fromRational_ = convertExactly -type HasRationalsWithSample t = ConvertibleExactly (WithSample t Rational) t +type HasRationalsWithSample t = ConvertibleExactlyWithSample Rational t fromRationalWithSample :: (HasRationalsWithSample t) => t -> Rational -> t -fromRationalWithSample sampleT q = convertExactly (WithSample sampleT q) +fromRationalWithSample sampleT q = convertExactlyWithSample sampleT q type CanBeDouble t = Convertible t Double double :: (CanBeDouble t) => t -> Double @@ -217,15 +217,18 @@ default safeConvertExactly :: (Convertible t1 t2) => t1 -> ConvertResult t2 safeConvertExactly = safeConvert +type ConvertibleExactlyWithSample t1 t2 = ConvertibleExactly (WithSample t2 t1) t2 + convertExactly :: (ConvertibleExactly t1 t2) => t1 -> t2 convertExactly a = case safeConvertExactly a of Right v -> v Left err -> error (show err) -convertExactlyTargetSample :: (ConvertibleExactly t1 t2) => t2 -> t1 -> t2 -convertExactlyTargetSample _sample = convertExactly +convertExactlyWithSample :: ConvertibleExactlyWithSample t1 t2 => t2 -> t1 -> t2 +convertExactlyWithSample sampleT a = convertExactly (WithSample sampleT a) + -- HasIntegers Integer, CanBeInteger Integer instance ConvertibleExactly Integer Integer -- use CVT instance by default -- CanBeInteger Int @@ -235,6 +238,14 @@ instance ConvertibleExactly (WithSample Integer Integer) Integer where safeConvertExactly (WithSample _ value) = safeConvert value +-- HasIntsWithSample Integer +instance ConvertibleExactly (WithSample Int Integer) Int where + safeConvertExactly (WithSample _ value) = safeConvert value + +-- CanBeIntegerWithSample Int +instance ConvertibleExactly (WithSample Integer Int) Integer where + safeConvertExactly (WithSample _ value) = safeConvert value + -- CanBeInt Int instance ConvertibleExactly Int Int where safeConvertExactly n = Right n @@ -266,6 +277,10 @@ (m, fr) | m P.== n P.&& fr P.== (double 0) -> return d _ -> convError "Integer could not be exactly converted to Double" n +-- HasIntegersWithSample Double +instance ConvertibleExactly (WithSample Double Integer) Double where + safeConvertExactly (WithSample _ value) = safeConvertExactly value + instance ConvertibleExactly Int Double where safeConvertExactly n = do @@ -274,6 +289,10 @@ (m, fr) | m P.== n P.&& fr P.== (double 0) -> return d _ -> convError "Int could not be exactly converted to Double" n +-- HasIntsWithSample Double +instance ConvertibleExactly (WithSample Double Int) Double where + safeConvertExactly (WithSample _ value) = safeConvertExactly value + instance ConvertibleExactly Double Double where safeConvertExactly d = Right d @@ -342,14 +361,6 @@ (a -> a -> c) {-^ same-type operation -} -> (a -> b -> c) {-^ mixed-type operation -} convertSecond = convertSecondUsing (\ _ b -> convertExactly b) - --- instance --- (ConvertibleExactly t1 t2, CanBeErrors es) --- => --- ConvertibleExactly t1 (CollectErrors es t2) --- where --- safeConvertExactly = fmap pure . safeConvertExactly --- instance (HasIntegers t, Monoid es) => -- HasIntegersWithSample (CollectErrors es t) diff --git a/src/Numeric/MixedTypes/MinMaxAbs.hs b/src/Numeric/MixedTypes/MinMaxAbs.hs --- a/src/Numeric/MixedTypes/MinMaxAbs.hs +++ b/src/Numeric/MixedTypes/MinMaxAbs.hs @@ -255,7 +255,8 @@ (x ?==? x) ==> -- avoid NaN (negate (negate x)) ?==?$ x it "takes 0 to 0" $ do - let z = convertExactly 0 :: t in negate z ?==? z + property $ \ (sampleT :: t) -> + let z = convertExactlyWithSample sampleT 0 :: t in negate z ?==? z it "takes positive to negative" $ do property $ \ (x :: t) -> (isFinite x) ==> -- avoid NaN diff --git a/src/Numeric/MixedTypes/Mul.hs b/src/Numeric/MixedTypes/Mul.hs --- a/src/Numeric/MixedTypes/Mul.hs +++ b/src/Numeric/MixedTypes/Mul.hs @@ -17,7 +17,7 @@ ( -- ** Multiplication CanMul, CanMulAsymmetric(..), CanMulBy, CanMulSameType - , (*), product + , (*), product, productWithSample -- ** Tests , specCanMul, specCanMulNotMixed, specCanMulSameType ) @@ -74,6 +74,9 @@ product :: (CanMulSameType t, ConvertibleExactly Integer t) => [t] -> t product xs = List.foldl' mul (convertExactly 1) xs +productWithSample :: (CanMulSameType t, ConvertibleExactlyWithSample Integer t) => t -> [t] -> t +productWithSample sampleT xs = List.foldl' mul (convertExactlyWithSample sampleT 1) xs + {-| HSpec properties that each implementation of CanMul should satisfy. -} @@ -82,7 +85,8 @@ specCanMul (T typeName1 :: T t1) (T typeName2 :: T t2) (T typeName3 :: T t3) = describe (printf "CanMul %s %s, CanMul %s %s" typeName1 typeName2 typeName2 typeName3) $ do it "absorbs 1" $ do - property $ \ (x :: t1) -> let one = (convertExactly 1 :: t2) in (x * one) ?==?$ x + property $ \ (x :: t1) (sampleT2 :: t2) -> + let one = (convertExactlyWithSample sampleT2 1 :: t2) in (x * one) ?==?$ x it "is commutative" $ do property $ \ (x :: t1) (y :: t2) -> (x * y) ?==?$ (y * x) it "is associative" $ do @@ -107,7 +111,7 @@ HSpec properties that each implementation of CanMulSameType should satisfy. -} specCanMulSameType :: - (Show t, ConvertibleExactly Integer t, + (Show t, Arbitrary t, ConvertibleExactlyWithSample Integer t, CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t, CanMulAsymmetric t t, MulType t t ~ t) => @@ -115,10 +119,13 @@ specCanMulSameType (T typeName :: T t) = describe (printf "CanMulSameType %s" typeName) $ do it "has product working over integers" $ do - property $ \ (xsi :: [Integer]) -> - (product $ (map convertExactly xsi :: [t])) ?==?$ (convertExactly (product xsi) :: t) + property $ \ (xsi :: [Integer]) (sampleT :: t) -> + (productWithSample sampleT $ (map (convertExactlyWithSample sampleT) xsi :: [t])) + ?==?$ + (convertExactlyWithSample sampleT (product xsi) :: t) it "has product [] = 1" $ do - (product ([] :: [t])) ?==?$ (convertExactly 1 :: t) + property $ \ (sampleT :: t) -> + (productWithSample sampleT ([] :: [t])) ?==?$ (convertExactlyWithSample sampleT 1 :: t) where infix 4 ?==?$ (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property diff --git a/src/Numeric/MixedTypes/Power.hs b/src/Numeric/MixedTypes/Power.hs --- a/src/Numeric/MixedTypes/Power.hs +++ b/src/Numeric/MixedTypes/Power.hs @@ -177,13 +177,13 @@ specCanPow (T typeName1 :: T t1) (T typeName2 :: T t2) = describe (printf "CanPow %s %s" typeName1 typeName2) $ do it "x^0 = 1" $ do - property $ \ (x :: t1) -> - let one = (convertExactly 1 :: t1) in - let z = (convertExactly 0 :: t2) in + property $ \ (x :: t1) (sampleT1 :: t1) (sampleT2 :: t2) -> + let one = (convertExactlyWithSample sampleT1 1 :: t1) in + let z = (convertExactlyWithSample sampleT2 0 :: t2) in (x ^ z) ?==?$ one it "x^1 = x" $ do - property $ \ (x :: t1) -> - let one = (convertExactly 1 :: t2) in + property $ \ (x :: t1) (sampleT2 :: t2) -> + let one = (convertExactlyWithSample sampleT2 1 :: t2) in (x ^ one) ?==?$ x it "x^(y+1) = x*x^y" $ do property $ \ (x :: t1) (y :: t2) -> diff --git a/src/Numeric/MixedTypes/Round.hs b/src/Numeric/MixedTypes/Round.hs --- a/src/Numeric/MixedTypes/Round.hs +++ b/src/Numeric/MixedTypes/Round.hs @@ -255,8 +255,8 @@ let diffCeilingFloorX = ceiling x - floor x in (0 ?<=? diffCeilingFloorX) .&&. (diffCeilingFloorX ?<=? 1) it "holds floor x = round x = ceiling x for integers" $ do - property $ \ (xi :: Integer) -> - let x = convertExactly xi :: t in + property $ \ (xi :: Integer) (sampleT :: t) -> + let x = convertExactlyWithSample sampleT xi :: t in (floor x !==!$ round x) .&&. (round x !==!$ ceiling x) where (?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property diff --git a/src/Utils/Test/EnforceRange.hs b/src/Utils/Test/EnforceRange.hs --- a/src/Utils/Test/EnforceRange.hs +++ b/src/Utils/Test/EnforceRange.hs @@ -33,7 +33,7 @@ (CanAddSubMulDivBy t Integer , CanAddSameType t, CanSubSameType t, CanAbsSameType t , CanDivIModIntegerSameType t - , ConvertibleExactly b t + , ConvertibleExactlyWithSample b t , HasOrderCertainly t t) {-| @@ -50,17 +50,17 @@ | l !