d262cea · servant-quickcheck

.travis.yml+4−1

compare with master

unifiedsplit

@@ -41,6 +41,9 @@ matrix:

41 - compiler: "ghc-8.2.2"

42 # env: TEST=--disable-tests BENCH=--disable-benchmarks

43 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}

44+ - compiler: "ghc-8.4.1"

45+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

46+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

44

47

45before_install:

48before_install:

46 - HC=${CC}

49 - HC=${CC}

@@ -72,7 +75,7 @@ install:

72 - rm -f cabal.project.freeze

75 - rm -f cabal.project.freeze

73 - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

76 - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

74 - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

77 - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

75− - rm -rf "."/.ghc.environment.* "."/dist

78+ - rm -rf .ghc.environment.* "."/dist

76 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

79 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

77

80

78# Here starts the actual work to be performed for the package under test;

81# Here starts the actual work to be performed for the package under test;

CHANGELOG.yaml+13−2

@@ -1,7 +1,18 @@

1−upcoming:

2−

3releases:

1releases:

4

2

3+ - version: "0.0.7.0"

4+ changes:

5+

6+ - description: Support for GHC-8.4.1

7+ issue: none

8+ authors: phadej

9+ date: 2018-03-23

10+

11+ - description: Requires hspec-2.5

12+ issue: none

13+ authors: phadej

14+ date: 2018-03-23

15+

5 - version: "0.0.6.0"

16 - version: "0.0.6.0"

6 changes:

17 changes:

7

18

servant-quickcheck.cabal+10−5

@@ -1,5 +1,5 @@

1name: servant-quickcheck

2−version: 0.0.6.0

2+version: 0.0.7.0

3synopsis: QuickCheck entire APIs

4description:

5 This packages provides QuickCheck properties that are tested across an entire

@@ -17,7 +17,8 @@ extra-source-files:

17tested-with:

18 GHC==7.10.3,

19 GHC==8.0.2,

20− GHC==8.2.2

20+ GHC==8.2.2,

21+ GHC==8.4.1

21

22

22source-repository head

23source-repository head

23 type: git

24 type: git

@@ -35,14 +36,14 @@ library

35 , Servant.QuickCheck.Internal.QuickCheck

36 , Servant.QuickCheck.Internal.QuickCheck

36 , Servant.QuickCheck.Internal.Equality

37 , Servant.QuickCheck.Internal.Equality

37 , Servant.QuickCheck.Internal.ErrorTypes

38 , Servant.QuickCheck.Internal.ErrorTypes

38− build-depends: base >=4.8 && <4.11

39+ build-depends: base >=4.8 && <4.12

39 , base-compat == 0.9.*

40 , base-compat == 0.9.*

40 , aeson > 0.8 && < 2

41 , aeson > 0.8 && < 2

41 , bytestring == 0.10.*

42 , bytestring == 0.10.*

42 , case-insensitive == 1.2.*

43 , case-insensitive == 1.2.*

43 , clock >= 0.7 && < 0.8

44 , clock >= 0.7 && < 0.8

44 , data-default-class >= 0.0 && < 0.2

45 , data-default-class >= 0.0 && < 0.2

45− , hspec >= 2.2 && < 2.5

46+ , hspec >= 2.5 && < 2.6

46 , http-client >= 0.4.30 && < 0.6

47 , http-client >= 0.4.30 && < 0.6

47 , http-media >= 0.6 && <0.8

48 , http-media >= 0.6 && <0.8

48 , http-types > 0.8 && < 0.13

49 , http-types > 0.8 && < 0.13

@@ -60,6 +61,10 @@ library

60 , time >= 1.5 && < 1.9

61 , time >= 1.5 && < 1.9

61 , warp >= 3.2.4 && < 3.3

62 , warp >= 3.2.4 && < 3.3

62

63

64+ if !impl(ghc >= 8.0)

65+ build-depends:

66+ semigroups >= 0.18.3 && <0.19

67+

63 hs-source-dirs: src

68 hs-source-dirs: src

64 default-extensions: TypeOperators

69 default-extensions: TypeOperators

65 , FlexibleInstances

70 , FlexibleInstances

