Generate query strings from complete maps or deep objects

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

@@ -23,6 +23,7 @@ module Servant.Client.Core.HasClient (
     (/:),
     foldMapUnion,
     matchUnion,
+    ToDeepQuery (..)
     ) where
 
 import           Prelude ()
@@ -44,6 +45,7 @@ import           Data.List
 import           Data.Sequence
                  (fromList)
 import qualified Data.Text                       as T
+import           Data.Text.Encoding (encodeUtf8)
 import           Network.HTTP.Media
                  (MediaType, matches, parseAccept)
 import qualified Network.HTTP.Media as Media
@@ -69,12 +71,12 @@ import           Network.HTTP.Types
 import qualified Network.HTTP.Types                       as H
 import           Servant.API
                  ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
-                 BuildHeadersTo (..), Capture', CaptureAll, Description,
+                 BuildHeadersTo (..), Capture', CaptureAll, DeepQuery, Description,
                  EmptyAPI, Fragment, FramingRender (..), FramingUnrender (..),
                  FromSourceIO (..), Header', Headers (..), HttpVersion,
                  IsSecure, MimeRender (mimeRender),
                  MimeUnrender (mimeUnrender), NoContent (NoContent),
-                 NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
+                 NoContentVerb, QueryFlag, QueryParam', QueryParams, QueryString, Raw,
                  ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
                  StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
                  Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
@@ -662,6 +664,44 @@ instance (KnownSymbol sym, HasClient m api)
   hoistClientMonad pm _ f cl = \b ->
     hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
 
+instance (HasClient m api)
+      => HasClient m (QueryString :> api) where
+  type Client m (QueryString :> api) =
+    H.Query -> Client m api
+
+  clientWithRoute pm Proxy req query =
+    clientWithRoute pm (Proxy :: Proxy api)
+                    (setQueryString query req)
+
+  hoistClientMonad pm _ f cl = \b ->
+    hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
+
+class ToDeepQuery a where
+  toDeepQuery :: a -> [([T.Text], Maybe T.Text)]
+
+generateDeepParam :: T.Text -> ([T.Text], Maybe T.Text) -> (T.Text, Maybe T.Text)
+generateDeepParam name (keys, value) =
+  let makeKeySegment key = "[" <> key <> "]"
+   in (name <> foldMap makeKeySegment keys, value)
+
+instance (KnownSymbol sym, ToDeepQuery a, HasClient m api)
+      => HasClient m (DeepQuery sym a :> api) where
+  type Client m (DeepQuery sym a :> api) =
+    a -> Client m api
+
+  clientWithRoute pm Proxy req deepObject =
+    let params = toDeepQuery deepObject
+        withParams = foldl' addDeepParam req params
+        addDeepParam r' kv =
+          let (k, textV) = generateDeepParam paramname kv
+           in appendToQueryString k (encodeUtf8 <$> textV) r'
+        paramname = pack $ symbolVal (Proxy :: Proxy sym)
+     in clientWithRoute pm (Proxy :: Proxy api)
+                        withParams
+
+  hoistClientMonad pm _ f cl = \b ->
+    hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
+
 -- | Pick a 'Method' and specify where the server you want to query is. You get
 -- back the full `Response`.
 instance RunClient m => HasClient m Raw where

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

@@ -20,6 +20,9 @@ module Servant.Client.Core.Reexport
   , ClientError(..)
   , EmptyClient(..)
 
+  -- * DeepQuery
+  , ToDeepQuery(..)
+
   -- * BaseUrl
   , BaseUrl(..)
   , Scheme(..)

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

@@ -18,6 +18,7 @@ module Servant.Client.Core.Request (
     appendToPath,
     appendToQueryString,
     encodeQueryParamValue,
+    setQueryString,
     setRequestBody,
     setRequestBodyLBS,
     ) where
@@ -50,7 +51,7 @@ import           GHC.Generics
 import           Network.HTTP.Media
                  (MediaType)
 import           Network.HTTP.Types
-                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
+                 (Header,  HeaderName, HttpVersion (..), Method, Query, QueryItem,
                  http11, methodGet)
 import           Servant.API
                  (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
@@ -162,6 +163,12 @@ appendToQueryString pname pvalue req
   = req { requestQueryString = requestQueryString req
                         Seq.|> (encodeUtf8 pname, pvalue)}
 
+setQueryString :: Query
+               -> Request
+               -> Request
+setQueryString query req
+  = req { requestQueryString = Seq.fromList query }
+
 -- | Encode a query parameter value.
 --
 encodeQueryParamValue :: ToHttpApiData a => a  -> BS.ByteString