mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-11-22 05:42:11 +03:00
Merge pull request #43 from haskell-servant/ghc-8.4.1
Support GHC-8.4.1
This commit is contained in:
Oleg Grenrus
GitHub
commit
d262cead57
@ -41,6 +41,9 @@ matrix:
|
||||
- compiler: "ghc-8.2.2"
|
||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
|
||||
- compiler: "ghc-8.4.1"
|
||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}
|
||||
|
||||
before_install:
|
||||
- HC=${CC}
|
||||
@ -72,7 +75,7 @@ install:
|
||||
- rm -f cabal.project.freeze
|
||||
- cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
|
||||
- cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
|
||||
- rm -rf "."/.ghc.environment.* "."/dist
|
||||
- rm -rf .ghc.environment.* "."/dist
|
||||
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||
|
||||
# Here starts the actual work to be performed for the package under test;
|
||||
|
||||
@ -1,7 +1,18 @@
|
||||
upcoming:
|
||||
|
||||
releases:
|
||||
|
||||
- version: "0.0.7.0"
|
||||
changes:
|
||||
|
||||
- description: Support for GHC-8.4.1
|
||||
issue: none
|
||||
authors: phadej
|
||||
date: 2018-03-23
|
||||
|
||||
- description: Requires hspec-2.5
|
||||
issue: none
|
||||
authors: phadej
|
||||
date: 2018-03-23
|
||||
|
||||
- version: "0.0.6.0"
|
||||
changes:
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: servant-quickcheck
|
||||
version: 0.0.6.0
|
||||
version: 0.0.7.0
|
||||
synopsis: QuickCheck entire APIs
|
||||
description:
|
||||
This packages provides QuickCheck properties that are tested across an entire
|
||||
@ -17,7 +17,8 @@ extra-source-files:
|
||||
tested-with:
|
||||
GHC==7.10.3,
|
||||
GHC==8.0.2,
|
||||
GHC==8.2.2
|
||||
GHC==8.2.2,
|
||||
GHC==8.4.1
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -35,14 +36,14 @@ library
|
||||
, Servant.QuickCheck.Internal.QuickCheck
|
||||
, Servant.QuickCheck.Internal.Equality
|
||||
, Servant.QuickCheck.Internal.ErrorTypes
|
||||
build-depends: base >=4.8 && <4.11
|
||||
build-depends: base >=4.8 && <4.12
|
||||
, base-compat == 0.9.*
|
||||
, aeson > 0.8 && < 2
|
||||
, bytestring == 0.10.*
|
||||
, case-insensitive == 1.2.*
|
||||
, clock >= 0.7 && < 0.8
|
||||
, data-default-class >= 0.0 && < 0.2
|
||||
, hspec >= 2.2 && < 2.5
|
||||
, hspec >= 2.5 && < 2.6
|
||||
, http-client >= 0.4.30 && < 0.6
|
||||
, http-media >= 0.6 && <0.8
|
||||
, http-types > 0.8 && < 0.13
|
||||
@ -60,6 +61,10 @@ library
|
||||
, time >= 1.5 && < 1.9
|
||||
, warp >= 3.2.4 && < 3.3
|
||||
|
||||
if !impl(ghc >= 8.0)
|
||||
build-depends:
|
||||
semigroups >= 0.18.3 && <0.19
|
||||
|
||||
hs-source-dirs: src
|
||||
default-extensions: TypeOperators
|
||||
, FlexibleInstances
|
||||
@ -87,7 +92,7 @@ test-suite spec
|
||||
main-is: Spec.hs
|
||||
other-modules: Servant.QuickCheck.InternalSpec
|
||||
build-tool-depends: hspec-discover:hspec-discover
|
||||
build-depends: base == 4.*
|
||||
build-depends: base
|
||||
, base-compat
|
||||
, aeson
|
||||
, servant-quickcheck
|
||||
|
||||
@ -5,15 +5,19 @@ import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Function (on)
|
||||
import Network.HTTP.Client (Response, responseBody)
|
||||
import Data.Semigroup (Semigroup (..))
|
||||
import Prelude.Compat
|
||||
|
||||
newtype ResponseEquality b
|
||||
= ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
|
||||
|
||||
instance Semigroup (ResponseEquality b) where
|
||||
ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
|
||||
a x y && b x y
|
||||
|
||||
instance Monoid (ResponseEquality b) where
|
||||
mempty = ResponseEquality $ \_ _ -> True
|
||||
ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
|
||||
a x y && b x y
|
||||
mappend = (<>)
|
||||
|
||||
-- | Use `Eq` instance for `Response`
|
||||
--
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Servant.QuickCheck.Internal.ErrorTypes where
|
||||
|
||||
import Control.Exception (Exception (..))
|
||||
@ -8,9 +9,14 @@ import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Network.HTTP.Client as C
|
||||
import Network.HTTP.Types (Header, statusCode)
|
||||
import Prelude.Compat
|
||||
import Text.PrettyPrint
|
||||
|
||||
#if MIN_VERSION_base(4,11,0)
|
||||
import Prelude.Compat hiding ((<>))
|
||||
#else
|
||||
import Prelude.Compat
|
||||
#endif
|
||||
|
||||
data PredicateFailure
|
||||
= PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
|
||||
deriving (Typeable, Generic)
|
||||
|
||||
@ -11,7 +11,7 @@ import Data.CaseInsensitive (foldCase, foldedCase, mk)
|
||||
import Data.Either (isRight)
|
||||
import Data.List.Split (wordsBy)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Semigroup (Semigroup (..))
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
|
||||
rfc822DateFormat)
|
||||
@ -377,9 +377,12 @@ newtype ResponsePredicate = ResponsePredicate
|
||||
{ getResponsePredicate :: Response LBS.ByteString -> IO ()
|
||||
} deriving (Generic)
|
||||
|
||||
instance Semigroup ResponsePredicate where
|
||||
ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
|
||||
|
||||
instance Monoid ResponsePredicate where
|
||||
mempty = ResponsePredicate $ const $ return ()
|
||||
ResponsePredicate a `mappend` ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
|
||||
mappend = (<>)
|
||||
|
||||
-- | A predicate that depends on both the request and the response.
|
||||
--
|
||||
@ -391,7 +394,11 @@ newtype RequestPredicate = RequestPredicate
|
||||
-- TODO: This isn't actually a monoid
|
||||
instance Monoid RequestPredicate where
|
||||
mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
|
||||
RequestPredicate a `mappend` RequestPredicate b = RequestPredicate $ \r mgr ->
|
||||
mappend = (<>)
|
||||
|
||||
-- TODO: This isn't actually a monoid
|
||||
instance Semigroup RequestPredicate where
|
||||
RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->
|
||||
liftM2 (<>) (a r mgr) (b r mgr)
|
||||
|
||||
-- | A set of predicates. Construct one with 'mempty' and '<%>'.
|
||||
@ -400,10 +407,13 @@ data Predicates = Predicates
|
||||
, responsePredicates :: ResponsePredicate
|
||||
} deriving (Generic)
|
||||
|
||||
instance Semigroup Predicates where
|
||||
a <> b = Predicates (requestPredicates a <> requestPredicates b)
|
||||
(responsePredicates a <> responsePredicates b)
|
||||
|
||||
instance Monoid Predicates where
|
||||
mempty = Predicates mempty mempty
|
||||
a `mappend` b = Predicates (requestPredicates a <> requestPredicates b)
|
||||
(responsePredicates a <> responsePredicates b)
|
||||
mappend = (<>)
|
||||
|
||||
class JoinPreds a where
|
||||
joinPreds :: a -> Predicates -> Predicates
|
||||
|
||||
@ -17,8 +17,8 @@ import qualified Text.Blaze.Html as Blaze
|
||||
import qualified Text.Blaze.Html5 as Blaze5
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe,
|
||||
shouldContain)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..),
|
||||
defaultParams)
|
||||
import Test.Hspec.Core.Spec (Arg, Example, Result (..), ResultStatus (..),
|
||||
defaultParams, safeEvaluateExample)
|
||||
import Test.QuickCheck.Gen (generate, unGen)
|
||||
import Test.QuickCheck.Random (mkQCGen)
|
||||
|
||||
@ -30,13 +30,6 @@ import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,
|
||||
comprehensiveAPI)
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_hspec(2,4,0)
|
||||
import Test.Hspec.Core.Spec (safeEvaluateExample)
|
||||
#else
|
||||
import Control.Exception (try)
|
||||
import Test.Hspec.Core.Spec (evaluateExample)
|
||||
#endif
|
||||
|
||||
import Servant.QuickCheck
|
||||
import Servant.QuickCheck.Internal (genRequest, runGenRequest,
|
||||
serverDoesntSatisfy)
|
||||
@ -349,27 +342,14 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
|
||||
-- Utils
|
||||
------------------------------------------------------------------------------
|
||||
evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
|
||||
#if MIN_VERSION_hspec(2,4,0)
|
||||
evalExample e = do
|
||||
r <- safeEvaluateExample e defaultParams ($ ()) progCallback
|
||||
case r of
|
||||
Left err -> return $ AnException err
|
||||
Right Success -> return $ AllGood
|
||||
Right (Failure _ reason) -> return $ FailedWith $ show reason
|
||||
Right (Pending _) -> error "should not happen"
|
||||
case resultStatus r of
|
||||
Success -> return $ AllGood
|
||||
Failure _ reason -> return $ FailedWith $ show reason
|
||||
Pending {} -> error "should not happen"
|
||||
where
|
||||
progCallback _ = return ()
|
||||
#else
|
||||
evalExample e = do
|
||||
r <- try $ evaluateExample e defaultParams ($ ()) progCallback
|
||||
case r of
|
||||
Left err -> return $ AnException err
|
||||
Right Success -> return $ AllGood
|
||||
Right (Fail _ reason) -> return $ FailedWith reason
|
||||
Right (Pending _) -> error "should not happen"
|
||||
where
|
||||
progCallback _ = return ()
|
||||
#endif
|
||||
|
||||
data EvalResult
|
||||
= AnException SomeException
|
||||
|
||||
Loading…
Reference in New Issue
Block a user