servant-quickcheck 0.0.6.0 → 0.0.7.0

raw patch · 6 files changed

+57/−41 lines, 6 filesdep +semigroupsdep ~basedep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependency ranges changed: base, hspec

API changes (from Hackage documentation)

Files

• 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

@@ -1,6 +1,17 @@-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 @@ 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 @@                      , 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 @@                      , 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 @@   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 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,8 +9,13 @@ 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)

@@ -11,7 +11,7 @@ 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 @@   { 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 @@ -- 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 @@   , 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.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 @@                                                    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 @@ -- 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"-  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"+  case resultStatus r of+    Success          -> return $ AllGood+    Failure _ reason -> return $ FailedWith $ show reason+    Pending {}       -> error "should not happen"   where     progCallback _ = return ()-#endif  data EvalResult   = AnException SomeException