hspec-smallcheck-0.5.2/0000755000000000000000000000000013256404152013114 5ustar0000000000000000hspec-smallcheck-0.5.2/LICENSE0000644000000000000000000000206713256404152014126 0ustar0000000000000000Copyright (c) 2013-2018 Simon Hengel 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. hspec-smallcheck-0.5.2/hspec-smallcheck.cabal0000644000000000000000000000402713256404152017311 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- -- hash: 8fef08d4c8338bfb32b5436d390cd7aa3453e20b39652a3a405efff6e4a0ffcc name: hspec-smallcheck version: 0.5.2 license: MIT license-file: LICENSE copyright: (c) 2013-2018 Simon Hengel maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.10 category: Testing bug-reports: https://github.com/hspec/hspec-smallcheck/issues homepage: http://hspec.github.io/ synopsis: SmallCheck support for the Hspec testing framework description: SmallCheck support for the Hspec testing framework source-repository head type: git location: https://github.com/hspec/hspec-smallcheck library 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: HUnit , base >=4.5.0.0 && <5 , call-stack , hspec-core >=2.5.0 , smallcheck >=1.1 default-language: Haskell2010 test-suite example type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Paths_hspec_smallcheck hs-source-dirs: example ghc-options: -Wall build-depends: HUnit , base >=4.5.0.0 && <5 , call-stack , hspec , hspec-core >=2.5.0 , 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 , base-orphans , call-stack , hspec , hspec-core >=2.5.0 , smallcheck >=1.1 default-language: Haskell2010 hspec-smallcheck-0.5.2/Setup.lhs0000644000000000000000000000011413256404152014720 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain hspec-smallcheck-0.5.2/test/0000755000000000000000000000000013256404152014073 5ustar0000000000000000hspec-smallcheck-0.5.2/test/Spec.hs0000644000000000000000000000005413256404152015320 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hspec-smallcheck-0.5.2/test/Test/0000755000000000000000000000000013256404152015012 5ustar0000000000000000hspec-smallcheck-0.5.2/test/Test/Hspec/0000755000000000000000000000000013256404152016054 5ustar0000000000000000hspec-smallcheck-0.5.2/test/Test/Hspec/SmallCheckSpec.hs0000644000000000000000000000504513256404152021235 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.SmallCheckSpec (main, spec) where import Test.Hspec import Data.Orphans () import qualified Control.Exception as E 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 exceptionEq :: E.SomeException -> E.SomeException -> Bool exceptionEq a b | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ErrorCall) | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ArithException) | otherwise = undefined deriving instance Eq H.FailureReason deriving instance Eq H.ResultStatus deriving instance Eq H.Result instance Eq E.SomeException where (==) = exceptionEq spec :: Spec spec = do describe "evaluateExample" $ do context "with Property IO" $ do it "returns Success if property holds" $ do eval True `shouldReturn` H.Result "" H.Success it "returns Failure if property does not hold" $ do eval False `shouldReturn` H.Result "" (H.Failure Nothing (H.Reason "condition is false")) it "shows what falsified it" $ do eval (/= (2 :: Int)) `shouldReturn` H.Result "" (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.Result "" (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.Result "" (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) hspec-smallcheck-0.5.2/test/Test/Hspec/SmallCheck/0000755000000000000000000000000013256404152020062 5ustar0000000000000000hspec-smallcheck-0.5.2/test/Test/Hspec/SmallCheck/TypesSpec.hs0000644000000000000000000000231513256404152022336 0ustar0000000000000000module 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" hspec-smallcheck-0.5.2/example/0000755000000000000000000000000013256404152014547 5ustar0000000000000000hspec-smallcheck-0.5.2/example/Spec.hs0000644000000000000000000000056213256404152016000 0ustar0000000000000000module 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]) hspec-smallcheck-0.5.2/src/0000755000000000000000000000000013256404152013703 5ustar0000000000000000hspec-smallcheck-0.5.2/src/Test/0000755000000000000000000000000013256404152014622 5ustar0000000000000000hspec-smallcheck-0.5.2/src/Test/Hspec/0000755000000000000000000000000013256404152015664 5ustar0000000000000000hspec-smallcheck-0.5.2/src/Test/Hspec/SmallCheck.hs0000644000000000000000000000414113256404152020226 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.SmallCheck (property) where 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 } 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 counter <- newIORef 0 let hook _ = do modifyIORef counter succ n <- readIORef counter reportProgress (n, 0) r <- smallCheckWithHook (paramsSmallCheckDepth c) hook p return . Result "" $ 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 hspec-smallcheck-0.5.2/src/Test/Hspec/SmallCheck/0000755000000000000000000000000013256404152017672 5ustar0000000000000000hspec-smallcheck-0.5.2/src/Test/Hspec/SmallCheck/Compat.hs0000644000000000000000000000171413256404152021454 0ustar0000000000000000{-# 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 hspec-smallcheck-0.5.2/src/Test/Hspec/SmallCheck/Types.hs0000644000000000000000000000131213256404152021327 0ustar0000000000000000module 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)