{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | testing IEEE numbers is a special kind of hell, and one that I reserve for days when I can hardly think, so please forgive the horrible hackery contained within this file. -- -- This suite sometimes fails, having been hand-crafty towards balancing reasonably approximate equality versus unbounded failure (given enough trials). module Main where import NumHask.Prelude import NumHask.Laws import Test.Tasty (TestTree, defaultMain, testGroup) import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen instance Arbitrary Natural where arbitrary = fromInteger . abs <$> arbitrary instance Arbitrary Rational where arbitrary = reduce <$> (fromInteger <$> arbitrary) <*> (fromInteger <$> arbitrary `suchThat` (>zero)) instance (Signed a, Arbitrary a, ExpField a) => Arbitrary (LogField a) where arbitrary = logField . abs <$> arbitrary main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "NumHask" [ testsInt , testsInt8 , testsInt16 , testsInt32 , testsInt64 , testsWord , testsWord8 , testsWord16 , testsWord32 , testsWord64 , testsNatural , testsFloat , testsDouble , testsBool , testsComplexFloat , testsRational , testsLogFieldDouble ] testsInt :: TestTree testsInt = testGroup "Int" [ testGroup "Additive" $ testLawOf ([] :: [Int]) <$> additiveLaws , testGroup "Additive Group" $ testLawOf ([] :: [Int]) <$> additiveGroupLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Int]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Int]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Int]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Int]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Int, Int)]) <$> metricIntegralLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int, Int)]) <$> normedBoundedLaws ] testsInteger :: TestTree testsInteger = testGroup "Integer" [ testGroup "Integrals" $ testLawOf ([] :: [Integer]) <$> integralsLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Integer, Integer)]) <$> metricIntegralLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Integer, Integer)]) <$> normedLaws ] testsInt8 :: TestTree testsInt8 = testGroup "Int8" [ testGroup "Integrals" $ testLawOf ([] :: [Int8]) <$> integralsLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Int8, Int8)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int8, Int8)]) <$> normedBoundedLaws ] testsInt16 :: TestTree testsInt16 = testGroup "Int16" [ testGroup "Integrals" $ testLawOf ([] :: [Int16]) <$> integralsLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Int16, Int16)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int16, Int16)]) <$> normedBoundedLaws ] testsInt32 :: TestTree testsInt32 = testGroup "Int32" [ testGroup "Integrals" $ testLawOf ([] :: [Int32]) <$> integralsLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Int32, Int32)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int32, Int32)]) <$> normedBoundedLaws ] testsInt64 :: TestTree testsInt64 = testGroup "Int64" [ testGroup "Integrals" $ testLawOf ([] :: [Int64]) <$> integralsLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Int64, Int64)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int64, Int64)]) <$> normedBoundedLaws ] testsWord :: TestTree testsWord = testGroup "Word" [ testGroup "Additive" $ testLawOf ([] :: [Word]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Word]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Word]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Word]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Word]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Word, Word)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word, Word)]) <$> normedBoundedLaws ] testsWord8 :: TestTree testsWord8 = testGroup "Word8" [ testGroup "Additive" $ testLawOf ([] :: [Word8]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Word8]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Word8]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Word8]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Word8]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Word8, Word8)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word8, Word8)]) <$> normedBoundedLaws ] testsWord16 :: TestTree testsWord16 = testGroup "Word16" [ testGroup "Additive" $ testLawOf ([] :: [Word16]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Word16]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Word16]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Word16]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Word16]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Word16, Word16)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word16, Word16)]) <$> normedBoundedLaws ] testsWord32 :: TestTree testsWord32 = testGroup "Word32" [ testGroup "Additive" $ testLawOf ([] :: [Word32]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Word32]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Word32]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Word32]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Word32]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Word32, Word32)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word32, Word32)]) <$> normedBoundedLaws ] testsWord64 :: TestTree testsWord64 = testGroup "Word64" [ testGroup "Additive" $ testLawOf ([] :: [Word64]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Word64]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Word64]) <$> distributionLaws , testGroup "Integral" $ testLawOf ([] :: [Word64]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Word64]) <$> signedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Word64, Word64)]) <$> metricIntegralBoundedLaws , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Word64, Word64)]) <$> normedBoundedLaws ] testsNatural :: TestTree testsNatural = testGroup "Natural" [ testGroup "Additive" $ testLawOf ([] :: [Natural]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Natural]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Natural]) <$> distributionLaws , testGroup "Naturalegral" $ testLawOf ([] :: [Natural]) <$> integralLaws , testGroup "Signed" $ testLawOf ([] :: [Natural]) <$> signedLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Natural, Natural)]) <$> normedLaws ] testsFloat :: TestTree testsFloat = testGroup "Float" [ testGroup "Additive - Associative Fail" $ testLawOf ([] :: [Float]) <$> additiveLawsFail , testGroup "Additive Group" $ testLawOf ([] :: [Float]) <$> additiveGroupLaws , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [Float]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $ testLawOf ([] :: [Float]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [Float]) <$> distributionLawsFail , testGroup "Signed" $ testLawOf ([] :: [Float]) <$> signedLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Float, Float)]) <$> normedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Float, Float)]) <$> metricRationalLaws , testGroup "Upper Bounded Field" $ testLawOf ([] :: [Float]) <$> upperBoundedFieldLaws , testGroup "Lower Bounded Field" $ testLawOf ([] :: [Float]) <$> lowerBoundedFieldLaws , testGroup "Quotient Field" $ testLawOf2 ([] :: [(Float,Integer)]) <$> quotientFieldLaws , testGroup "Exponential Field" $ testLawOf2 ([] :: [(Float,Float)]) <$> expFieldLaws , testGroup "Rational" $ testLawOf ([] :: [Float]) <$> rationalLaws ] testsDouble :: TestTree testsDouble = testGroup "Double" [ testGroup "Additive - Associative Fail" $ testLawOf ([] :: [Double]) <$> additiveLawsFail , testGroup "Additive Group" $ testLawOf ([] :: [Double]) <$> additiveGroupLaws , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [Double]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $ testLawOf ([] :: [Double]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [Double]) <$> distributionLawsFail , testGroup "Signed" $ testLawOf ([] :: [Double]) <$> signedLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Double, Double)]) <$> normedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Double, Double)]) <$> metricRationalLaws , testGroup "Upper Bounded Field" $ testLawOf ([] :: [Double]) <$> upperBoundedFieldLaws , testGroup "Lower Bounded Field" $ testLawOf ([] :: [Double]) <$> lowerBoundedFieldLaws , testGroup "Quotient Field" $ testLawOf2 ([] :: [(Double,Integer)]) <$> quotientFieldLaws , testGroup "Exponential Field" $ testLawOf2 ([] :: [(Double,Double)]) <$> expFieldLaws , testGroup "Rational" $ testLawOf ([] :: [Double]) <$> rationalLaws ] testsBool :: TestTree testsBool = testGroup "Bool" [ testGroup "Idempotent" $ testLawOf ([] :: [Bool]) <$> idempotentLaws , testGroup "Additive" $ testLawOf ([] :: [Bool]) <$> additiveLaws , testGroup "Multiplicative" $ testLawOf ([] :: [Bool]) <$> multiplicativeLaws , testGroup "Distribution" $ testLawOf ([] :: [Bool]) <$> distributionLaws ] testsComplexFloat :: TestTree testsComplexFloat = testGroup "Complex Float" [ testGroup "Additive - Associative Fail" $ testLawOf ([] :: [Complex Float]) <$> additiveLawsFail , testGroup "Additive Group" $ testLawOf ([] :: [Complex Float]) <$> additiveGroupLaws , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [Complex Float]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $ testLawOf ([] :: [Complex Float]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [Complex Float]) <$> distributionLawsFail -- , testGroup "Exponential Field" $ -- testLawOf2 ([] :: [(Complex Float, Float)]) <$> expFieldLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Complex Float, Float)]) <$> normedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Complex Float, Float)]) <$> metricRationalLaws , testGroup "Involutive Ring" $ testLawOf ([] :: [Complex Float]) <$> involutiveRingLaws ] testsRational :: TestTree testsRational = testGroup "Rational" [ testGroup "Additive - Associative" $ testLawOf ([] :: [Rational]) <$> additiveLaws , testGroup "Additive Group" $ testLawOf ([] :: [Rational]) <$> additiveGroupLaws , testGroup "Multiplicative - Associative" $ testLawOf ([] :: [Rational]) <$> multiplicativeLaws , testGroup "MultiplicativeGroup" $ testLawOf ([] :: [Rational]) <$> multiplicativeGroupLaws_ , testGroup "Distribution" $ testLawOf ([] :: [Rational]) <$> distributionLaws , testGroup "Signed" $ testLawOf ([] :: [Rational]) <$> signedLaws , testGroup "Normed" $ testLawOf2 ([] :: [(Rational, Rational)]) <$> normedLaws , testGroup "Metric" $ testLawOf2 ([] :: [(Rational, Rational)]) <$> metricRationalLaws , testGroup "Rational" $ testLawOf ([] :: [Rational]) <$> rationalLaws -- fixme: rounding and infinities need work , testGroup "Quotient Field" $ testLawOf2 ([] :: [(Rational, Integer)]) <$> quotientFieldLaws , testGroup "Upper Bounded Field" $ testLawOf ([] :: [Rational]) <$> upperBoundedFieldLaws , testGroup "Lower Bounded Field" $ testLawOf ([] :: [Rational]) <$> lowerBoundedFieldLaws ] -- testGroup "Distribution" $ testLawOf ([] :: [Int]) <$> distributionLaws -- , testGroup "Metric" $ testLawOf2 ([] :: [(Int, Int)]) <$> -- metricIntegralLaws -- , testGroup "Normed or maxBound" $ testLawOf2 ([] :: [(Int, Int)]) <$> normedBoundedLaws testsLogFieldDouble :: TestTree testsLogFieldDouble = testGroup "LogField Double" [ testGroup "Additive - Associative Fail" $ testLawOf ([] :: [LogField Double]) <$> additiveLawsFail , testGroup "Multiplicative - Associative Fail" $ testLawOf ([] :: [LogField Double]) <$> multiplicativeLawsFail , testGroup "MultiplicativeGroup" $ testLawOf ([] :: [LogField Double]) <$> multiplicativeGroupLaws_ , testGroup "Distribution - Fail" $ testLawOf ([] :: [LogField Double]) <$> distributionLawsFail ]