mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-10-26 18:17:32 +03:00
Fix QueryFlags too (#23)
* Same logic / testing as for `QueryParam` * There's probably some de-duplication that could be done here one day...
This commit is contained in:
parent
a8459223ed
commit
77fa490b93
@ -119,8 +119,10 @@ instance (KnownSymbol x, HasGenRequest b)
|
|||||||
=> HasGenRequest (QueryFlag x :> b) where
|
=> HasGenRequest (QueryFlag x :> b) where
|
||||||
genRequest _ = do
|
genRequest _ = do
|
||||||
old' <- old
|
old' <- old
|
||||||
return $ \burl -> let r = old' burl in r {
|
return $ \burl -> let r = old' burl
|
||||||
queryString = queryString r <> param <> "=" }
|
newExpr = param <> "="
|
||||||
|
qs = queryString r in r {
|
||||||
|
queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs }
|
||||||
where
|
where
|
||||||
old = genRequest (Proxy :: Proxy b)
|
old = genRequest (Proxy :: Proxy b)
|
||||||
param = cs $ symbolVal (Proxy :: Proxy x)
|
param = cs $ symbolVal (Proxy :: Proxy x)
|
||||||
|
@ -33,6 +33,7 @@ spec = do
|
|||||||
onlyJsonObjectSpec
|
onlyJsonObjectSpec
|
||||||
notLongerThanSpec
|
notLongerThanSpec
|
||||||
queryParamsSpec
|
queryParamsSpec
|
||||||
|
queryFlagsSpec
|
||||||
|
|
||||||
serversEqualSpec :: Spec
|
serversEqualSpec :: Spec
|
||||||
serversEqualSpec = describe "serversEqual" $ do
|
serversEqualSpec = describe "serversEqual" $ do
|
||||||
@ -123,6 +124,17 @@ queryParamsSpec = describe "QueryParams" $ do
|
|||||||
qs = C.unpack $ queryString req
|
qs = C.unpack $ queryString req
|
||||||
qs `shouldBe` "one=_&two=_"
|
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
|
-- APIs
|
||||||
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
||||||
@ -139,6 +151,12 @@ type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] ()
|
|||||||
paramsAPI :: Proxy ParamsAPI
|
paramsAPI :: Proxy ParamsAPI
|
||||||
paramsAPI = Proxy
|
paramsAPI = Proxy
|
||||||
|
|
||||||
|
type FlagsAPI = QueryFlag "one" :> QueryFlag "two" :> Get '[JSON] ()
|
||||||
|
|
||||||
|
flagsAPI :: Proxy FlagsAPI
|
||||||
|
flagsAPI = Proxy
|
||||||
|
|
||||||
|
|
||||||
server :: IO (Server API)
|
server :: IO (Server API)
|
||||||
server = do
|
server = do
|
||||||
mvar <- newMVar ""
|
mvar <- newMVar ""
|
||||||
|
Loading…
Reference in New Issue
Block a user