Rewrite client concatQueryString for client requests and pull extraneous data type for spec

Remove symbol from QueryParamForm type args

Remove the data instance for QueryParamForm in HasDocs

Author: erewok

servant-client-core/src/Servant/Client/Core/HasClient.hs

@@ -557,7 +557,7 @@ instance (KnownSymbol sym, HasClient m api)
 -- >   } deriving (Eq, Show, Generic)
 -- > instance ToForm BookSearchParams
 --
--- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
+-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
 -- >
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
@@ -567,10 +567,10 @@ instance (KnownSymbol sym, HasClient m api)
 -- > -- then you can just use "getBooks" to query that endpoint.
 -- > -- 'getBooksBy Nothing' for all books
 -- > -- 'getBooksBy (Just $ BookSearchParams "white noise" ["DeLillo"] Nothing)'
-instance (KnownSymbol sym, ToForm a, HasClient m api, SBoolI (FoldRequired mods))
-      => HasClient m (QueryParamForm' mods sym a :> api) where
+instance (ToForm a, HasClient m api, SBoolI (FoldRequired mods))
+      => HasClient m (QueryParamForm' mods a :> api) where
 
-  type Client m (QueryParamForm' mods sym a :> api) =
+  type Client m (QueryParamForm' mods a :> api) =
     RequiredArgument mods a -> Client m api
 
   -- if mparam = Nothing, we don't add it to the query string

servant-client-core/src/Servant/Client/Core/Request.hs

@@ -51,11 +51,11 @@ import           Network.HTTP.Media
                  (MediaType)
 import           Network.HTTP.Types
                  (Header, HeaderName, HttpVersion (..), Method, QueryItem,
-                 http11, methodGet, parseQuery)
+                 http11, methodGet)
 import           Servant.API
                  (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
 import           Web.FormUrlEncoded
-                 (ToForm (..), urlEncodeAsForm)
+                 (ToForm (..), toListStable)
 
 import Servant.Client.Core.Internal (mediaTypeRnf)
 
@@ -143,14 +143,16 @@ concatQueryString :: ToForm a
                   -> Request
                   -> Request
 concatQueryString form req
-  = let querySeq = Seq.fromList . parseQuery . LBS.toStrict . urlEncodeAsForm $ form
+  = let
+      queryEncoder = map (bimap encodeUtf8 (Just . encodeUtf8))
+      querySeq = Seq.fromList . queryEncoder . toListStable . toForm $ form
     in req { requestQueryString = requestQueryString req Seq.>< querySeq }
 
+
 -- | Set body and media type of the request being constructed.
 --
 -- The body is set to the given bytestring using the 'RequestBodyLBS'
 -- constructor.
---
 -- @since 0.12
 --
 setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request

servant-docs/src/Servant/Docs/Internal.hs

@@ -32,8 +32,6 @@ import qualified Data.ByteString.Lazy.Char8 as LBSC
 import           Data.ByteString.Lazy.Char8
                  (ByteString)
 import qualified Data.CaseInsensitive       as CI
-import           Data.Data
-                 (Data, toConstr, constrFields)
 import           Data.Foldable
                  (toList)
 import           Data.Foldable
@@ -955,25 +953,23 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
           paramP = Proxy :: Proxy (QueryFlag sym)
           action' = over params (|> toParam paramP) action
 
--- | The docs for a @'QueryParamForm' sym a'@
---   require the following instances for the `a`:
---   'Data', 'ToSample'
-instance (KnownSymbol sym, Data a, ToForm a, ToSample a, HasDocs api)
-      => HasDocs (QueryParamForm' mods sym a :> api) where
-    
+-- | The docs for a @'QueryParamForm' a'@
+--   require a 'ToSample a' instance
+instance (ToForm a, ToSample a, HasDocs api)
+      => HasDocs (QueryParamForm' mods a :> api) where
+
   docsFor Proxy (endpoint, action) =
     docsFor subApiP (endpoint, action')
 
     where subApiP = Proxy :: Proxy api
           action' =
             let (Just sampleForm) = toSample (Proxy :: Proxy a)
-                paramNames = constrFields (toConstr sampleForm)
                 sampleEncoding = LBSC.unpack . urlEncodeAsForm . toForm $ sampleForm
-            in action & params <>~ (fmap (qParamMaker sampleEncoding) paramNames)
-          qParamMaker formEncodedSample pName = DocQueryParam {
-            _paramName = pName
+            in action & params <>~ [qParamMaker sampleEncoding]
+          qParamMaker formEncodedSample = DocQueryParam {
+            _paramName = "Collection of Parameters"
             , _paramValues = [formEncodedSample]
-            , _paramDesc = "Query parameter"
+            , _paramDesc = "Query parameters"
             , _paramKind = Normal
           }
 

servant-docs/test/Servant/DocsSpec.hs

@@ -58,7 +58,7 @@ instance ToParam (QueryParam' mods "bar" Int) where
 instance ToParam (QueryParams "foo" Int) where
   toParam _ = DocQueryParam "foo" ["1","2","3"] "QueryParams Int" List
 instance ToParam (QueryParam "query" String) where
-    toParam _ = DocQueryParam "query" ["a","b","c"] "QueryParams String" Normal  
+    toParam _ = DocQueryParam "query" ["a","b","c"] "QueryParams String" Normal
 instance ToParam (QueryFlag "foo") where
   toParam _ = DocQueryParam "foo" [] "QueryFlag" Flag
 instance ToCapture (Capture "foo" Int) where
@@ -143,10 +143,7 @@ spec = describe "Servant.Docs" $ do
     it "mentions optional query-param" $ do
       md `shouldContain` "### GET Parameters:"
       md `shouldContain` "- query"
-    it "mentions optional query-param-form params from QueryParamForm" $ do
-      md `shouldContain` "- dt1field1"
-      md `shouldContain` "- dt1field2"
-      -- contains sample url-encoded form
+    it "mentions optional query-param-form params from QueryParamForm" $
       md `shouldContain` "- **Values**: *dt1field1=field%201&dt1field2=13*"
 
     it "does not generate any docs mentioning the 'empty-api' path" $
@@ -177,7 +174,7 @@ instance MimeRender PlainText Int where
 type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
            :<|> "postJson"   :> ReqBody '[JSON] String          :> Post '[JSON] Datatype1
            :<|> "qparam"     :> QueryParam "query" String       :> Get '[JSON] Datatype1
-           :<|> "qparamform" :> QueryParamForm "form" Datatype1 :> Get '[JSON] Datatype1
+           :<|> "qparamform" :> QueryParamForm Datatype1 :> Get '[JSON] Datatype1
            :<|> "header"     :> Header "X-Test" Int             :> Put '[JSON] Int
            :<|> "empty-api"                                     :> EmptyAPI
 

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -325,9 +325,9 @@ instance
         { _argName = PathSegment str
         , _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
 
-instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
-  => HasForeign lang ftype (QueryParamForm' mods sym a :> api) where
-  type Foreign ftype (QueryParamForm' mods sym a :> api) = Foreign ftype api
+instance (HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api)
+  => HasForeign lang ftype (QueryParamForm' mods a :> api) where
+  type Foreign ftype (QueryParamForm' mods a :> api) = Foreign ftype api
 
   foreignFor lang Proxy Proxy req =
     foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
@@ -336,7 +336,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a),
       arg = Arg
         { _argName = PathSegment ""
         , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy (RequiredArgument mods a)) }
-      
+
 
 instance HasForeign lang ftype Raw where
   type Foreign ftype Raw = HTTP.Method -> Req ftype

servant-foreign/test/Servant/ForeignSpec.hs

@@ -82,7 +82,7 @@ instance HasForeignType LangX String ContactForm where
 type TestApi
     = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
  :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] NoContent
- :<|> "test" :> QueryParamForm "contact" ContactForm :> Post '[JSON] NoContent
+ :<|> "test" :> QueryParamForm ContactForm :> Post '[JSON] NoContent
  :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] NoContent
  :<|> "test" :> Capture "id" Int :> Delete '[JSON] NoContent
  :<|> "test" :> CaptureAll "ids" Int :> Get '[JSON] [Int]

servant-http-streams/test/Servant/ClientSpec.hs

@@ -111,14 +111,6 @@ alice = Person "Alice" 42
 carol :: Person
 carol = Person "Carol" 17
 
-data PersonSearch = PersonSearch
-  { nameStartsWith :: String
-  , ageGreaterThan :: Integer
-  } deriving (Eq, Show, Generic)
-
-instance ToForm PersonSearch
-instance FromForm PersonSearch
-
 type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
 
 type Api =
@@ -130,7 +122,7 @@ type Api =
   :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
   :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
   :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
-  :<|> "paramform" :> QueryParamForm "names" PersonSearch :> Get '[JSON] [Person]
+  :<|> "paramform" :> QueryParamForm Person :> Get '[JSON] [Person]
   :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
   :<|> "rawSuccess" :> Raw
   :<|> "rawFailure" :> Raw
@@ -156,7 +148,7 @@ getCaptureAll   :: [String] -> ClientM [Person]
 getBody         :: Person -> ClientM Person
 getQueryParam   :: Maybe String -> ClientM Person
 getQueryParams  :: [String] -> ClientM [Person]
-getQueryParamForm  :: Maybe PersonSearch -> ClientM [Person]
+getQueryParamForm  :: Maybe Person -> ClientM [Person]
 getQueryFlag    :: Bool -> ClientM Bool
 getRawSuccess   :: HTTP.Method -> ClientM Response
 getRawFailure   :: HTTP.Method -> ClientM Response
@@ -198,8 +190,8 @@ server = serve api (
                    Nothing -> throwError $ ServerError 400 "missing parameter" "" [])
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> (\ psearch -> case psearch of
-                   Just (Right psearch) -> return [alice, carol]
-                   Just (Left err) -> throwError $ ServerError 400 "failed to decode form" "" []
+                   Just (Right _) -> return [alice, carol]
+                   Just (Left _) -> throwError $ ServerError 400 "failed to decode form" "" []
                    Nothing -> return [])
   :<|> return
   :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
@@ -323,7 +315,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
 
     it "Servant.API.QueryParam.QueryParamForm" $ \(_, baseUrl) -> do
       left show <$> runClient (getQueryParamForm Nothing) baseUrl `shouldReturn` Right []
-      left show <$> runClient (getQueryParamForm (Just $ PersonSearch "a" 10)) baseUrl
+      left show <$> runClient (getQueryParamForm (Just $ Person "a" 10)) baseUrl
         `shouldReturn` Right [alice, carol]
 
     context "Servant.API.QueryParam.QueryFlag" $

servant-server/src/Servant/Server/Internal.hs

@@ -558,9 +558,9 @@ instance (KnownSymbol sym, HasServer api context)
           examine v | v == "true" || v == "1" || v == "" = True
                     | otherwise = False
 
--- | If you define a custom record type, for example @BookSearchParams@, then you can use 
--- @'QueryParamForm' "formName" BookSearchParams@ in one of the endpoints for your API
--- to translate a collection of query-string parameters into a value of your record type. 
+-- | If you define a custom record type, for example @BookSearchParams@, then you can use
+-- @'QueryParamForm' BookSearchParams@ in one of the endpoints for your API
+-- to translate a collection of query-string parameters into a value of your record type.
 --
 -- Your server-side handler must be a function that takes an argument of type
 -- @'Maybe' ('Either' BookSearchParams)@.
@@ -582,26 +582,24 @@ instance (KnownSymbol sym, HasServer api context)
 -- >   , page :: Maybe Int
 -- >   } deriving (Eq, Show, Generic)
 -- > instance FromForm BookSearchParams
--- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
--- 
+-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
+--
 -- Example Handler Signature:
 -- Maybe (Either Text BookSearchParams) -> Handler [Book]
 instance
-  ( KnownSymbol sym, FromForm a, HasServer api context
+  (FromForm a, HasServer api context
   , SBoolI (FoldRequired mods), SBoolI (FoldLenient mods)
   )
-  => HasServer (QueryParamForm' mods sym a :> api) context where
+  => HasServer (QueryParamForm' mods a :> api) context where
 ------
-  type ServerT (QueryParamForm' mods sym a :> api) m =
+  type ServerT (QueryParamForm' mods a :> api) m =
     RequestArgument mods a -> ServerT api m
 
   hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
 
-  route Proxy context subserver = 
-    
-    let formName = cs $ symbolVal (Proxy :: Proxy sym)
+  route Proxy context subserver =
 
-        parseParamForm req =
+    let parseParamForm req =
             unfoldRequestArgument (Proxy :: Proxy mods) errReq errSt mev
           where
             rawQS = rawQueryString req
@@ -612,12 +610,11 @@ instance
               _ -> Just $ urlDecodeAsForm (BL.drop 1 . BL.fromStrict $ rawQS)
 
             errReq = delayedFailFatal err400
-              { errBody = cs $ "Query parameter form " <> formName <> " is required"
+              { errBody = "Query parameter form is required"
               }
 
             errSt e = delayedFailFatal err400
-              { errBody = cs $ "Error parsing query parameter form "
-                                <> formName <> " failed: " <> e
+              { errBody = cs $ "Error: parsing query parameter form failed. " <> e
               }
 
         delayed = addParameterCheck subserver . withRequest $ \req ->

servant-server/test/Servant/ServerSpec.hs

@@ -466,14 +466,14 @@ data AnimalSearch = AnimalSearch {
 instance FromForm AnimalSearch
 
 type QueryParamFormApi =
-  QueryParamForm "octopus" AnimalSearch :> Get '[JSON] Animal
+  QueryParamForm AnimalSearch :> Get '[JSON] Animal
   :<|> "before-param"
         :> QueryParam "before" Bool
-        :> QueryParamForm "before" AnimalSearch
+        :> QueryParamForm AnimalSearch
         :> Get '[JSON] Animal
   :<|> "mixed-param"
         :> QueryParam "before" Bool
-        :> QueryParamForm "multiple" AnimalSearch
+        :> QueryParamForm AnimalSearch
         :> QueryParam "after" Bool
         :> Get '[JSON] Animal
 

servant/src/Servant/API/QueryParam.hs

@@ -50,7 +50,7 @@ data QueryParams (sym :: Symbol) (a :: *)
 -- of type (Maybe (Either Text a)). This also means that in a server implementation
 -- if there as a query string of any length (even just a "?"), we'll try to parse
 -- the 'QueryParamForm' into the custom type specified.
--- 
+--
 -- Example:
 --
 -- > data BookSearchParams = BookSearchParams
@@ -59,15 +59,15 @@ data QueryParams (sym :: Symbol) (a :: *)
 -- >   , page :: Maybe Int
 -- >   } deriving (Eq, Show, Generic)
 -- > instance FromForm BookSearchParams
--- > type MyApi = "books" :> QueryParamForm "searchQ" BookSearchParams :> Get '[JSON] [Book]
--- 
+-- > type MyApi = "books" :> QueryParamForm BookSearchParams :> Get '[JSON] [Book]
+--
 -- Example Handler Signature:
 -- Maybe (Either Text BookSearchParams) -> Handler [Book]
 
 type QueryParamForm = QueryParamForm' '[Optional, Lenient]
 
 -- | 'QueryParamForm' which can be 'Required', 'Lenient', or modified otherwise.
-data QueryParamForm' (mods :: [*]) (sym :: Symbol) (a :: *)
+data QueryParamForm' (mods :: [*]) (a :: *)
     deriving Typeable