quickcheck-simple-0.1.1.1/0000755000000000000000000000000013522613525013443 5ustar0000000000000000quickcheck-simple-0.1.1.1/Setup.hs0000644000000000000000000000005613522613525015100 0ustar0000000000000000import Distribution.Simple main = defaultMain quickcheck-simple-0.1.1.1/quickcheck-simple.cabal0000644000000000000000000000335713522613525020040 0ustar0000000000000000name: quickcheck-simple version: 0.1.1.1 synopsis: Test properties and default-mains for QuickCheck description: This package contains definitions of test properties and default-mains using QuickCheck library. license: BSD3 license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino@gmail.com copyright: Copyright (c) 2015-2019 Kei Hibino category: Testing build-type: Simple extra-source-files: example/e0.hs cabal-version: >=1.10 tested-with: GHC == 8.8.1 , GHC == 8.6.1, GHC == 8.6.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5 , GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3, GHC == 8.4.4 , GHC == 8.2.1, GHC == 8.2.2 , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4 , GHC == 7.6.1, GHC == 7.6.2, GHC == 7.6.3 , GHC == 7.4.1, GHC == 7.4.2 library exposed-modules: Test.QuickCheck.Simple Test.QuickCheck.CompatIO build-depends: base <5, QuickCheck >=2 hs-source-dirs: src ghc-options: -Wall if impl(ghc >= 8) ghc-options: -Wcompat if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances default-language: Haskell2010 source-repository head type: git location: https://github.com/khibino/haskell-quickcheck-simple source-repository head type: mercurial location: https://bitbucket.org/khibino/haskell-quickcheck-simple quickcheck-simple-0.1.1.1/LICENSE0000644000000000000000000000275613522613525014462 0ustar0000000000000000Copyright (c) 2015, Kei Hibino All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of Kei Hibino nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT OWNER 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. quickcheck-simple-0.1.1.1/src/0000755000000000000000000000000013522613525014232 5ustar0000000000000000quickcheck-simple-0.1.1.1/src/Test/0000755000000000000000000000000013522613525015151 5ustar0000000000000000quickcheck-simple-0.1.1.1/src/Test/QuickCheck/0000755000000000000000000000000013522613525017163 5ustar0000000000000000quickcheck-simple-0.1.1.1/src/Test/QuickCheck/CompatIO.hs0000644000000000000000000000112313522613525021167 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : Test.QuickCheck.CompatIO -- Copyright : 2019 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- This module provides a compatible ioProperty definition. module Test.QuickCheck.CompatIO ( ioProperty, ) where #if MIN_VERSION_QuickCheck(2,7,0) import Test.QuickCheck (ioProperty) #else import Test.QuickCheck.Property (Testable, Property, morallyDubiousIOProperty) ioProperty :: Testable prop => IO prop -> Property ioProperty = morallyDubiousIOProperty #endif quickcheck-simple-0.1.1.1/src/Test/QuickCheck/Simple.hs0000644000000000000000000001071513522613525020754 0ustar0000000000000000-- | -- Module : Test.QuickCheck.Simple -- Copyright : 2015-2019 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com -- Stability : experimental -- Portability : unknown -- -- This module contains definitions of test properties and default-mains -- using QuickCheck library. module Test.QuickCheck.Simple ( Property (..) , boolTest', boolTest , eqTest', eqTest , qcTest , Test, TestError (..) , runTest_, runTest , defaultMain_, defaultMain, verboseMain , defaultMain' ) where import Control.Applicative ((<$>)) import Control.Monad (unless) import Data.Maybe (catMaybes) import Data.Monoid ((<>)) import Test.QuickCheck (Testable, Result (..), quickCheckResult, label) import qualified Test.QuickCheck as QC -- | Property type. 'Bool' or 'Testable' of QuickCheck. data Property = Bool (Maybe String {- verbose error message -}) Bool | QuickCheck QC.Property -- | Property with label string type Test = (String {- label -}, Property) mkBoolTest :: String -> Maybe String -> Bool -> Test mkBoolTest n m = ((,) n) . Bool m -- | 'Bool' specialized property with message for False case boolTest' :: String -> String -> Bool -> Test boolTest' n m = mkBoolTest n (Just m) -- | 'Bool' specialized property boolTest :: String -> Bool -> Test boolTest n = mkBoolTest n Nothing -- | 'Eq' specialized property with explicit passing eqTest' :: (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test eqTest' eq show' n x y = boolTest' n msg $ x `eq` y where msg = unlines [show' x, "** NOT EQUALS **", show' y] -- | 'Eq' specialized property eqTest :: (Eq a, Show a) => String -> a -> a -> Test eqTest = eqTest' (==) show -- | QuickCheck 'Testable' property qcTest :: Testable prop => String -> prop -> Test qcTest n = ((,) n) . QuickCheck . label n -------------------------------------------------------------------------------- -- | Test failure result. data TestError = BFalse (Maybe String {- verbose error message -}) | QCError Result deriving Show putErrorLn :: String -> IO () putErrorLn = putStrLn . ("*** " <>) printVerbose :: String -> TestError -> IO () printVerbose lb te = case te of BFalse m -> maybe (return ()) format m QCError r -> format $ show r where format s = mapM_ putErrorLn $ ("label: " <> lb <> ":") : (map (" " <>) $ lines s) runBool :: String -> Maybe String -- ^ verbose error message. Nothing corresponds to not verbose. -> Bool -> IO (Maybe TestError) runBool lb vmsg = d where d True = do putStrLn $ "+++ OK, success (" <> lb <> ")" return Nothing d False = do putErrorLn $ "Failed! (" <> lb <> ")" let r = BFalse vmsg printVerbose lb r return $ Just r runQcProp :: Bool -- ^ verbose flag -> String -> QC.Property -> IO (Maybe TestError) runQcProp verbose lb p = err =<< quickCheckResult p where err (Success {}) = return Nothing err x = do let r = QCError x if verbose then printVerbose lb r -- this action show label else putErrorLn $ "label: " <> lb -- quickcheck does not show label return $ Just r runProp :: Bool -> String -> Property -> IO (Maybe TestError) runProp verbose lb prop = case prop of Bool m b -> runBool lb (if verbose then m else Nothing) b QuickCheck p -> runQcProp verbose lb p -- | Run a single test suite. runTest_ :: Bool -- ^ verbose flag -> Test -- ^ property to test -> IO (Maybe TestError) -- ^ result action, and may be failure result runTest_ verbose = uncurry $ runProp verbose -- | Not verbose version of runTest_ runTest :: Test -- ^ property to test -> IO (Maybe TestError) -- ^ result action, and may be failure result runTest = runTest_ False -- | Default main to run test suites. defaultMain_ :: Bool -> [Test] -> IO () defaultMain_ verbose xs = do es <- catMaybes <$> mapM (runTest_ verbose) xs unless (null es) $ fail "Some failures are found." defaultMain' :: Bool -> [Test] -> IO () defaultMain' = defaultMain_ {-# DEPRECATED defaultMain' "Use defaultMain_ instead of this." #-} -- | Not verbose version of 'defaultMain''. defaultMain :: [Test] -> IO () defaultMain = defaultMain_ False -- | Verbose verison of defaultMain verboseMain :: [Test] -> IO () verboseMain = defaultMain_ True quickcheck-simple-0.1.1.1/example/0000755000000000000000000000000013522613525015076 5ustar0000000000000000quickcheck-simple-0.1.1.1/example/e0.hs0000644000000000000000000000213413522613525015736 0ustar0000000000000000 import Test.QuickCheck.Simple import System.IO.Error boolTQ :: Test boolTQ = boolTest "true" True boolTV :: Test boolTV = boolTest' "true-verbose" "verbose true" True boolFQ :: Test boolFQ = boolTest "false" False boolFV :: Test boolFV = boolTest' "false-verbose" "verbose false error message" False eqTQ :: Test eqTQ = eqTest "eq" 1 (1 :: Int) eqTV :: Test eqTV = eqTest' (==) show "eq-verbose" 1 (1 :: Int) eqFQ :: Test eqFQ = eqTest "neq" 2 (1 :: Int) eqFV :: Test eqFV = eqTest' (==) show "neq-verbose" 2 (1 :: Int) qcT :: Test qcT = qcTest "qc-true" (\x -> (x :: Int) == x) qcF :: Test qcF = qcTest "qc-false" (\x -> (x :: Int) == x + 1) successTests :: [Test] successTests = [ boolTQ , boolTV , eqTQ , eqTV , qcT ] allTests :: [Test] allTests = [ boolTQ , boolTV , boolFQ , boolFV , eqTQ , eqTV , eqFQ , eqFV , qcT , qcF ] putLine :: IO () putLine = putStrLn "\n------------------------------\n" main :: IO () main = do verboseMain successTests putLine _ <- tryIOError $ defaultMain allTests putLine _ <- tryIOError $ verboseMain allTests return ()