mirror of
https://github.com/ilyakooo0/servant-quickcheck.git
synced 2024-08-17 06:10:27 +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
|
||||
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)
|
||||
|
@ -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 ""
|
||||
|
Loading…
Reference in New Issue
Block a user