diff --git a/src/Servant/QuickCheck/Internal/HasGenRequest.hs b/src/Servant/QuickCheck/Internal/HasGenRequest.hs index f1247fa..378f743 100644 --- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs +++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs @@ -119,8 +119,10 @@ instance (KnownSymbol x, HasGenRequest b) => HasGenRequest (QueryFlag x :> b) where genRequest _ = do old' <- old - return $ \burl -> let r = old' burl in r { - queryString = queryString r <> param <> "=" } + return $ \burl -> let r = old' burl + newExpr = param <> "=" + qs = queryString r in r { + queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs } where old = genRequest (Proxy :: Proxy b) param = cs $ symbolVal (Proxy :: Proxy x) diff --git a/test/Servant/QuickCheck/InternalSpec.hs b/test/Servant/QuickCheck/InternalSpec.hs index 3d38a87..98a3843 100644 --- a/test/Servant/QuickCheck/InternalSpec.hs +++ b/test/Servant/QuickCheck/InternalSpec.hs @@ -33,6 +33,7 @@ spec = do onlyJsonObjectSpec notLongerThanSpec queryParamsSpec + queryFlagsSpec serversEqualSpec :: Spec serversEqualSpec = describe "serversEqual" $ do @@ -123,6 +124,17 @@ queryParamsSpec = describe "QueryParams" $ do qs = C.unpack $ queryString req qs `shouldBe` "one=_&two=_" +queryFlagsSpec :: Spec +queryFlagsSpec = describe "QueryFlags" $ do + + it "reduce to an HTTP query string correctly" $ do + let rng = mkQCGen 0 + burl = BaseUrl Http "localhost" 80 "" + gen = genRequest flagsAPI + req = (unGen gen rng 0) burl + qs = C.unpack $ queryString req + qs `shouldBe` "one=&two=" + ------------------------------------------------------------------------------ -- APIs ------------------------------------------------------------------------------ @@ -139,6 +151,12 @@ type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] () paramsAPI :: Proxy ParamsAPI paramsAPI = Proxy +type FlagsAPI = QueryFlag "one" :> QueryFlag "two" :> Get '[JSON] () + +flagsAPI :: Proxy FlagsAPI +flagsAPI = Proxy + + server :: IO (Server API) server = do mvar <- newMVar ""