4757df4 · servant-quickcheck

git.iko.soy/servant-quickcheck

Support GHC-8.4.1

commit4757df4195a4292aaa612d59d7a842423557e360 authorOleg Grenrus <oleg.grenrus@iki.fi> dateThu 22 Mar 2018, 13:56 (9 years ago) parent76a0394

7 files changed+61−42

compare with master

unifiedsplit

.travis.yml+4−1 CHANGELOG.yaml+13−2 servant-quickcheck.cabal+10−5 src/Servant/QuickCheck/Internal/Equality.hs+6−2 src/Servant/QuickCheck/Internal/ErrorTypes.hs+7−1 src/Servant/QuickCheck/Internal/Predicates.hs+15−5 test/Servant/QuickCheck/InternalSpec.hs+6−26

.travis.yml+4−1

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

4141 - compiler: "ghc-8.2.2"

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

4343 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]}}

4447

4548before_install:

4649 - HC=${CC}

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

7275 - rm -f cabal.project.freeze

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

7477 - 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

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

7780

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

CHANGELOG.yaml+13−2

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

1−upcoming:

2−

31releases:

3+ - version: "0.0.7.0"

4+ changes:

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+

516 - version: "0.0.6.0"

617 changes:

718

servant-quickcheck.cabal+10−5

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

11name: servant-quickcheck

2−version: 0.0.6.0

2+version: 0.0.7.0

33synopsis: QuickCheck entire APIs

44description:

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

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

1717tested-with:

1818 GHC==7.10.3,

1919 GHC==8.0.2,

20− GHC==8.2.2

20+ GHC==8.2.2,

21+ GHC==8.4.1

2122

2223source-repository head

2324 type: git

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

3536 , Servant.QuickCheck.Internal.QuickCheck

3637 , Servant.QuickCheck.Internal.Equality

3738 , Servant.QuickCheck.Internal.ErrorTypes

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

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

3940 , base-compat == 0.9.*

4041 , aeson > 0.8 && < 2

4142 , bytestring == 0.10.*

4243 , case-insensitive == 1.2.*

4344 , clock >= 0.7 && < 0.8

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

45− , hspec >= 2.2 && < 2.5

46+ , hspec >= 2.5 && < 2.6

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

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

4849 , http-types > 0.8 && < 0.13

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

6061 , time >= 1.5 && < 1.9

6162 , warp >= 3.2.4 && < 3.3

6263

64+ if !impl(ghc >= 8.0)

65+ build-depends:

66+ semigroups >= 0.18.3 && <0.19

67+

6368 hs-source-dirs: src

6469 default-extensions: TypeOperators

6570 , FlexibleInstances

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

8792 main-is: Spec.hs

8893 other-modules: Servant.QuickCheck.InternalSpec

8994 build-tool-depends: hspec-discover:hspec-discover

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

95+ build-depends: base

9196 , base-compat

9297 , aeson

9398 , servant-quickcheck

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

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

55import qualified Data.ByteString.Lazy as LB

66import Data.Function (on)

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

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

89import Prelude.Compat

910

1011newtype ResponseEquality b

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

1213

14+instance Semigroup (ResponseEquality b) where

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

16+ a x y && b x y

17+

1318instance Monoid (ResponseEquality b) where

1419 mempty = ResponseEquality $ \_ _ -> True

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

16− a x y && b x y

20+ mappend = (<>)

1721

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

1923--

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

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

1+{-# LANGUAGE CPP #-}

12module Servant.QuickCheck.Internal.ErrorTypes where

34import Control.Exception (Exception (..))

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

89import GHC.Generics (Generic)

910import qualified Network.HTTP.Client as C

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

11−import Prelude.Compat

1212import Text.PrettyPrint

1313

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

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

16+#else

17+import Prelude.Compat

18+#endif

19+

1420data PredicateFailure

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

1622 deriving (Typeable, Generic)

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

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

1111import Data.Either (isRight)

1212import Data.List.Split (wordsBy)

1313import Data.Maybe (fromMaybe, isJust)

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

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

1515import qualified Data.Text as T

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

1717 rfc822DateFormat)

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

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

378378 } deriving (Generic)

379379

380+instance Semigroup ResponsePredicate where

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

382+

380383instance Monoid ResponsePredicate where

381384 mempty = ResponsePredicate $ const $ return ()

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

385+ mappend = (<>)

383386

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

385388--

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

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

392395instance Monoid RequestPredicate where

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

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

397+ mappend = (<>)

398+

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

400+instance Semigroup RequestPredicate where

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

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

396403

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

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

400407 , responsePredicates :: ResponsePredicate

401408 } deriving (Generic)

402409

410+instance Semigroup Predicates where

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

412+ (responsePredicates a <> responsePredicates b)

413+

403414instance Monoid Predicates where

404415 mempty = Predicates mempty mempty

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

406− (responsePredicates a <> responsePredicates b)

416+ mappend = (<>)

407417

408418class JoinPreds a where

409419 joinPreds :: a -> Predicates -> Predicates

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

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

1717import qualified Text.Blaze.Html5 as Blaze5

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

1919 shouldContain)

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

21− defaultParams)

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

21+ defaultParams, safeEvaluateExample)

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

2323import Test.QuickCheck.Random (mkQCGen)

2424

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

3030 comprehensiveAPI)

3131#endif

3232

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−

4033import Servant.QuickCheck

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

4235 serverDoesntSatisfy)

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

349342-- Utils

350343------------------------------------------------------------------------------

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

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

353345evalExample e = do

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

355− case r of

356− Left err -> return $ AnException err

357− Right Success -> return $ AllGood

358− Right (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"

347+ case resultStatus r of

348+ Success -> return $ AllGood

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

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

370351 where

371352 progCallback _ = return ()

372−#endif

373353

374354data EvalResult

375355 = AnException SomeException