{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} module Main where import Foundation import Foundation.Array import Foundation.Foreign import Foundation.List.DList import Foundation.Primitive import Foundation.Check import Foundation.Check.Main (defaultMain) import Foundation.String import Foundation.String.Read import qualified Prelude import Data.Ratio import Test.Foundation.Random import Test.Checks.Property.Collection applyFstToSnd :: (String, String -> b) -> b applyFstToSnd (a, fab) = fab a matrixToGroup name l = Group name $ Prelude.concat $ fmap (fmap applyFstToSnd . snd) l functorProxy :: Proxy f -> Proxy ty -> Proxy (f ty) functorProxy _ _ = Proxy primTypesMatrixArbitrary :: (forall ty . (PrimType ty, Typeable ty, Show ty, Ord ty) => Proxy ty -> Gen ty -> a) -> [(String, [(String, a)])] primTypesMatrixArbitrary f = [ ("Words", [ ("W8", f (Proxy :: Proxy Word8) arbitrary) , ("W16", f (Proxy :: Proxy Word16) arbitrary) , ("W32", f (Proxy :: Proxy Word32) arbitrary) , ("W64", f (Proxy :: Proxy Word64) arbitrary) , ("Word", f (Proxy :: Proxy Word) arbitrary) ]) , ("Ints", [ ("I8", f (Proxy :: Proxy Int8) arbitrary) , ("I16", f (Proxy :: Proxy Int16) arbitrary) , ("I32", f (Proxy :: Proxy Int32) arbitrary) , ("I64", f (Proxy :: Proxy Int64) arbitrary) , ("Int", f (Proxy :: Proxy Int) arbitrary) ]) , ("Floating", [ ("FP32", f (Proxy :: Proxy Float) arbitrary) , ("FP64", f (Proxy :: Proxy Double) arbitrary) ]) , ("C-Types", [ ("CChar", f (Proxy :: Proxy CChar) (CChar <$> arbitrary)) , ("CUChar", f (Proxy :: Proxy CUChar) (CUChar <$> arbitrary)) ]) , ("Endian", [ ("BE-W16", f (Proxy :: Proxy (BE Word16)) (toBE <$> arbitrary)) , ("BE-W32", f (Proxy :: Proxy (BE Word32)) (toBE <$> arbitrary)) , ("BE-W64", f (Proxy :: Proxy (BE Word64)) (toBE <$> arbitrary)) , ("LE-W16", f (Proxy :: Proxy (LE Word16)) (toLE <$> arbitrary)) , ("LE-W32", f (Proxy :: Proxy (LE Word32)) (toLE <$> arbitrary)) , ("LE-W64", f (Proxy :: Proxy (LE Word64)) (toLE <$> arbitrary)) ]) ] testAdditive :: forall a . (Show a, Eq a, Typeable a, Additive a, Arbitrary a) => Proxy a -> Test testAdditive _ = Group "Additive" [ Property "eq" $ azero === (azero :: a) , Property "a + azero == a" $ \(v :: a) -> v + azero === v , Property "azero + a == a" $ \(v :: a) -> azero + v === v , Property "a + b == b + a" $ \(v1 :: a) v2 -> v1 + v2 === v2 + v1 ] readFloatingExact' :: String -> Maybe (Bool, Natural, Word, Maybe Int) readFloatingExact' str = readFloatingExact str (\s x y z -> Just (s,x,y,z)) doubleEqualApprox :: Double -> Double -> PropertyCheck doubleEqualApprox d1 d2 = (propertyCompare pName1 (<) (negate lim) d) `propertyAnd` (propertyCompare pName2 (<) d lim) where d = d2 - d1 pName1 = show (negate lim) <> " < " <> show d2 <> " - " <> show d1 <> " (== " <> show d <> " )" pName2 = show d1 <> " - " <> show d2 <> " (== " <> show d <> " )" <> " < " <> show lim lim = 1.0e-8 main = defaultMain $ Group "foundation" [ Group "Numerical" [ Group "Int" [ testAdditive (Proxy :: Proxy Int) ] , Group "Word64" [ testAdditive (Proxy :: Proxy Word64) ] ] , Group "String" [ Group "reading" [ Group "integer" [ Property "empty" $ readInteger "" === Nothing , Property "just-sign" $ readInteger "-" === Nothing , Property "extra-content" $ readInteger "-123a" === Nothing , Property "any" $ \i -> readInteger (show i) === Just i ] , Group "floating-exact" [ Property "empty" $ readFloatingExact' "" === Nothing , Property "just-sign" $ readFloatingExact' "-" === Nothing , Property "extra-content" $ readFloatingExact' "-123a" === Nothing , Property "no-dot-after" $ readFloatingExact' "-123." === Nothing , Property "case0" $ readFloatingExact' "124890" === Just (False, 124890, 0, Nothing) , Property "case1" $ readFloatingExact' "-123.1" === Just (True, 1231, 1, Nothing) , Property "case2" $ readFloatingExact' "10001.001" === Just (False, 10001001, 3, Nothing) {- , Property "any" $ \s i (v :: Word8) n -> let (integral,floating) = i `divMod` (10^v) let vw = integralUpsize v :: Word sfloat = show n digits = integralCast (length sfloat) + vw in readFloatingExact' ((if s then "-" else "") <> show i <> "." <> replicate vw '0' <> sfloat) === Just (s, i, Just (digits, n), Nothing) -} ] , Group "Double" [ Property "case1" $ readDouble "96152.5" === Just 96152.5 , Property "case2" $ maybe (propertyFail "Nothing") (doubleEqualApprox 1.2300000000000002e102) $ readDouble "1.2300000000000002e102" , Property "case3" $ maybe (propertyFail "Nothing") (doubleEqualApprox 0.00001204) $ readDouble "0.00001204" , Property "case4" $ maybe (propertyFail "Nothing") (doubleEqualApprox 2.5e12) $ readDouble "2.5e12" , Property "case5" $ maybe (propertyFail "Nothing") (doubleEqualApprox 6.0e-4) $ readDouble "6.0e-4" , Property "case6" $ maybe (propertyFail "Nothing") ((===) (-31.548)) $ readDouble "-31.548" , Property "case7" $ readDouble "1e100000000" === Just (1/0) , Property "Prelude.read" $ \(d :: Double) -> case readDouble (show d) of Nothing -> propertyFail "Nothing" Just d' -> d' `doubleEqualApprox` (Prelude.read $ toList $ show d) ] , Group "rational" [ Property "case1" $ readRational "124.098" === Just (124098 % 1000) ] ] , Group "conversion" [ Property "lower" $ lower "This is MY test" === "this is my test" , Property "upper" $ upper "This is MY test" === "THIS IS MY TEST" ] ] , collectionProperties "DList a" (Proxy :: Proxy (DList Word8)) arbitrary , Group "Array" [ matrixToGroup "Block" $ primTypesMatrixArbitrary $ \prx arb s -> collectionProperties ("Block " <> s) (functorProxy (Proxy :: Proxy Block) prx) arb , matrixToGroup "Unboxed" $ primTypesMatrixArbitrary $ \prx arb s -> collectionProperties ("Unboxed " <> s) (functorProxy (Proxy :: Proxy UArray) prx) arb , Group "Boxed" [ collectionProperties "Array(W8)" (Proxy :: Proxy (Array Word8)) arbitrary , collectionProperties "Array(W16)" (Proxy :: Proxy (Array Word16)) arbitrary , collectionProperties "Array(W32)" (Proxy :: Proxy (Array Word32)) arbitrary , collectionProperties "Array(W64)" (Proxy :: Proxy (Array Word64)) arbitrary , collectionProperties "Array(I8)" (Proxy :: Proxy (Array Int8)) arbitrary , collectionProperties "Array(I16)" (Proxy :: Proxy (Array Int16)) arbitrary , collectionProperties "Array(I32)" (Proxy :: Proxy (Array Int32)) arbitrary , collectionProperties "Array(I64)" (Proxy :: Proxy (Array Int64)) arbitrary , collectionProperties "Array(F32)" (Proxy :: Proxy (Array Float)) arbitrary , collectionProperties "Array(F64)" (Proxy :: Proxy (Array Double)) arbitrary , collectionProperties "Array(Int)" (Proxy :: Proxy (Array Int)) arbitrary , collectionProperties "Array(Int,Int)" (Proxy :: Proxy (Array (Int,Int))) arbitrary , collectionProperties "Array(Integer)" (Proxy :: Proxy (Array Integer)) arbitrary , collectionProperties "Array(CChar)" (Proxy :: Proxy (Array CChar)) (CChar <$> arbitrary) , collectionProperties "Array(CUChar)" (Proxy :: Proxy (Array CUChar)) (CUChar <$> arbitrary) , collectionProperties "Array(BE W16)" (Proxy :: Proxy (Array (BE Word16))) (toBE <$> arbitrary) , collectionProperties "Array(BE W32)" (Proxy :: Proxy (Array (BE Word32))) (toBE <$> arbitrary) , collectionProperties "Array(BE W64)" (Proxy :: Proxy (Array (BE Word64))) (toBE <$> arbitrary) , collectionProperties "Array(LE W16)" (Proxy :: Proxy (Array (LE Word16))) (toLE <$> arbitrary) , collectionProperties "Array(LE W32)" (Proxy :: Proxy (Array (LE Word32))) (toLE <$> arbitrary) , collectionProperties "Array(LE W64)" (Proxy :: Proxy (Array (LE Word64))) (toLE <$> arbitrary) ] ] , Group "ChunkedUArray" [ matrixToGroup "Unboxed" $ primTypesMatrixArbitrary $ \prx arb s -> collectionProperties ("Unboxed " <> s) (functorProxy (Proxy :: Proxy ChunkedUArray) prx) arb ] , testRandom ]