@@ -87,8 +87,14 @@ module Servant.Utils.Links (
8787 , URI(..)
8888 -- * Adding custom types
8989 , HasLink(..)
90− , linkURI
9190 , Link
91+ , linkURI
92+ , linkURI'
93+ , LinkArrayElementStyle (..)
94+ -- ** Link accessors
95+ , Param (..)
96+ , linkSegments
97+ , linkQueryParams
9298) where
9399
94100import Data.List
@@ -118,21 +124,24 @@ import Servant.API.Experimental.Auth ( AuthProtect )
118124-- The only way of constructing a 'Link' is using 'safeLink', which means any
119125-- 'Link' is guaranteed to be part of the mentioned API.
120126data Link = Link
121− { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
122− , _queryParams :: [Param Query]
127+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
128+ , _queryParams :: [Param]
123129 } deriving Show
124130
131+linkSegments :: Link -> [String]
132+linkSegments = _segments
133+
134+linkQueryParams :: Link -> [Param]
135+linkQueryParams = _queryParams
136+
125137instance ToHttpApiData Link where
126138 toHeader = TE.encodeUtf8 . toUrlPiece
127139 toUrlPiece l =
128140 let uri = linkURI l
129141 in Text.pack $ uriPath uri ++ uriQuery uri
130142
131−-- Phantom types for Param
132−data Query
133−
134−-- | Query param
135−data Param a
143+-- | Query parameter.
144+data Param
136145 = SingleParam String Text.Text
137146 | ArrayElemParam String Text.Text
138147 | FlagParam String
@@ -141,27 +150,59 @@ data Param a
141150addSegment :: String -> Link -> Link
142151addSegment seg l = l { _segments = _segments l <> [seg] }
143152
144−addQueryParam :: Param Query -> Link -> Link
153+addQueryParam :: Param -> Link -> Link
145154addQueryParam qp l =
146155 l { _queryParams = _queryParams l <> [qp] }
147156
157+-- | Transform 'Link' into 'URI'.
158+--
159+-- >>> type API = "something" :> Get '[JSON] Int
160+-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
161+-- something
162+--
163+-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
164+-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
165+-- sum?x[]=1&x[]=2&x[]=3
166+--
148167linkURI :: Link -> URI
149−linkURI (Link segments q_params) =
168+linkURI = linkURI' LinkArrayElementBracket
169+
170+-- | How to encode array query elements.
171+data LinkArrayElementStyle
172+ = LinkArrayElementBracket -- ^ @foo[]=1&foo[]=2@
173+ | LinkArrayElementPlain -- ^ @foo=1&foo=2@
174+ deriving (Eq, Ord, Show, Enum, Bounded)
175+
176+-- | Configurable 'linkURI'.
177+--
178+-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
179+-- >>> linkURI' LinkArrayElementBracket $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
180+-- sum?x[]=1&x[]=2&x[]=3
181+--
182+-- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
183+-- sum?x=1&x=2&x=3
184+--
185+linkURI' :: LinkArrayElementStyle -> Link -> URI
186+linkURI' addBrackets (Link segments q_params) =
150187 URI mempty -- No scheme (relative)
151188 Nothing -- Or authority (relative)
152189 (intercalate "/" segments)
153190 (makeQueries q_params) mempty
154191 where
155− makeQueries :: [Param Query] -> String
192+ makeQueries :: [Param] -> String
156193 makeQueries [] = ""
157194 makeQueries xs =
158195 "?" <> intercalate "&" (fmap makeQuery xs)
159196
160− makeQuery :: Param Query -> String
161− makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (Text.unpack v)
197+ makeQuery :: Param -> String
198+ makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
162199 makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
163200 makeQuery (FlagParam k) = escape k
164201
202+ style = case addBrackets of
203+ LinkArrayElementBracket -> "[]="
204+ LinkArrayElementPlain -> "="
205+
165206escape :: String -> String
166207escape = escapeURIString isUnreserved
167208
@@ -265,3 +306,6 @@ instance HasLink Raw where
265306instance HasLink sub => HasLink (AuthProtect tag :> sub) where
266307 type MkLink (AuthProtect tag :> sub) = MkLink sub
267308 toLink _ = toLink (Proxy :: Proxy sub)
309+
310+-- $setup
311+-- >>> import Servant.API