QuickCheckVariant 0.2.0.0 → 1.0.0.0

raw patch · 4 files changed

+176/−9 lines, 4 filesdep +QuickCheckVariantdep +hspecdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheckVariant, hspec

Dependency ranges changed: QuickCheck, base

API changes (from Hackage documentation)

Files

• QuickCheckVariant.cabal +14/−3
• README.md +14/−0
• src/Test/QuickCheck/Variant.hs +101/−6
• test/VariantTest.hs +47/−0

@@ -2,7 +2,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.0+version:             1.0.0.0 synopsis:            Generator of "valid" and "invalid" data in a type class description:         Generator of "valid" and "invalid" data in a type class homepage:            https://github.com/sanjorgek/QuickCheckVariant@@ -11,7 +11,7 @@ author:              Jorge Santiago Alvarez Cuadros maintainer:          sanjorgek@ciencias.unam.mx bug-reports:         https://github.com/sanjorgek/QuickCheckVariant/issues--- copyright:+copyright:           (c) Jorge Santiago Alvarez Cuadros category:            Testing build-type:          Simple extra-source-files:  README.md@@ -26,6 +26,17 @@   -- other-modules:   -- other-extensions:   build-depends:       base >4.6 && <5-                       , QuickCheck+                       , QuickCheck >2.10 && <2.12   hs-source-dirs:      src   default-language:    Haskell98++test-suite variant+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             VariantTest.hs+  --other-modules:+  build-depends:       base+                       , hspec >2.3 && <2.5+                       , QuickCheck >2.10 && <2.12+                       , QuickCheckVariant+  default-language:    Haskell2010