@@ -87,7 +92,7 @@ test-suite spec

87 main-is: Spec.hs

92 main-is: Spec.hs

88 other-modules: Servant.QuickCheck.InternalSpec

93 other-modules: Servant.QuickCheck.InternalSpec

89 build-tool-depends: hspec-discover:hspec-discover

94 build-tool-depends: hspec-discover:hspec-discover

90− build-depends: base == 4.*

95+ build-depends: base

91 , base-compat

96 , base-compat

92 , aeson

97 , aeson

93 , servant-quickcheck

98 , servant-quickcheck

src/Servant/QuickCheck/Internal/Equality.hs+6−2

@@ -5,15 +5,19 @@ import Data.ByteString (ByteString)

5import qualified Data.ByteString.Lazy as LB

6import Data.Function (on)

7import Network.HTTP.Client (Response, responseBody)

8+import Data.Semigroup (Semigroup (..))

8import Prelude.Compat

9import Prelude.Compat

9

10

10newtype ResponseEquality b

11newtype ResponseEquality b

11 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }

12 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }

12

13

14+instance Semigroup (ResponseEquality b) where

15+ ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->

16+ a x y && b x y

17+

13instance Monoid (ResponseEquality b) where

18instance Monoid (ResponseEquality b) where

14 mempty = ResponseEquality $ \_ _ -> True

19 mempty = ResponseEquality $ \_ _ -> True

15− ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->

20+ mappend = (<>)

16− a x y && b x y

17

21

18-- | Use `Eq` instance for `Response`

22-- | Use `Eq` instance for `Response`

19--

23--

src/Servant/QuickCheck/Internal/ErrorTypes.hs+7−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1module Servant.QuickCheck.Internal.ErrorTypes where

2module Servant.QuickCheck.Internal.ErrorTypes where

2

3

3import Control.Exception (Exception (..))

4import Control.Exception (Exception (..))

@@ -8,9 +9,14 @@ import Data.Typeable (Typeable)

8import GHC.Generics (Generic)

9import GHC.Generics (Generic)

9import qualified Network.HTTP.Client as C

10import qualified Network.HTTP.Client as C

10import Network.HTTP.Types (Header, statusCode)

11import Network.HTTP.Types (Header, statusCode)

11−import Prelude.Compat

12import Text.PrettyPrint

13

14+#if MIN_VERSION_base(4,11,0)

15+import Prelude.Compat hiding ((<>))

16+#else

17+import Prelude.Compat

18+#endif

19+

14data PredicateFailure

20data PredicateFailure

15 = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)

21 = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)

16 deriving (Typeable, Generic)

22 deriving (Typeable, Generic)

src/Servant/QuickCheck/Internal/Predicates.hs+15−5

@@ -11,7 +11,7 @@ import Data.CaseInsensitive (foldCase, foldedCase, mk)

11import Data.Either (isRight)

12import Data.List.Split (wordsBy)

13import Data.Maybe (fromMaybe, isJust)

14−import Data.Monoid ((<>))

14+import Data.Semigroup (Semigroup (..))

15import qualified Data.Text as T

16import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,

17 rfc822DateFormat)

@@ -377,9 +377,12 @@ newtype ResponsePredicate = ResponsePredicate

377 { getResponsePredicate :: Response LBS.ByteString -> IO ()

378 } deriving (Generic)

379

380+instance Semigroup ResponsePredicate where

381+ ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x

382+

380instance Monoid ResponsePredicate where

383instance Monoid ResponsePredicate where

381 mempty = ResponsePredicate $ const $ return ()

384 mempty = ResponsePredicate $ const $ return ()

382− ResponsePredicate a `mappend` ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x

385+ mappend = (<>)

383

386

384-- | A predicate that depends on both the request and the response.

387-- | A predicate that depends on both the request and the response.

385--

388--

@@ -391,7 +394,11 @@ newtype RequestPredicate = RequestPredicate

391-- TODO: This isn't actually a monoid

394-- TODO: This isn't actually a monoid

392instance Monoid RequestPredicate where

395instance Monoid RequestPredicate where

393 mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))

396 mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))

397+ mappend = (<>)

398+

399+-- TODO: This isn't actually a monoid

