Resolve #715: Add linkUri'

servant/src/Servant/Utils/Links.hs

@@ -87,8 +87,14 @@ module Servant.Utils.Links (
   , URI(..)
   -- * Adding custom types
   , HasLink(..)
-  , linkURI
   , Link
+  , linkURI
+  , linkURI'
+  , LinkArrayElementStyle (..)
+  -- ** Link accessors
+  , Param (..)
+  , linkSegments
+  , linkQueryParams
 ) where
 
 import           Data.List
@@ -119,20 +125,23 @@ import Servant.API.Experimental.Auth ( AuthProtect )
 -- 'Link' is guaranteed to be part of the mentioned API.
 data Link = Link
   { _segments :: [String]   -- ^ Segments of "foo/bar" would be ["foo", "bar"]
-  , _queryParams :: [Param Query]
+  , _queryParams :: [Param]
   } deriving Show
 
+linkSegments :: Link -> [String]
+linkSegments = _segments
+
+linkQueryParams :: Link -> [Param]
+linkQueryParams = _queryParams
+
 instance ToHttpApiData Link where
     toHeader   = TE.encodeUtf8 . toUrlPiece
     toUrlPiece l =
         let uri = linkURI l
         in Text.pack $ uriPath uri ++ uriQuery uri
 
--- Phantom types for Param
-data Query
-
--- | Query param
-data Param a
+-- | Query parameter.
+data Param
     = SingleParam    String Text.Text
     | ArrayElemParam String Text.Text
     | FlagParam      String
@@ -141,27 +150,40 @@ data Param a
 addSegment :: String -> Link -> Link
 addSegment seg l = l { _segments = _segments l <> [seg] }
 
-addQueryParam :: Param Query -> Link -> Link
+addQueryParam :: Param -> Link -> Link
 addQueryParam qp l =
     l { _queryParams = _queryParams l <> [qp] }
 
 linkURI :: Link -> URI
-linkURI (Link segments q_params) =
+linkURI = linkURI' LinkArrayElementBracket
+
+-- | How to encode array query elements.
+data LinkArrayElementStyle
+    = LinkArrayElementBracket  -- ^ @foo[]=1&foo[]=2@
+    | LinkArrayElementPlain    -- ^ @foo=1&foo=2@
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+linkURI' :: LinkArrayElementStyle -> Link -> URI
+linkURI' addBrackets (Link segments q_params) =
     URI mempty  -- No scheme (relative)
         Nothing -- Or authority (relative)
         (intercalate "/" segments)
         (makeQueries q_params) mempty
   where
-    makeQueries :: [Param Query] -> String
+    makeQueries :: [Param] -> String
     makeQueries [] = ""
     makeQueries xs =
         "?" <> intercalate "&" (fmap makeQuery xs)
 
-    makeQuery :: Param Query -> String
-    makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (Text.unpack v)
+    makeQuery :: Param -> String
+    makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
     makeQuery (SingleParam k v)    = escape k <> "=" <> escape (Text.unpack v)
     makeQuery (FlagParam k)        = escape k
 
+    style = case addBrackets of
+        LinkArrayElementBracket -> "[]="
+        LinkArrayElementPlain -> "="
+
 escape :: String -> String
 escape = escapeURIString isUnreserved