quickcheck-classes 0.4.3 → 0.4.4
raw patch · 4 files changed
+74/−26 lines, 4 files
Files
- changelog.md +6/−0
- quickcheck-classes.cabal +24/−4
- src/Test/QuickCheck/Classes.hs +38/−22
- test/Spec.hs +6/−0
changelog.md view
@@ -4,6 +4,12 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.4.4] - 2018-03-23+### Added+- Cabal flags for controlling whether or not `aeson` and `semigroupoids`+ are used. These are mostly provided to accelerate builds `primitive`'s + test suite.+ ## [0.4.3] - 2018-03-23 ### Added - Property tests for `foldl1` and `foldr1`.
quickcheck-classes.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-classes-version: 0.4.3+version: 0.4.4 synopsis: QuickCheck common typeclasses description: This library provides quickcheck properties to@@ -20,6 +20,23 @@ cabal-version: >=1.10 extra-source-files: changelog.md +flag aeson+ description:+ You can disable the use of the `aeson` package using `-f-aeson`.+ .+ This may be useful for accelerating builds in sandboxes for expert users.+ default: True+ manual: True++flag semigroupoids+ description:+ You can disable the use of the `semigroupoids` package using `-f-semigroupoids`.+ .+ This may be useful for accelerating builds in sandboxes for expert users.+ default: True+ manual: True++ library hs-source-dirs: src exposed-modules:@@ -30,11 +47,13 @@ , QuickCheck >= 2.9 , transformers >= 0.3 && < 0.6 , primitive >= 0.6.1 && < 0.7- , aeson , containers , semigroups , tagged- , semigroupoids + if flag(aeson)+ build-depends: aeson+ if flag(semigroupoids)+ build-depends: semigroupoids default-language: Haskell2010 test-suite test@@ -46,10 +65,11 @@ , quickcheck-classes , QuickCheck , primitive- , aeson , vector , transformers , tagged+ if flag(aeson)+ build-depends: aeson default-language: Haskell2010 source-repository head
src/Test/QuickCheck/Classes.hs view
@@ -42,9 +42,10 @@ , eqLaws , ordLaws , showReadLaws+#if defined(VERSION_aeson) , jsonLaws+#endif , integralLaws- , jsonLaws , monoidLaws , ordLaws , primLaws@@ -59,7 +60,9 @@ #if MIN_VERSION_QuickCheck(2,10,0) -- ** Higher-Kinded Types #if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)+#if defined(VERSION_semigroupoids) , altLaws +#endif , alternativeLaws , applicativeLaws , foldableLaws@@ -78,7 +81,6 @@ import Data.Functor ((<$)) import Control.Applicative (liftA2,(<*>),pure,Applicative,(<$>),Alternative(..)) import Control.Monad.ST-import Data.Aeson (FromJSON(..),ToJSON(..)) import Data.Bifunctor (Bifunctor(..)) import Data.Bits import Data.Foldable (foldMap,Foldable)@@ -88,7 +90,6 @@ import Data.Primitive.Addr (Addr(..)) import Data.Proxy import Data.Semigroup (Semigroup)-import Data.Functor.Alt hiding (Apply) import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Storable@@ -100,13 +101,22 @@ import Test.QuickCheck.Property (Property(..)) import Control.Monad.Primitive (PrimMonad,PrimState,primitive,primitive_) import qualified Control.Monad.Trans.Writer.Lazy as WL-import qualified Data.Aeson as AE import qualified Data.Primitive as P import qualified Data.Semigroup as SG import qualified Data.Monoid as MND import qualified Data.List as L import qualified Data.Set as S +#if defined(VERSION_semigroupoids)+import Data.Functor.Alt (Alt)+import qualified Data.Functor.Alt as Alt+#endif++#if defined(VERSION_aeson)+import Data.Aeson (FromJSON(..),ToJSON(..))+import qualified Data.Aeson as AE+#endif+ #if MIN_VERSION_base(4,6,0) import Text.Read (readMaybe) #endif@@ -201,12 +211,27 @@ -- -- Note that in the second propertiy, the type of decode is @ByteString -> Value@, -- not @ByteString -> a@+#if defined(VERSION_aeson) jsonLaws :: (ToJSON a, FromJSON a, Show a, Arbitrary a, Eq a) => Proxy a -> Laws jsonLaws p = Laws "ToJSON/FromJSON" [ ("Partial Isomorphism", jsonEncodingPartialIsomorphism p) , ("Encoding Equals Value", jsonEncodingEqualsValue p) ] +-- TODO: improve the quality of the error message if+-- something does not pass this test.+jsonEncodingEqualsValue :: forall a. (ToJSON a, Show a, Arbitrary a) => Proxy a -> Property+jsonEncodingEqualsValue _ = property $ \(a :: a) ->+ case AE.decode (AE.encode a) of+ Nothing -> False+ Just (v :: AE.Value) -> v == toJSON a++jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) => Proxy a -> Property+jsonEncodingPartialIsomorphism _ = property $ \(a :: a) ->+ AE.decode (AE.encode a) == Just a++#endif+ -- | Tests the following properties: -- -- [/Partial Isomorphism/]@@ -408,18 +433,6 @@ read (show a) == a #endif --- TODO: improve the quality of the error message if--- something does not pass this test.-jsonEncodingEqualsValue :: forall a. (ToJSON a, Show a, Arbitrary a) => Proxy a -> Property-jsonEncodingEqualsValue _ = property $ \(a :: a) ->- case AE.decode (AE.encode a) of- Nothing -> False- Just (v :: AE.Value) -> v == toJSON a--jsonEncodingPartialIsomorphism :: forall a. (ToJSON a, FromJSON a, Show a, Eq a, Arbitrary a) => Proxy a -> Property-jsonEncodingPartialIsomorphism _ = property $ \(a :: a) ->- AE.decode (AE.encode a) == Just a- eqTransitive :: forall a. (Show a, Eq a, Arbitrary a) => Proxy a -> Property eqTransitive _ = property $ \(a :: a) b c -> case a == b of True -> case b == c of@@ -820,12 +833,21 @@ -- @(a '<!>' b) '<!>' c ≡ a '<!>' (b '<!>' c)@ -- [/Left Distributivity/] -- @f '<$>' (a '<!>' b) = (f '<$>' a) '<!>' (f '<$>' b)+#if defined(VERSION_semigroupoids) altLaws :: (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Laws altLaws p = Laws "Alt" [ ("Associativity", altAssociative p) , ("Left Distributivity", altLeftDistributive p) ] +altAssociative :: forall proxy f. (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+altAssociative _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 ((a Alt.<!> b) Alt.<!> c) (a Alt.<!> (b Alt.<!> c))++altLeftDistributive :: forall proxy f. (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property+altLeftDistributive _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) -> eq1 (id <$> (a Alt.<!> b)) ((id <$> a) Alt.<!> (id <$> b))+#endif++ -- | Tests the following monadic properties: -- -- [/Left Identity/]@@ -1308,12 +1330,6 @@ functorConst :: forall proxy f. (Functor f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property functorConst _ = property $ \(Apply (a :: f Integer)) -> eq1 (fmap (const 'X') a) ('X' <$ a)--altAssociative :: forall proxy f. (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property-altAssociative _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) (Apply (c :: f Integer)) -> eq1 ((a <!> b) <!> c) (a <!> (b <!> c))--altLeftDistributive :: forall proxy f. (Alt f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property-altLeftDistributive _ = property $ \(Apply (a :: f Integer)) (Apply (b :: f Integer)) -> eq1 (id <$> (a <!> b)) ((id <$> a) <!> (id <$> b)) alternativeIdentity :: forall proxy f. (Alternative f, Eq1 f, Show1 f, Arbitrary1 f) => proxy f -> Property alternativeIdentity _ = property $ \(Apply (a :: f Integer)) -> (eq1 (empty <|> a) a) && (eq1 a (empty <|> a))
test/Spec.hs view
@@ -6,7 +6,9 @@ import Control.Monad import Control.Applicative+#if defined(VERSION_aeson) import Data.Aeson (ToJSON,FromJSON)+#endif import Data.Bits import Data.Foldable import Data.Traversable@@ -57,8 +59,10 @@ , Arbitrary a , Show a , Read a+#if defined(VERSION_aeson) , ToJSON a , FromJSON a+#endif #if MIN_VERSION_base(4,7,0) , FiniteBits a #endif@@ -68,7 +72,9 @@ , storableLaws p , monoidLaws (Proxy :: Proxy (Sum a)) , showReadLaws p+#if defined(VERSION_aeson) , jsonLaws p+#endif , eqLaws p , ordLaws p , integralLaws p