git.iko.soy/servant
on master help sign in
Merge pull request #745 from phadej/issue-715
2cfcff4Oleg Grenrus
servant/src/Servant/Utils/Links.hs+57−13
compare with master
unifiedsplit
@@ -87,8 +87,14 @@ module Servant.Utils.Links (
87 , URI(..)
87 , URI(..)
88 -- * Adding custom types
88 -- * Adding custom types
89 , HasLink(..)
89 , HasLink(..)
90− , linkURI
91 , Link
90 , Link
91+ , linkURI
92+ , linkURI'
93+ , LinkArrayElementStyle (..)
94+ -- ** Link accessors
95+ , Param (..)
96+ , linkSegments
97+ , linkQueryParams
92) where
98) where
93
99
94import Data.List
100import Data.List
@@ -118,21 +124,24 @@ import Servant.API.Experimental.Auth ( AuthProtect )
118-- The only way of constructing a 'Link' is using 'safeLink', which means any
124-- The only way of constructing a 'Link' is using 'safeLink', which means any
119-- 'Link' is guaranteed to be part of the mentioned API.
125-- 'Link' is guaranteed to be part of the mentioned API.
120data Link = Link
126data Link = Link
121− { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
127+ { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
122− , _queryParams :: [Param Query]
128+ , _queryParams :: [Param]
123 } deriving Show
129 } deriving Show
124
130
131+linkSegments :: Link -> [String]
132+linkSegments = _segments
133+
134+linkQueryParams :: Link -> [Param]
135+linkQueryParams = _queryParams
136+
125instance ToHttpApiData Link where
137instance ToHttpApiData Link where
126 toHeader = TE.encodeUtf8 . toUrlPiece
138 toHeader = TE.encodeUtf8 . toUrlPiece
127 toUrlPiece l =
139 toUrlPiece l =
128 let uri = linkURI l
140 let uri = linkURI l
129 in Text.pack $ uriPath uri ++ uriQuery uri
141 in Text.pack $ uriPath uri ++ uriQuery uri
130
142
131−-- Phantom types for Param
132−data Query
133−
134−-- | Query param
143+-- | Query parameter.
135−data Param a
144+data Param
136 = SingleParam String Text.Text
145 = SingleParam String Text.Text
137 | ArrayElemParam String Text.Text
146 | ArrayElemParam String Text.Text
138 | FlagParam String
147 | FlagParam String
@@ -141,27 +150,59 @@ data Param a
141addSegment :: String -> Link -> Link
150addSegment :: String -> Link -> Link
142addSegment seg l = l { _segments = _segments l <> [seg] }
151addSegment seg l = l { _segments = _segments l <> [seg] }
143
152
144−addQueryParam :: Param Query -> Link -> Link
153+addQueryParam :: Param -> Link -> Link
145addQueryParam qp l =
154addQueryParam qp l =
146 l { _queryParams = _queryParams l <> [qp] }
155 l { _queryParams = _queryParams l <> [qp] }
147
156
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+--
148linkURI :: Link -> URI
167linkURI :: Link -> URI
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
149−linkURI (Link segments q_params) =
186+linkURI' addBrackets (Link segments q_params) =
150 URI mempty -- No scheme (relative)
187 URI mempty -- No scheme (relative)
151 Nothing -- Or authority (relative)
188 Nothing -- Or authority (relative)
152 (intercalate "/" segments)
189 (intercalate "/" segments)
153 (makeQueries q_params) mempty
190 (makeQueries q_params) mempty
154 where
191 where
155− makeQueries :: [Param Query] -> String
192+ makeQueries :: [Param] -> String
156 makeQueries [] = ""
193 makeQueries [] = ""
157 makeQueries xs =
194 makeQueries xs =
158 "?" <> intercalate "&" (fmap makeQuery xs)
195 "?" <> intercalate "&" (fmap makeQuery xs)
159
196
160− makeQuery :: Param Query -> String
197+ makeQuery :: Param -> String
161− makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (Text.unpack v)
198+ makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
162 makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
199 makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
163 makeQuery (FlagParam k) = escape k
200 makeQuery (FlagParam k) = escape k
164
201
202+ style = case addBrackets of
203+ LinkArrayElementBracket -> "[]="
204+ LinkArrayElementPlain -> "="
205+
165escape :: String -> String
206escape :: String -> String
166escape = escapeURIString isUnreserved
207escape = escapeURIString isUnreserved
167
208
@@ -265,3 +306,6 @@ instance HasLink Raw where
265instance HasLink sub => HasLink (AuthProtect tag :> sub) where
306instance HasLink sub => HasLink (AuthProtect tag :> sub) where
266 type MkLink (AuthProtect tag :> sub) = MkLink sub
307 type MkLink (AuthProtect tag :> sub) = MkLink sub
267 toLink _ = toLink (Proxy :: Proxy sub)
308 toLink _ = toLink (Proxy :: Proxy sub)
309+
310+-- $setup
311+-- >>> import Servant.API