400+instance Semigroup RequestPredicate where

394− RequestPredicate a `mappend` RequestPredicate b = RequestPredicate $ \r mgr ->

401+ RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->

395 liftM2 (<>) (a r mgr) (b r mgr)

402 liftM2 (<>) (a r mgr) (b r mgr)

396

403

397-- | A set of predicates. Construct one with 'mempty' and '<%>'.

404-- | A set of predicates. Construct one with 'mempty' and '<%>'.

@@ -400,10 +407,13 @@ data Predicates = Predicates

400 , responsePredicates :: ResponsePredicate

407 , responsePredicates :: ResponsePredicate

401 } deriving (Generic)

408 } deriving (Generic)

402

409

410+instance Semigroup Predicates where

411+ a <> b = Predicates (requestPredicates a <> requestPredicates b)

412+ (responsePredicates a <> responsePredicates b)

413+

403instance Monoid Predicates where

414instance Monoid Predicates where

404 mempty = Predicates mempty mempty

415 mempty = Predicates mempty mempty

405− a `mappend` b = Predicates (requestPredicates a <> requestPredicates b)

416+ mappend = (<>)

406− (responsePredicates a <> responsePredicates b)

407

417

408class JoinPreds a where

418class JoinPreds a where

409 joinPreds :: a -> Predicates -> Predicates

419 joinPreds :: a -> Predicates -> Predicates

test/Servant/QuickCheck/InternalSpec.hs+6−26

@@ -17,8 +17,8 @@ import qualified Text.Blaze.Html as Blaze

17import qualified Text.Blaze.Html5 as Blaze5

18import Test.Hspec (Spec, context, describe, it, shouldBe,

19 shouldContain)

20−import Test.Hspec.Core.Spec (Arg, Example, Result (..),

20+import Test.Hspec.Core.Spec (Arg, Example, Result (..), ResultStatus (..),

21− defaultParams)

21+ defaultParams, safeEvaluateExample)

22import Test.QuickCheck.Gen (generate, unGen)

23import Test.QuickCheck.Random (mkQCGen)

24

@@ -30,13 +30,6 @@ import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,

30 comprehensiveAPI)

31#endif

32

33−#if MIN_VERSION_hspec(2,4,0)

34−import Test.Hspec.Core.Spec (safeEvaluateExample)

35−#else

36−import Control.Exception (try)

37−import Test.Hspec.Core.Spec (evaluateExample)

38−#endif

39−

40import Servant.QuickCheck

33import Servant.QuickCheck

41import Servant.QuickCheck.Internal (genRequest, runGenRequest,

34import Servant.QuickCheck.Internal (genRequest, runGenRequest,

42 serverDoesntSatisfy)

35 serverDoesntSatisfy)

@@ -349,27 +342,14 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext

349-- Utils

342-- Utils

350------------------------------------------------------------------------------

343------------------------------------------------------------------------------

351evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult

344evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult

352−#if MIN_VERSION_hspec(2,4,0)

353evalExample e = do

345evalExample e = do

354 r <- safeEvaluateExample e defaultParams ($ ()) progCallback

346 r <- safeEvaluateExample e defaultParams ($ ()) progCallback

355− case r of

347+ case resultStatus r of

356− Left err -> return $ AnException err

357− Right Success -> return $ AllGood

348+ Success -> return $ AllGood

358− Right (Failure _ reason) -> return $ FailedWith $ show reason

349+ Failure _ reason -> return $ FailedWith $ show reason

359− Right (Pending _) -> error "should not happen"

360− where

361− progCallback _ = return ()

362−#else

363−evalExample e = do

364− r <- try $ evaluateExample e defaultParams ($ ()) progCallback

365− case r of

366− Left err -> return $ AnException err

367− Right Success -> return $ AllGood

368− Right (Fail _ reason) -> return $ FailedWith reason

369− Right (Pending _) -> error "should not happen"

350+ Pending {} -> error "should not happen"

370 where

351 where

371 progCallback _ = return ()

352 progCallback _ = return ()

372−#endif

373

353

374data EvalResult

354data EvalResult

375 = AnException SomeException

355 = AnException SomeException