smallcheck 1.0.4 → 1.1

raw patch · 8 files changed

+95/−18 lines, 8 filesdep ~basedep ~mtl

Dependency ranges changed: base, mtl

Files

• CHANGES.md +8/−0
• Test/SmallCheck.hs +1/−0
• Test/SmallCheck/Drivers.hs +1/−1
• Test/SmallCheck/Property.hs +40/−8
• Test/SmallCheck/Property/Result.hs +10/−4
• Test/SmallCheck/Series.hs +27/−2
• Test/SmallCheck/SeriesMonad.hs +6/−1
• smallcheck.cabal +2/−2

@@ -1,6 +1,14 @@ Changes ======= +Version 1.1+-----------++* Add a `Serial` instance for `Ratio`+* Add the `NonEmpty` wrapper for lists+* Add `listM` (the monadic version of `list`)+* Add optional explanation for test outcomes+ Version 1.0.4 ------------- 

@@ -92,6 +92,7 @@   -- * Main types and classes   Testable,   Property,+  Reason    ) where 

@@ -14,7 +14,7 @@   smallCheck, smallCheckM, smallCheckWithHook,   test,   ppFailure,-  PropertyFailure(..), PropertySuccess(..), Argument, TestQuality(..)+  PropertyFailure(..), PropertySuccess(..), Argument, Reason, TestQuality(..)   ) where  import Control.Monad (when)

