From 0337996c6c5a7c87762b61c648e0eefab0d5d950 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Wed, 14 Sep 2016 10:13:37 -0300
Subject: [PATCH] Support new CaptureAll combinator.

---
 .travis.yml                                      |  3 ++-
 servant-quickcheck.cabal                         |  6 +++++-
 src/Servant/QuickCheck/Internal/HasGenRequest.hs | 15 +++++++++++++++
 stack-ghc-8.0.1.yaml                             |  5 ++++-
 test/Servant/QuickCheck/InternalSpec.hs          |  4 ++--
 5 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 7e56a9f..4437ad7 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -11,7 +11,7 @@ matrix:
 
 install:
   - (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)
-  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH
+  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
   - ghc --version
   - cabal --version
   - travis_retry cabal update
@@ -19,6 +19,7 @@ install:
 
 script:
   - tinc && cabal configure --enable-tests && cabal build && cabal test
+  - cabal check
 
 cache:
   directories:
diff --git a/servant-quickcheck.cabal b/servant-quickcheck.cabal
index 97e4300..430670a 100644
--- a/servant-quickcheck.cabal
+++ b/servant-quickcheck.cabal
@@ -13,7 +13,11 @@ category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:
-  CHANGELOG.md
+  CHANGELOG.yaml
+
+source-repository head
+  type: git
+  location: https://github.com/haskell-servant/servant-quickcheck
 
 flag long-tests
   description: Run more QuickCheck tests
diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs
index 64ee033..407c0ab 100644
--- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs
+++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP       #-}
 {-# LANGUAGE PolyKinds #-}
 module Servant.QuickCheck.Internal.HasGenRequest where
 
@@ -5,6 +6,7 @@ import Data.Default.Class       (def)
 import Data.Monoid              ((<>))
 import Data.String              (fromString)
 import Data.String.Conversions  (cs)
+import qualified Data.ByteString as BS
 import GHC.TypeLits             (KnownSymbol, Nat, symbolVal)
 import Network.HTTP.Client      (Request, RequestBody (..), host, method, path,
                                  port, queryString, requestBody, requestHeaders,
@@ -44,6 +46,19 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
         old = genRequest (Proxy :: Proxy b)
         new = arbitrary :: Gen c
 
+#if MIN_VERSION_servant(0,8,0)
+instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
+    => HasGenRequest (CaptureAll x c :> b) where
+    genRequest _ = do
+      old' <- old
+      new' <- fmap (cs . toUrlPiece) <$> new
+      let new'' = BS.intercalate "/" new'
+      return $ \burl -> let r = old' burl in r { path = new'' <> path r }
+      where
+        old = genRequest (Proxy :: Proxy b)
+        new = arbitrary :: Gen [c]
+#endif
+
 instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
     => HasGenRequest (Header h c :> b) where
     genRequest _ = do
diff --git a/stack-ghc-8.0.1.yaml b/stack-ghc-8.0.1.yaml
index 3867889..ba8bdb2 100644
--- a/stack-ghc-8.0.1.yaml
+++ b/stack-ghc-8.0.1.yaml
@@ -2,6 +2,9 @@
 resolver: nightly-2016-09-07
 packages:
 - '.'
-extra-deps: []
+extra-deps:
+- 'servant-0.8.1'
+- 'servant-server-0.8.1'
+- 'servant-client-0.8.1'
 flags: {}
 extra-package-dbs: []
diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs
index 97ed739..91c5691 100644
--- a/test/Servant/QuickCheck/InternalSpec.hs
+++ b/test/Servant/QuickCheck/InternalSpec.hs
@@ -5,7 +5,7 @@ import Control.Concurrent.MVar                    (newMVar, readMVar, swapMVar)
 import Control.Monad.IO.Class                     (liftIO)
 import Prelude.Compat
 import Servant
-import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI)
+import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
 import Test.Hspec                                 (Spec, context, describe, it,
                                                    shouldBe, shouldContain)
 import Test.Hspec.Core.Spec                       (Arg, Example, Result (..),
@@ -81,7 +81,7 @@ isComprehensiveSpec :: Spec
 isComprehensiveSpec = describe "HasGenRequest" $ do
 
   it "has instances for all 'servant' combinators" $ do
-    let _g = genRequest comprehensiveAPI
+    let _g = genRequest comprehensiveAPIWithoutRaw
     True `shouldBe` True -- This is a type-level check