hspec-smallcheck 0.4.2 → 0.5.0

raw patch · 8 files changed

+268/−26 lines, 8 filesdep +HUnitdep +call-stackdep ~basedep ~hspec-coredep ~smallcheckPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, call-stack

Dependency ranges changed: base, hspec-core, smallcheck

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• example/Spec.hs +16/−0
• hspec-smallcheck.cabal +56/−20
• src/Test/Hspec/SmallCheck.hs +42/−5
• src/Test/Hspec/SmallCheck/Compat.hs +35/−0
• src/Test/Hspec/SmallCheck/Types.hs +26/−0
• test/Test/Hspec/SmallCheck/TypesSpec.hs +41/−0
• test/Test/Hspec/SmallCheckSpec.hs +51/−0

@@ -1,4 +1,4 @@-Copyright (c) 2013-2015 Simon Hengel <sol@typeful.net>+Copyright (c) 2013-2018 Simon Hengel <sol@typeful.net>  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -0,0 +1,16 @@+module Main (main, spec) where++import Test.Hspec+import Test.Hspec.SmallCheck++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "reverse" $ do+    it "reverses a list" $ do+      reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1]++    it "gives the original list, if applied twice" $ property $+      \xs -> (reverse . reverse) xs `shouldBe` (xs :: [Int])

@@ -1,11 +1,17 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 9cd99f0806cf8dfefb5b2761767e11bcc64bbb719b6d31200201b36702038392+ name:             hspec-smallcheck-version:          0.4.2+version:          0.5.0 license:          MIT license-file:     LICENSE-copyright:        (c) 2013-2015 Simon Hengel+copyright:        (c) 2013-2018 Simon Hengel maintainer:       Simon Hengel <sol@typeful.net> build-type:       Simple-cabal-version:    >= 1.8+cabal-version:    >= 1.10 category:         Testing bug-reports:      https://github.com/hspec/hspec-smallcheck/issues homepage:         http://hspec.github.io/@@ -17,31 +23,61 @@   location: https://github.com/hspec/hspec-smallcheck  library-  ghc-options:-      -Wall+  ghc-options: -Wall   hs-source-dirs:       src   exposed-modules:       Test.Hspec.SmallCheck+  other-modules:+      Test.Hspec.SmallCheck.Compat+      Test.Hspec.SmallCheck.Types+      Paths_hspec_smallcheck   build-depends:-      base == 4.*-    , hspec-core >= 2.4-    , smallcheck >= 1.0+      HUnit+    , base >=4.5.0.0 && <5+    , call-stack+    , hspec-core ==2.4.*+    , smallcheck >=1.1+  default-language: Haskell2010 -test-suite spec-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall+test-suite example+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hspec_smallcheck   hs-source-dirs:-      test-  main-is:-      Spec.hs+      example+  ghc-options: -Wall   build-depends:-      base              == 4.*+      HUnit+    , base >=4.5.0.0 && <5+    , call-stack     , hspec-    , hspec-core-    , smallcheck-+    , hspec-core ==2.4.*     , hspec-smallcheck+    , smallcheck >=1.1+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  ghc-options: -Wall+  hs-source-dirs:+      src+      test+  main-is: Spec.hs+  other-modules:+      Test.Hspec.SmallCheck+      Test.Hspec.SmallCheck.Compat+      Test.Hspec.SmallCheck.Types+      Test.Hspec.SmallCheck.TypesSpec+      Test.Hspec.SmallCheckSpec+      Paths_hspec_smallcheck+  build-depends:+      HUnit     , QuickCheck+    , base >=4.5.0.0 && <5+    , call-stack+    , hspec+    , hspec-core ==2.4.*+    , smallcheck >=1.1+  default-language: Haskell2010

