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