quickcheck-property-monad (empty) → 0.1

raw patch · 10 files changed

+482/−0 lines, 10 filesdep +QuickCheckdep +basedep +directorybuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, directory, doctest, either, filepath, transformers

Files

• .ghci +1/−0
• .gitignore +15/−0
• .travis.yml +24/−0
• .vim.custom +31/−0
• LICENSE +30/−0
• README.md +135/−0
• Setup.hs +69/−0
• quickcheck-property-monad.cabal +52/−0
• src/Test/QuickCheck/Property/Monad.hs +51/−0
• tests/doctests.hsc +74/−0

@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h

@@ -0,0 +1,15 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#+.cabal-sandbox+cabal.sandbox.config

@@ -0,0 +1,24 @@+env:+ - GHCVER=7.4.2 CABALVER=1.16+ - GHCVER=7.6.3 CABALVER=1.18+ - GHCVER=head CABALVER=1.18 ++before_install:+ - sudo add-apt-repository -y ppa:hvr/ghc+ - sudo apt-get update+ - sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER hlint+ - cabal-$CABALVER update+ - cabal-$CABALVER install happy -j+ - export PATH=/opt/ghc/$GHCVER/bin:~/.cabal/bin:$PATH++install:+ - cabal-$CABALVER install --only-dependencies --enable-tests --enable-benchmarks -j++script:+ - travis/script.sh+ - hlint src++matrix:+  allow_failures:+   - env: GHCVER=head CABALVER=1.18+  fast_finish: true

@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -0,0 +1,30 @@+Copyright 2013 Benno Fünfstück++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,135 @@+# quickcheck-property-monad++[![Build Status](https://secure.travis-ci.org/bennofs/quickcheck-property-monad.png?branch=master)](http://travis-ci.org/bennofs/quickcheck-property-monad)++## Introduction++When your data has many invariants, it's often difficult to write `Arbitrary` instances for QuickCheck. This library attempts to solve that+problem by providing a nice interface to write QuickCheck tests without using `Arbitrary` instances. It aims to be somewhere in the middle between+`HUnit` and `QuickCheck`: Use the random test case generation of `QuickCheck`, but write `HUnit` like assertions.++## A simple model++To show the library in action, let's first create a simple model holding an integer with a one invariant: the value hold by it will always be even.+We also provide two operations that preserve the invariant, `add2` and `multiply`, a function to create a new model and a function to check that the+invariant holds (we will use this function later when we write our tests):++```haskell+module Model+  ( Model() -- We don't export the constructor so the invariant cannot be broken.+  , newModel+  , add2+  , multiply+  , checkInvariant+  ) where++data Model = Model { value :: Int } deriving Show++newModel :: Model+newModel = Model 0++add2 :: Model -> Model+add2 (Model x) = Model $ 2 + x++multiply :: Int -> Model -> Model+multiply n (Model x) = Model $ n * x++checkInvariant :: Model -> Bool+checkInvariant (Model x) = even x+```++## Writing tests using the `PropM` monad++We now want to write tests that ensure that none of our operations will ever break the invariant, no matter in what sequence we apply them. In this case, we could+write an `Arbitrary` instance for our model, but for more complex models, this will quickly become very difficult. Often, you have to use the functions you want to test+to create the `Arbitrary` instance, which means that if the functions are broken, you already generate invalid data to begin with. It's difficult to find the bug in that case.++```haskell+module Main where++import Model+import Test.QuickCheck+import Test.QuickCheck.Property.Monad+```++But using `quickcheck-property-monad`, we can write the tests so that they will fail right after the invariant is broken. First, we define a `Gen` to generate a random+operation. We will also include a short description of the operation, to make debugging easier:++```haskell+randomOperation :: Gen (String, Model -> Model)+randomOperation = oneof+  [ return ("Add two", add2)+  , fmap (\n -> ("Multiply by " ++ show n, multiply n)) arbitrary+  ]+```++So far, all functions we've used are provided by `QuickCheck` itself. Let's now write the test property:++```haskell+prop_satisfies_invariant :: Property+prop_satisfies_invariant = sized $ \s -> property $ go newModel s+  where go :: Model -> Int -> PropM Bool+        go _     0    = return True+        go model size = do+          (description, operation) <- generate randomOperation+          logMessageLn $ "Operation: " ++ description+          let model' = operation model+          logMessageLn $ "Model is now: " ++ show model'+          assert "Number is even" $ checkInvariant model'+          go model' $ pred size+```++Here we've used some functions from `quickcheck-property-monad`. We first grab the `size` parameter from QuickCheck using `sized`, and then+pass that to go, together with an initial model. `go` returns a value of type `PropM Bool`, which we have to convert into a QuickCheck `Property`+using the `property` function.++But what does go do? First, it looks at the size parameter. If the size is null, we return `True`, indicating a successful test. If the size is not+null, we first generate a random operation, using our previously defined `randomOperation` function. We use `generate` to lift the `Gen` into the `PropM`+monad. After we generated a random operation, we log it. You'll see all messages logged with `logMessageLn` when the test fails, which is useful for+debugging. We then apply the operation on the model. Using `assert`, we require that the model still satisfies our invariant. `assert` will do nothing+if the condition given to it is True. If it is False, it will abort the test case and report a failure, with the given error message. After that, we recurse,+decreasing the size by one so that we eventually reach 0 and stop.++Now, the only function left to write is main:++```haskell+main :: IO ()+main = quickCheck prop_satisfies_invariant+```++If we run our test suite, we get the expected output:++```++++ OK, passed 100 tests.+```++All fine!++## How a failure looks++Now, if you want to see how a failing test looks like, go back and change++```haskell+add2 (Model x) = Model $ 2 + x+```++to++```haskell+add2 (Model x) = Model $ 1 + x+```++If we now run our tests, we get a failure, as expected:++    *** Failed! Falsifiable (after 2 tests): +    Operation: Add two+    Model is now: Model {value = 1}++    Assertion failed: Number is even++We get the output from the `logMessageLn` calls and the message of the assertion that failed.++## Contributing++Contributions are always welcome. If you have any ideas, improvements or bug reports,+send a pull request or open a issue on github.

