diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index 970c0269..1b7cd6f2 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/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 @@ -118,21 +124,24 @@ import Servant.API.Experimental.Auth ( AuthProtect ) -- The only way of constructing a 'Link' is using 'safeLink', which means any -- '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] + { _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"] + , _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