@@ -9,11 +9,21 @@ -- -- Properties and tools to construct them. ---------------------------------------------------------------------{-# LANGUAGE Trustworthy #-}-  -- Trustworthy is needed because of the hand-written Typeable instance.-  -- Kind-polymorphic Typeable will solve this. {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies,-             ScopedTypeVariables #-}+             ScopedTypeVariables, DeriveDataTypeable #-}++-- CPP is for Typeable1 vs Typeable+{-# LANGUAGE CPP #-}++-- Are we using new, polykinded and derivable Typeable yet?+#define NEWTYPEABLE MIN_VERSION_base(4,7,0)++#if NEWTYPEABLE+{-# LANGUAGE Safe #-}+#else+-- Trustworthy is needed because of the hand-written Typeable instance+{-# LANGUAGE Trustworthy #-}+#endif module Test.SmallCheck.Property (   -- * Constructors   forAll, exists, existsUnique, over, (==>), monadic, changeDepth, changeDepth1,@@ -21,7 +31,7 @@   -- * Property's entrails   Property, -  PropertySuccess(..), PropertyFailure(..), runProperty, TestQuality(..), Argument, Depth, Testable(..),+  PropertySuccess(..), PropertyFailure(..), runProperty, TestQuality(..), Argument, Reason, Depth, Testable(..),   ) where  import Test.SmallCheck.Series@@ -40,6 +50,9 @@  -- | The type of properties over the monad @m@ newtype Property m = Property { unProperty :: Reader (Env m) (PropertySeries m) }+#if NEWTYPEABLE+  deriving Typeable+#endif  data PropertySeries m =   PropertySeries@@ -64,12 +77,16 @@   | BadTest   deriving (Eq, Ord, Enum, Show) +#if !NEWTYPEABLE+-- Typeable here is not polykinded yet, and also GHC doesn't know how to+-- derive this. instance Typeable1 m => Typeable (Property m)   where     typeOf _ =       mkTyConApp         (mkTyCon3 "smallcheck" "Test.SmallCheck.Property" "Property")         [typeOf (undefined :: m ())]+#endif  -- }}} @@ -145,10 +162,25 @@     let       success = do         lift $ testHook env GoodTest-        if b then return PropertyTrue else mzero-      failure = PropertyFalse <$ lnot success+        if b then return $ PropertyTrue Nothing else mzero+      failure = PropertyFalse Nothing <$ lnot success     in atomicProperty success failure +-- | Works like the 'Bool' instance, but includes an explanation of the result.+--+-- 'Left' and 'Right' correspond to test failure and success+-- respectively.+instance Monad m => Testable m (Either Reason Reason) where+  test r = Property $ reader $ \env ->+    let+      success = do+        lift $ testHook env GoodTest+        either (const mzero) (pure . PropertyTrue . Just) r+      failure = do+        lift $ testHook env GoodTest+        either (pure . PropertyFalse . Just) (const mzero) r+    in atomicProperty success failure+ instance (Serial m a, Show a, Testable m b) => Testable m (a->b) where   test = testFunction series @@ -179,7 +211,7 @@               CounterExample args etc -> CounterExample (arg:args) etc               _ -> CounterExample [arg] failure -        success = PropertyTrue <$ lnot failure+        success = PropertyTrue Nothing <$ lnot failure       -- }}}      Exists -> PropertySeries success failure closest

@@ -4,6 +4,7 @@   ( PropertySuccess(..)   , PropertyFailure(..)   , ppFailure+  , Reason   , Argument   ) where @@ -11,10 +12,13 @@  type Argument = String +-- | An explanation for the test outcome+type Reason = String+ data PropertySuccess   = Exist [Argument] PropertySuccess   | ExistUnique [Argument] PropertySuccess-  | PropertyTrue+  | PropertyTrue (Maybe Reason)   | Vacuously PropertyFailure   deriving (Eq, Show) @@ -22,7 +26,7 @@   = NotExist   | AtLeastTwo [Argument] PropertySuccess [Argument] PropertySuccess   | CounterExample [Argument] PropertyFailure-  | PropertyFalse+  | PropertyFalse (Maybe Reason)   deriving (Eq, Show)  class Pretty a where@@ -43,10 +47,12 @@     prettyArgs args <+>     text "such that"     </> (pretty f)-  pretty PropertyFalse = text "condition is false"+  pretty (PropertyFalse Nothing)  = text "condition is false"+  pretty (PropertyFalse (Just s)) = text s  instance Pretty PropertySuccess where-  pretty PropertyTrue = text "condition is true"+  pretty (PropertyTrue Nothing)  = text "condition is true"+  pretty (PropertyTrue (Just s)) = text s   pretty (Exist       args s) = existsMsg False args s   pretty (ExistUnique args s) = existsMsg True args s   pretty (Vacuously s) = text "property is vacuously true because" </> pretty s

@@ -28,6 +28,7 @@ -- The following is needed for generic instances {-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators,              TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE Trustworthy #-}  module Test.SmallCheck.Series (   -- {{{@@ -148,7 +149,7 @@   Depth, Series, Serial(..), CoSerial(..),    -- * Convenient wrappers-  Positive(..), NonNegative(..),+  Positive(..), NonNegative(..), NonEmpty(..),    -- * Other useful definitions   (\/), (><), (<~>), (>>-),@@ -156,7 +157,8 @@   decDepth,   getDepth,   generate,-  list+  list,+  listM   -- }}}   ) where @@ -165,6 +167,7 @@ import Control.Applicative import Control.Monad.Identity import Data.List+import Data.Ratio import Test.SmallCheck.SeriesMonad import GHC.Generics @@ -210,6 +213,10 @@ list :: Depth -> Series Identity a -> [a] list d s = runIdentity $ observeAllT $ runSeries d s +-- | Monadic version of 'list'+listM :: Monad m => Depth -> Series m a -> m [a]+listM d s = observeAllT $ runSeries d s+ -- | Sum (union) of series infixr 7 \/ (\/) :: Monad m => Series m a -> Series m a -> Series m a@@ -476,6 +483,15 @@   coseries rs =     (. (realToFrac :: Double -> Float)) <$> coseries rs +instance (Integral i, Serial m i) => Serial m (Ratio i) where+  series = pairToRatio <$> series+    where+      pairToRatio (n, Positive d) = n % d+instance (Integral i, CoSerial m i) => CoSerial m (Ratio i) where+  coseries rs = (. ratioToPair) <$> coseries rs+    where+      ratioToPair r = (numerator r, denominator r)+ instance Monad m => Serial m Char where   series = generate $ \d -> take (d+1) ['a'..'z'] instance Monad m => CoSerial m Char where@@ -597,5 +613,14 @@  instance Show a => Show (NonNegative a) where   showsPrec n (NonNegative x) = showsPrec n x++-- | @NonEmpty xs@: guarantees that @xs@ is not null+newtype NonEmpty a = NonEmpty { getNonEmpty :: [a] }++instance (Serial m a) => Serial m (NonEmpty a) where+  series = NonEmpty <$> cons2 (:)++instance Show a => Show (NonEmpty a) where+  showsPrec n (NonEmpty x) = showsPrec n x  -- }}}

@@ -6,6 +6,7 @@ import Control.Monad import Control.Monad.Logic import Control.Monad.Reader+import Control.Arrow  -- | Maximum depth of generated test values. --@@ -38,7 +39,11 @@     , Applicative     , MonadPlus     , Alternative-    , MonadLogic)+    )++-- This instance is written manually. Using the GND for it is not safe. +instance Monad m => MonadLogic (Series m) where+  msplit (Series a) = Series $ fmap (fmap $ second Series) $ msplit a  instance MonadTrans Series where   lift a = Series $ lift . lift $ a

@@ -1,5 +1,5 @@ Name:          smallcheck-Version:       1.0.4+Version:       1.1 Cabal-Version: >= 1.6 License:       BSD3 License-File:  LICENSE@@ -27,7 +27,7 @@ Source-repository this   type:     git   location: git://github.com/feuerbach/smallcheck.git-  tag:      v1.0.4+  tag:      v1.1  Library