packages feed

quickcheck-report (empty) → 0.1.0.0

raw patch · 5 files changed

+294/−0 lines, 5 filesdep +QuickCheckdep +basedep +lenssetup-changed

Dependencies added: QuickCheck, base, lens, template-haskell, th-printf

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Simon Hudon++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/QuickCheck/Lens.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE TemplateHaskell #-}+module Test.QuickCheck.Lens where++import Control.Lens++import Test.QuickCheck+import Test.QuickCheck.Exception+import Test.QuickCheck.Random++makePrisms ''Result++pairs :: Iso (s0,s1,s2,s3,s4,s5,s6,s7,s8,s9) +             (t0,t1,t2,t3,t4,t5,t6,t7,t8,t9) +             ((s0,s1,s2,s3,s4),(s5,s6,s7,s8,s9)) +             ((t0,t1,t2,t3,t4),(t5,t6,t7,t8,t9)) +pairs = iso (\(s0,s1,s2,s3,s4,s5,s6,s7,s8,s9) -> ((s0,s1,s2,s3,s4),(s5,s6,s7,s8,s9)))+            (\((s0,s1,s2,s3,s4),(s5,s6,s7,s8,s9)) -> (s0,s1,s2,s3,s4,s5,s6,s7,s8,s9))++argReplay :: Lens' Args (Maybe (QCGen, Int))+argReplay f x = (\r' -> x { replay = r' }) <$> f (replay x)++argMaxSuccess :: Lens' Args Int+argMaxSuccess f x = (\r' -> x { maxSuccess = r' }) <$> f (maxSuccess x)++argMaxDiscardRatio :: Lens' Args Int+argMaxDiscardRatio f x = (\r' -> x { maxDiscardRatio = r' }) <$> f (maxDiscardRatio x)++argMaxSize :: Lens' Args Int+argMaxSize f x = (\r' -> x { maxSize = r' }) <$> f (maxSize x)++argChatty :: Lens' Args Bool+argChatty f x = (\r' -> x { chatty = r' }) <$> f (chatty x)++type Failure = (Int,+                 Int,+                 Int,+                 Int,+                 QCGen,+                 Int,+                 String,+                 Maybe AnException,+                 [(String, Int)],+                 String)++resNumTests :: Lens' Result Int+resNumTests f x = (\r' -> x { numTests = r' }) <$> f (numTests x)++resLabels :: Lens' Result [(String,Int)]+resLabels f x = (\r' -> x { labels = r' }) <$> f (labels x)++resOutput :: Lens' Result String+resOutput f x = (\r' -> x { output = r' }) <$> f (output x)++resNumShrinks :: Lens' Failure Int+resNumShrinks = pairs . _1 . _2++resNumShrinkTries :: Lens' Failure Int+resNumShrinkTries = pairs . _1 . _3++resNumShrinkFinal :: Lens' Failure Int+resNumShrinkFinal = pairs . _1 . _4++resUsedSeed :: Lens' Failure QCGen+resUsedSeed = pairs . _1 . _5++resUsedSize :: Lens' Failure Int+resUsedSize = pairs . _2 . _1++resReason :: Lens' Failure String+resReason = pairs . _2 . _2++resTheException :: Lens' Failure (Maybe AnException)+resTheException = pairs . _2 . _3+
+ Test/QuickCheck/Report.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell #-}+module Test.QuickCheck.Report where++import Control.Arrow+import Control.Lens+import Control.Lens.Extras+import Control.Monad++import Data.Char+import Data.IORef+import Data.List as L++import Language.Haskell.TH+import Language.Haskell.TH.Syntax++import qualified System.IO as S++import Test.QuickCheck+import Test.QuickCheck.Lens++import Text.Printf.TH++data PropName = PropName String FilePath Int++propDesc :: PropName -> String+propDesc (PropName x filename l) = x ++ " from " ++ filename ++ ":" ++ show l++quickCheckWithResult' :: Testable prop+                      => Args +                      -> PropName+                      -> prop +                      -> IO (String,Result)+quickCheckWithResult' args name prop = do+        r <- quickCheckWithResult args { chatty = False } prop+        return ([s|=== %s ===\n%s\n|] (propDesc name) (output r),r)++quickCheckResult' :: Testable prop +                  => PropName +                  -> prop +                  -> IO (String,Result)+quickCheckResult' = quickCheckWithResult' stdArgs+++printQuickCheckResult :: Testable prop+                      => ((PropName -> prop -> IO (String,Result)) -> IO ([String],Bool))+                      -> IO ()+printQuickCheckResult = printQuickCheckWithResult stdArgs++printQuickCheckWithResult :: Testable prop+                          => Args+                          -> ((PropName -> prop -> IO (String,Result)) -> IO ([String],Bool))+                          -> IO ()+printQuickCheckWithResult args prop = prop (quickCheckWithResult' args) +                                  >>= _1 (mapM_ putStrLn) +                                  >>= _2 print+                                  >> return ()++quickCheckWrap :: Name -> ExpQ -- (PropName -> prop -> IO (a,Result)) -> IO ([a],Bool)+quickCheckWrap name = do+        loc <- location+        let name' = lift $ nameBase name+            fn    = lift $ loc_filename loc+            ln    = lift $ fst $ loc_start loc+            propName = [| PropName $name' $fn $ln |]+            prop  = monomorphic name+        [e| \check -> ((:[]) *** is _Success) <$> check $propName (property $prop) |]++forAllProperties' :: ExpQ -- :: (String -> Property -> IO (a,Result)) -> IO ([a],Bool)+forAllProperties' = do+  Loc { loc_filename = filename } <- location+  when (filename == "<interactive>") $ error "don't run this interactively"+  ls <- runIO (fmap lines (readUTF8File filename))+  let prefixes = L.map (takeWhile (\c -> isAlphaNum c || c == '_' || c == '\'') . dropWhile (\c -> isSpace c || c == '>')) ls+      idents = nubBy (\x y -> snd x == snd y) (L.filter (("prop_" `isPrefixOf`) . snd) (zip [1..] prefixes))+#if __GLASGOW_HASKELL__ > 705+      warning x = reportWarning ("Name " ++ x ++ " found in source file but was not in scope")+#else+      warning x = report False ("Name " ++ x ++ " found in source file but was not in scope")+#endif+      quickCheckOne :: (Int, String) -> Q [Exp]+      quickCheckOne (l, x) = do+        exists <- (warning x >> return False) `recover` (reify (mkName x) >> return True)+        if exists then sequence [ [| ( PropName x filename l+                                     , property $(monomorphic (mkName x))) |] ]+         else return []+  [| runQuickCheckAll' $(fmap (ListE . concat) (mapM quickCheckOne idents)) |]++readUTF8File :: FilePath -> IO String+readUTF8File name = S.openFile name S.ReadMode >>=+                    set_utf8_io_enc >>=+                    S.hGetContents++-- Deal with UTF-8 input and output.+set_utf8_io_enc :: S.Handle -> IO S.Handle+#if __GLASGOW_HASKELL__ > 611+-- possibly if MIN_VERSION_base(4,2,0)+set_utf8_io_enc h = do S.hSetEncoding h S.utf8; return h+#else+set_utf8_io_enc h = return h+#endif++runQuickCheckAll' :: [(PropName, Property)] +                  -> (PropName -> Property -> IO (a,Result)) +                  -> IO ([a],Bool)+runQuickCheckAll' ps qc = +  fmap (L.map fst &&& all snd) . forM ps $ \(xs, p) -> do+    qc xs p & mapped._2 %~ is _Success+    -- return $ (x,is _Success r)++test_report :: Testable a+            => ((a -> IO Result) -> IO b) -> IO Bool+test_report tests = do +    success <- newIORef (0 :: Int)+    total   <- newIORef (0 :: Int)+    let inc r = do+            when (is _Success r) +                $ modifyIORef success (+1)+            modifyIORef total (+1)+            return r+    (tests $ (>>= inc) . quickCheckWithResult stdArgs {chatty = False})+    x <- readIORef success+    y <- readIORef total+    putStr $ [s|success: %d / %d\n[ %s ]\n|]+        x y+        (if x == y then "passed" else "failed")+    return $ x == y
+ quickcheck-report.cabal view
@@ -0,0 +1,72 @@+-- Initial quickcheck-report.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                quickcheck-report++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            Customizable reports for quickcheck properties++-- A longer description of the package.+description:         Add some flexibility to the creation of reports from sets of quickcheck properties++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Simon Hudon++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          simon.hudon@gmail.com++-- A copyright notice.+-- copyright:           ++category:            Testing++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/literate-unitb/quickcheck-report++library+  -- Modules exported by the library.+  exposed-modules:     +      Test.QuickCheck.Lens+      Test.QuickCheck.Report+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    CPP, QuasiQuotes, TemplateHaskell+  +  -- Other library packages from which modules are imported.+  build-depends:       base >=4.8 && <5, lens >=4.12 && <4.15, template-haskell >=2.10 && <2.12, QuickCheck >=2.8 && <2.10, th-printf+  +  -- Directories containing source files.+  hs-source-dirs:      .+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+