@@ -0,0 +1,69 @@+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.IORef+import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..), hsSourceDirs, libBuildInfo, buildInfo)+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, withExeLBI, ComponentLocalBuildInfo(), LocalBuildInfo(), componentPackageDeps )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag, buildDistPref, defaultDistPref, fromFlagOrDefault )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Verbosity ( Verbosity )+import System.Directory ( canonicalizePath )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi flags+     buildHook simpleUserHooks pkg lbi hooks flags+  }++--  Very ad-hoc implementation of difference lists+singletonDL :: a -> [a] -> [a]+singletonDL = (:)++emptyDL :: [a] -> [a]+emptyDL = id++appendDL :: ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]+appendDL x y = x . y++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> BuildFlags -> IO ()+generateBuildModule verbosity pkg lbi flags = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withTestLBI pkg lbi $ \suite suitelbi -> do+    srcDirs <- mapM canonicalizePath $ hsSourceDirs $ testBuildInfo suite+    distDir <- canonicalizePath $ fromFlagOrDefault defaultDistPref $ buildDistPref flags++    depsVar <- newIORef emptyDL+    withLibLBI pkg lbi $ \lib liblbi ->+      modifyIORef depsVar $ appendDL . singletonDL $ depsEntry (libBuildInfo lib) liblbi suitelbi+    withExeLBI pkg lbi $ \exe exelbi ->+      modifyIORef depsVar $ appendDL . singletonDL $ depsEntry (buildInfo exe) exelbi suitelbi+    deps <- fmap ($ []) $ readIORef depsVar++    rewriteFile (map fixchar $ dir </> "Build_" ++ testName suite ++ ".hs") $ unlines +      [ "module Build_" ++ map fixchar (testName suite) ++ " where"+      , "getDistDir :: FilePath"+      , "getDistDir = " ++ show distDir+      , "getSrcDirs :: [FilePath]"+      , "getSrcDirs = " ++ show srcDirs+      , "deps :: [([FilePath], [String])]"+      , "deps = " ++ show deps+      ]++  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+    depsEntry targetbi targetlbi suitelbi = (hsSourceDirs targetbi, formatdeps $ testDeps targetlbi suitelbi)+    fixchar '-' = '_'+    fixchar c = c++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys

@@ -0,0 +1,52 @@+name:          quickcheck-property-monad+version:       0.1+license:       BSD3+cabal-version: >= 1.10+license-file:  LICENSE+author:        Benno Fünfstück+maintainer:    Benno Fünfstück <benno.fuenfstueck@gmail.com>+stability:     experimental+homepage:      http://github.com/bennofs/quickcheck-property-monad/+bug-reports:   http://github.com/bennofs/quickcheck-property-monad/issues+copyright:     Copyright (C) 2013 Benno Fünfstück+synopsis:      quickcheck-property-monad+description:   quickcheck-property-monad+build-type:    Custom+category:      Testing++extra-source-files:+  .ghci+  .gitignore+  .travis.yml+  .vim.custom+  README.md++source-repository head+  type: git+  location: https://github.com/bennofs/quickcheck-property-monad.git++library+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall+  build-depends:+      base >= 4.4 && < 5+    , either+    , transformers+    , QuickCheck+  exposed-modules:+      Test.QuickCheck.Property.Monad++test-suite doctests+  type:    exitcode-stdio-1.0+  main-is: doctests.hs+  default-language: Haskell2010+  build-depends:+      base+    , directory >= 1.0+    , doctest >= 0.9.1+    , filepath+  ghc-options: -Wall -threaded+  if impl(ghc<7.6.1)+    ghc-options: -Werror+  hs-source-dirs: tests

@@ -0,0 +1,51 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- | Tutorial: <http://github.com/bennofs/quickcheck-property-monad/tree/master/README.md>+module Test.QuickCheck.Property.Monad+  ( PropM()+  , assert+  , failWith+  , generate+  , logMessage+  , logMessageLn+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import Control.Monad.Trans.Writer+import Test.QuickCheck.Gen+import Test.QuickCheck.Property++-- | PropM is a monad for writing properties that depend on random+-- data. This is especially useful if you have many invariants for+-- your data and cannot simply write an 'Arbitrary' instance.+newtype PropM a = PropM (EitherT String (WriterT String Gen) a) deriving (Functor, Applicative, Alternative, Monad, MonadPlus)++instance Testable a => Testable (PropM a) where+  property (PropM m) = property $ do+    (r,w) <- runWriterT $ runEitherT m+    case r of+      Right r' -> return $ property r'+      Left err -> return $ printTestCase (w ++ "\n" ++ err) $ property False++-- | Assert that a certain condition is true. If the condition is false, fail with the+-- given error message.+assert :: String -> Bool -> PropM ()+assert err cond = unless cond $ failWith $ "Assertion failed: " ++ err++-- | Fail with the given error message.+failWith :: String -> PropM ()+failWith err = PropM $ left err++-- | Use the given generator to generate a value.+generate :: Gen a -> PropM a+generate = PropM . lift . lift++-- | Log a message that will be printed when the test case fails.+logMessage :: String -> PropM ()+logMessage = PropM . lift . tell++-- | Like 'logMessage' but appends a line break after the message.+logMessageLn :: String -> PropM ()+logMessageLn = logMessage . (++ "\n")

@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##ifdef mingw32_HOST_ARCH+##ifdef i386_HOST_ARCH+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ forM_ deps $ \(dirs, dep) -> do+    putStrLn $ ":: Running doctests for source directories: " ++ intercalate " " dirs+    mapM getSources dirs >>= \sources -> doctest $+        "-idist/build/autogen"+      : "-optP-include"+      : "-optPdist/build/autogen/cabal_macros.h"+      : "-hide-all-packages"+      : map ("-package="++) dep+        ++ map ("-i"++) dirs +        ++ join sources ++getSources :: FilePath -> IO [FilePath]+getSources d = filter (isSuffixOf ".hs") <$> go d+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c