@@ -2,6 +2,8 @@  Generator of "valid" and "invalid" data in a type class +[![QuickCheckVariant](https://img.shields.io/badge/QuickCheckVariant-v0.2.0.0-blue.svg?style=plastic)](https://hackage.haskell.org/package/QuickCheckVariant)+ For example, if you created  ```haskell@@ -27,3 +29,15 @@ ```   See [this post](https://wiki.haskell.org/QuickCheck_as_a_test_set_generator) for more details++## More badges++[![QuickCheckVariant](https://img.shields.io/badge/winter-is%20here-blue.svg)](http://sanjorgek.com/QuickCheckVariant/)++[![forthebadge](http://forthebadge.com/images/badges/uses-badges.svg)](http://sanjorgek.com/QuickCheckVariant/)++[![forthebadge](http://forthebadge.com/images/badges/check-it-out.svg)](http://sanjorgek.com/QuickCheckVariant/)++[![forthebadge](http://forthebadge.com/images/badges/compatibility-betamax.svg)](http://sanjorgek.com/QuickCheckVariant/)++[![forthebadge](http://forthebadge.com/images/badges/you-didnt-ask-for-this.svg)](http://sanjorgek.com/QuickCheckVariant/)

@@ -11,7 +11,12 @@ To get random "invalid" and "valid" data -} module Test.QuickCheck.Variant where-import           Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Exception+import Test.QuickCheck.Gen+import Test.QuickCheck.Property+import Test.QuickCheck.State+import Test.QuickCheck.Text  {-| You can define@@ -27,7 +32,7 @@ {-| The class of things wich can be tested with invalid or valid input. -}-class VarTesteable prop where+class VarTestable prop where   -- |Property for valid input   propertyValid::prop -> Property   -- |Property for invalid input@@ -36,13 +41,103 @@ {-| Same as Testeable -}-instance VarTesteable Bool where+instance VarTestable Bool where   propertyValid = property   propertyInvalid = property +mapTotalResultValid :: VarTestable prop => (Result -> Result) -> prop -> Property+mapTotalResultValid f = mapRoseResultValid (fmap f)++-- f here mustn't throw an exception (rose tree invariant).+mapRoseResultValid :: VarTestable prop => (Rose Result -> Rose Result) -> prop -> Property+mapRoseResultValid f = mapPropValid (\(MkProp t) -> MkProp (f t))++mapPropValid :: VarTestable prop => (Prop -> Prop) -> prop -> Property+mapPropValid f = MkProperty . fmap f . unProperty . propertyValid++-- | Adds a callback+callbackValid :: VarTestable prop => Callback -> prop -> Property+callbackValid cb = mapTotalResultValid (\res -> res{ callbacks = cb : callbacks res })++-- | Adds the given string to the counterexample if the property fails.+counterexampleValid :: VarTestable prop => String -> prop -> Property+counterexampleValid s =+  mapTotalResult (\res -> res{ testCase = s:testCase res }) .+  callbackValid (PostFinalFailure Counterexample $ \st _res -> do+    s <- showCounterexampleValid s+    putLine (terminal st) s)++showCounterexampleValid :: String -> IO String+showCounterexampleValid s = do+  let force [] = return ()+      force (x:xs) = x `seq` force xs+  res <- tryEvaluateIO (force s)+  return $+    case res of+      Left err ->+        formatException "Exception thrown while showing test case" err+      Right () ->+        s++-- | Like 'forAll', but tries to shrink the argument for failing test cases.+forAllShrinkValid :: (Show a, VarTestable prop)+             => Gen a -> (a -> [a]) -> (a -> prop) -> Property+forAllShrinkValid gen shrinker pf =+  again $+  MkProperty $+  gen >>= \x ->+    unProperty $+    shrinking shrinker x $ \x' ->+      counterexampleValid (show x') (pf x')++mapTotalResultInvalid :: VarTestable prop => (Result -> Result) -> prop -> Property+mapTotalResultInvalid f = mapRoseResultInvalid (fmap f)++-- f here mustn't throw an exception (rose tree invariant).+mapRoseResultInvalid :: VarTestable prop => (Rose Result -> Rose Result) -> prop -> Property+mapRoseResultInvalid f = mapPropInvalid (\(MkProp t) -> MkProp (f t))++mapPropInvalid :: VarTestable prop => (Prop -> Prop) -> prop -> Property+mapPropInvalid f = MkProperty . fmap f . unProperty . propertyInvalid++-- | Adds a callback+callbackInvalid :: VarTestable prop => Callback -> prop -> Property+callbackInvalid cb = mapTotalResultInvalid (\res -> res{ callbacks = cb : callbacks res })++-- | Adds the given string to the counterexample if the property fails.+counterexampleInvalid :: VarTestable prop => String -> prop -> Property+counterexampleInvalid s =+  mapTotalResult (\res -> res{ testCase = s:testCase res }) .+  callbackInvalid (PostFinalFailure Counterexample $ \st _res -> do+    s <- showCounterexampleInvalid s+    putLine (terminal st) s)++showCounterexampleInvalid :: String -> IO String+showCounterexampleInvalid s = do+  let force [] = return ()+      force (x:xs) = x `seq` force xs+  res <- tryEvaluateIO (force s)+  return $+    case res of+      Left err ->+        formatException "Exception thrown while showing test case" err+      Right () ->+        s++-- | Like 'forAll', but tries to shrink the argument for failing test cases.+forAllShrinkInvalid :: (Show a, VarTestable prop)+             => Gen a -> (a -> [a]) -> (a -> prop) -> Property+forAllShrinkInvalid gen shrinker pf =+  again $+  MkProperty $+  gen >>= \x ->+    unProperty $+    shrinking shrinker x $ \x' ->+      counterexampleInvalid (show x') (pf x')+ {-| Instead of variant we use valid or invalid generators -}-instance (Arbitrary a, Variant a, Show a, Testable prop) => VarTesteable (a->prop) where-  propertyValid = forAllShrink valid shrink-  propertyInvalid = forAllShrink invalid shrink+instance (Arbitrary a, Variant a, Show a, VarTestable prop) => VarTestable (a->prop) where+  propertyValid = forAllShrinkValid valid shrink+  propertyInvalid = forAllShrinkInvalid invalid shrink

@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Main where++import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.QuickCheck+import           Test.QuickCheck.Variant++type Natural = Integer++instance Variant Natural where+  invalid = do+    n <- arbitrary+    if n<0 then return n else return ((-1)*(n+1))+  valid = do+    n <- arbitrary+    if n>=0 then return n else return ((-1)*(n-1))++tupleProp = describe "Naturals" $ do+  describe "valid" $+    context "order" $ do+      it "0 <= n" $+        propertyValid $+          \ n -> 0 <= (n::Natural)+      it "0 <= n+m" $+        propertyValid $+          \ n m ->  0 <= (n::Natural)+(m::Natural)+      it "0 <= n*m" $+        propertyValid $+          \ n m ->  0 <= (n::Natural)*(m::Natural)+  describe "invalid" $+    context "order" $ do+      it "0 > n" $+        propertyInvalid $+          \ n -> (n::Natural) < 0+      it "0 > n+m" $+        propertyInvalid $+          \ n m ->  0 > (n::Natural)+(m::Natural)+      it "0 < n*m" $+        propertyInvalid $+          \ n m ->  0 < (n::Natural)*(m::Natural)+++main::IO ()+main = hspec $+  describe "Test test" tupleProp