@@ -1,18 +1,48 @@-{-# LANGUAGE TypeFamilies, FlexibleInstances, FlexibleContexts, CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.SmallCheck (property) where -#if !MIN_VERSION_base(4,8,0)-import           Control.Applicative-#endif+import           Prelude ()+import           Test.Hspec.SmallCheck.Compat+ import           Data.IORef import           Test.Hspec.Core.Spec import           Test.SmallCheck import           Test.SmallCheck.Drivers+import qualified Test.HUnit.Lang as HUnit+import           Control.Exception (try)+import           Data.Maybe+import           Data.CallStack +import qualified Test.Hspec.SmallCheck.Types as T+ property :: Testable IO a => a -> Property IO property = test +srcLocToLocation :: SrcLoc -> Location+srcLocToLocation loc = Location {+  locationFile = srcLocFile loc+, locationLine = srcLocStartLine loc+, locationColumn = srcLocStartCol loc+, locationAccuracy = ExactLocation+}++instance Testable IO (IO ()) where+  test action = monadic $ do+    r <- try action+    return $ case r of+      Right () -> test True+      Left e -> case e of+        HUnit.HUnitFailure loc reason -> test . failure $ case reason of+          HUnit.Reason s -> T.Reason s+          HUnit.ExpectedButGot prefix expected actual -> T.ExpectedActual (fromMaybe "" prefix) expected actual+          where+            failure :: T.Reason -> Either String String+            failure = Left . show . T.Failure (srcLocToLocation <$> loc)+ instance Example (Property IO) where   type Arg (Property IO) = ()   evaluateExample p c _ reportProgress = do@@ -21,4 +51,11 @@           modifyIORef counter succ           n <- readIORef counter           reportProgress (n, 0)-    maybe Success (Failure Nothing . Reason . ppFailure) <$> smallCheckWithHook (paramsSmallCheckDepth c) hook p+    r <- smallCheckWithHook (paramsSmallCheckDepth c) hook p+    return $ case r of+      Just e -> case T.parseResult (ppFailure e) of+        (m, Just (T.Failure loc reason)) -> Failure loc $ case reason of+          T.Reason err -> Reason (fromMaybe "" $ T.concatPrefix m err)+          T.ExpectedActual prefix expected actual -> ExpectedButGot (T.concatPrefix m prefix) expected actual+        (m, Nothing) -> Failure Nothing (Reason m)+      Nothing -> Success

@@ -0,0 +1,35 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.SmallCheck.Compat (+  module Prelude+, module Control.Applicative+, readMaybe+) where++import           Text.Read+import           Control.Applicative++#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+-- A 'Left' value indicates a parse error.+readEither :: Read a => String -> Either String a+readEither s =+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+    [x] -> Right x+    []  -> Left "Prelude.read: no parse"+    _   -> Left "Prelude.read: ambiguous parse"+ where+  read' =+    do x <- readPrec+       lift P.skipSpaces+       return x++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case readEither s of+                Left _  -> Nothing+                Right a -> Just a+#endif

@@ -0,0 +1,26 @@+module Test.Hspec.SmallCheck.Types where++import           Prelude ()+import           Test.Hspec.SmallCheck.Compat++import           Data.List+import           Test.Hspec.Core.Spec (Location(..))+++data Result = Failure (Maybe Location) Reason+  deriving (Eq, Show, Read)++data Reason =+    Reason String+  | ExpectedActual String String String+  deriving (Eq, Show, Read)++parseResult :: String -> (String, Maybe Result)+parseResult xs =  case [(x, Just y) | (x, Just y) <- zip (inits xs) (map readMaybe $ tails xs)] of+  r : _ -> r+  [] -> (xs, Nothing)++concatPrefix :: String -> String -> Maybe String+concatPrefix a b = case filter (not . null) $ [a, b] of+  [] -> Nothing+  xs -> Just (intercalate "\n" xs)

@@ -0,0 +1,41 @@+module Test.Hspec.SmallCheck.TypesSpec (spec) where++import           Test.Hspec++import           Test.Hspec.SmallCheck.Types++spec :: Spec+spec = do+  describe "parseResult" $ do+    let r = Failure Nothing (ExpectedActual "" "23" "42")+    it "parses result" $ do+      parseResult (show r) `shouldBe` ("", Just r)++    context "with prefix" $ do+      it "includes prefix" $ do+        let+          prefix = "some prefix"+          input = prefix ++ show r+        parseResult input `shouldBe` (prefix, Just r)++    context "on parse error" $ do+      it "returns input verbatim" $ do+        let input = init (show r)+        parseResult input `shouldBe` (input, Nothing)++  describe "concatPrefix" $ do+    context "when given two empty strings" $ do+      it "returns Nothing" $ do+        concatPrefix "" "" `shouldBe` Nothing++    context "with first string empty" $ do+      it "returns second" $ do+        concatPrefix "foo" "" `shouldBe` Just "foo"++    context "with second string empty" $ do+      it "returns first" $ do+        concatPrefix "" "foo" `shouldBe` Just "foo"++    context "with two strings" $ do+      it "concatenates with newline" $ do+        concatPrefix "foo" "bar" `shouldBe` Just "foo\nbar"

@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+module Test.Hspec.SmallCheckSpec (main, spec) where++import           Test.Hspec++import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Runner as H+import           Test.SmallCheck+import           Test.QuickCheck (stdArgs)+import           Test.HUnit (Assertion, assertFailure, assertEqual)++import           Test.Hspec.SmallCheck++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "evaluateExample" $ do+    context "with Property IO" $ do+      it "returns Success if property holds" $ do+        eval True `shouldReturn` H.Success++      it "returns Failure if property does not hold" $ do+        eval False `shouldReturn` H.Failure Nothing (H.Reason "condition is false")++      it "shows what falsified it" $ do+        eval (/= (2 :: Int)) `shouldReturn` H.Failure Nothing (H.Reason "there exists 2 such that\n  condition is false")++      it "propagates exceptions" $ do+        eval (error "foobar" :: Property IO) `shouldThrow` errorCall "foobar"++      context "with HUnit Assertion" $ do+        it "includes failure reason" $ do+          H.Failure _loc reason <- eval ((\ _ -> assertFailure "some failure") :: Int -> Assertion)+          reason `shouldBe` H.Reason "there exists 0 such that\nsome failure"++        context "with assertEqual" $ do+          it "includes actual and expected" $ do+            H.Failure _loc reason <- eval (assertEqual "foo" (42 :: Int))+            reason `shouldBe` H.ExpectedButGot (Just "there exists 0 such that\nfoo") "42" "0"+  where+    eval :: Testable IO a => a -> IO H.Result+    eval = evaluateExample . property++    evaluateExample :: (Example a, Arg a ~ ()) => a -> IO H.Result+    evaluateExample e = H.evaluateExample e defaultParams ($ ()) (const $ return ())++    defaultParams :: H.Params+    defaultParams = H.Params stdArgs (H.configSmallCheckDepth H.defaultConfig)