eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Remove MatrixParam.

Browse source 
In servant, servant-server, and servant-client.
This commit is contained in:
Julian K. Arni 2015-10-08 22:40:46 +02:00
parent 6ef59de6b4
commit afc76b8f6c
13 changed files with 22 additions and 547 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

128
servant-client/src/Servant/Client.hs
View file

@ -477,134 +477,6 @@ instance (KnownSymbol sym, HasClient sublayout)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | If you use a 'MatrixParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'MatrixParam',
-- enclosed in Maybe.
--
-- If you give Nothing, nothing will be added to the query string.
--
-- If you give a non-'Nothing' value, this function will take care
-- of inserting a textual representation of this value in the query string.
--
-- You can control how values for your type are turned into
-- text by specifying a 'ToHttpApiData' instance for your type.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book]
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (MatrixParam sym a :> sublayout) where
type Client (MatrixParam sym a :> sublayout) =
Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string
clientWithRoute Proxy req baseurl manager mparam =
clientWithRoute (Proxy :: Proxy sublayout)
(maybe req
(flip (appendToMatrixParams pname . Just) req)
mparamText
)
baseurl manager
where pname = symbolVal (Proxy :: Proxy sym)
mparamText = fmap (cs . toQueryParam) mparam
-- | If you use a 'MatrixParams' in one of your endpoints in your API,
-- the corresponding querying function will automatically take an
-- additional argument, a list of values of the type specified by your
-- 'MatrixParams'.
--
-- If you give an empty list, nothing will be added to the query string.
--
-- Otherwise, this function will take care of inserting a textual
-- representation of your values in the path segment string, under the
-- same matrix string parameter name.
--
-- You can control how values for your type are turned into text by
-- specifying a 'ToHttpApiData' instance for your type.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book]
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
-- > getBooksBy = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
-- > -- to get all books by Asimov and Heinlein
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (MatrixParams sym a :> sublayout) where
type Client (MatrixParams sym a :> sublayout) =
[a] -> Client sublayout
clientWithRoute Proxy req baseurl manager paramlist =
clientWithRoute (Proxy :: Proxy sublayout)
(foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value)
req
paramlist'
)
baseurl manager
where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym)
paramlist' = map (Just . toQueryParam) paramlist
-- | If you use a 'MatrixFlag' in one of your endpoints in your API,
-- the corresponding querying function will automatically take an
-- additional 'Bool' argument.
--
-- If you give 'False', nothing will be added to the path segment.
--
-- Otherwise, this function will insert a value-less matrix parameter
-- under the name associated to your 'MatrixFlag'.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]
-- >
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getBooks :: Bool -> ExceptT String IO [Book]
-- > getBooks = client myApi host
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBooks" to query that endpoint.
-- > -- 'getBooksBy False' for all books
-- > -- 'getBooksBy True' to only get _already published_ books
instance (KnownSymbol sym, HasClient sublayout)
=> HasClient (MatrixFlag sym :> sublayout) where
type Client (MatrixFlag sym :> sublayout) =
Bool -> Client sublayout
clientWithRoute Proxy req baseurl manager flag =
clientWithRoute (Proxy :: Proxy sublayout)
(if flag
then appendToMatrixParams paramname Nothing req
else req
)
baseurl manager
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`.

7
servant-client/src/Servant/Common/Req.hs
View file

@ -72,13 +72,6 @@ appendToPath :: String -> Req -> Req
appendToPath p req =
req { reqPath = reqPath req ++ "/" ++ p }
appendToMatrixParams :: String
-> Maybe String
-> Req
-> Req
appendToMatrixParams pname pvalue req =
req { reqPath = reqPath req ++ ";" ++ pname ++ maybe "" ("=" ++) pvalue }
appendToQueryString :: Text -- ^ param name
-> Maybe Text -- ^ param value
-> Req

30
servant-client/test/Servant/ClientSpec.hs
View file

@ -96,9 +96,6 @@ type Api =
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
:<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
:<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
:<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
:<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
:<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
:<|> "rawSuccess" :> Raw
:<|> "rawFailure" :> Raw
:<|> "multiple" :>
@ -124,12 +121,6 @@ server = serve api (
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (\ name -> case name of
Just "alice" -> return alice
Just name -> throwE $ ServantErr 400 (name ++ " not found") "" []
Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
:<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
:<|> (\ a b c d -> return (a, b, c, d))
@ -198,26 +189,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
(left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
it "Servant.API.MatrixParam" $ \(_, baseUrl) -> do
let getMatrixParam = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
left show <$> runExceptT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runExceptT (getMatrixParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.MatrixParam.MatrixParams" $ \(_, baseUrl) -> do
let getMatrixParams = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
left show <$> runExceptT (getMatrixParams []) `shouldReturn` Right []
left show <$> runExceptT (getMatrixParams ["alice", "bob"])
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.MatrixParam.MatrixFlag" $
forM_ [False, True] $ \ flag ->
it (show flag) $ \(_, baseUrl) -> do
let getMatrixFlag = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
left show <$> runExceptT (getMatrixFlag flag) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
let getRawSuccess = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
it "Servant.API.Raw on success" $ do
res <- runExceptT (getRawSuccess methodGet)
case res of
Left e -> assertFailure $ show e

1
servant-server/servant-server.cabal
View file

@ -37,7 +37,6 @@ library
Servant.Server
Servant.Server.Internal
Servant.Server.Internal.Enter
Servant.Server.Internal.PathInfo
Servant.Server.Internal.Router
Servant.Server.Internal.RoutingApplication
Servant.Server.Internal.ServantErr

132
servant-server/src/Servant/Server/Internal.hs
View file

@ -14,7 +14,6 @@
module Servant.Server.Internal
( module Servant.Server.Internal
, module Servant.Server.Internal.PathInfo
, module Servant.Server.Internal.Router
, module Servant.Server.Internal.RoutingApplication
, module Servant.Server.Internal.ServantErr
@ -31,8 +30,6 @@ import Data.Maybe (mapMaybe, fromMaybe)
import Data.String (fromString)
import Data.String.Conversions (cs, (<>), ConvertibleStrings)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders)
@ -41,11 +38,10 @@ import Network.Wai (Application, lazyRequestBody,
rawQueryString, requestHeaders,
requestMethod, responseLBS, remoteHost,
isSecure, vault, httpVersion, Response,
Request)
Request, pathInfo)
import Servant.API ((:<|>) (..), (:>), Capture,
Delete, Get, Header,
IsSecure(..), MatrixFlag, MatrixParam,
MatrixParams, Patch, Post, Put,
IsSecure(..), Patch, Post, Put,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, Vault)
import Servant.API.ContentTypes (AcceptHeader (..),
@ -54,7 +50,6 @@ import Servant.API.ContentTypes (AcceptHeader (..),
import Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders,
getHeaders)
import Servant.Server.Internal.PathInfo
import Servant.Server.Internal.Router
import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr
@ -548,123 +543,6 @@ instance (KnownSymbol sym, HasServer sublayout)
examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False
parseMatrixText :: B.ByteString -> QueryText
parseMatrixText = parseQueryText
-- | If you use @'MatrixParam' "author" Text@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function
-- that takes an argument of type @'Maybe' 'Text'@.
--
-- This lets servant worry about looking it up in the query string
-- and turning it into a value of the type you specify, enclosed
-- in 'Maybe', because it may not be there and servant would then
-- hand you 'Nothing'.
--
-- You can control how it'll be converted from 'Text' to your type
-- by simply providing an instance of 'FromHttpApiData' for your type.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (MatrixParam sym a :> sublayout) where
type ServerT (MatrixParam sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
case parsePathInfo request of
(first : _)
-> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
param = case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string
Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type
route (Proxy :: Proxy sublayout) (feedTo subserver param)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
-- | If you use @'MatrixParams' "authors" Text@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function
-- that takes an argument of type @['Text']@.
--
-- This lets servant worry about looking up 0 or more values in the query string
-- associated to @authors@ and turning each of them into a value of
-- the type you specify.
--
-- You can control how the individual values are converted from 'Text' to your type
-- by simply providing an instance of 'FromHttpApiData' for your type.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
-- >
-- > server :: Server MyApi
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (MatrixParams sym a :> sublayout) where
type ServerT (MatrixParams sym a :> sublayout) m =
[a] -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
case parsePathInfo request of
(first : _)
-> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
-- if sym is "foo", we look for matrix parameters
-- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values
parameters = filter looksLikeParam matrixtext
values = mapMaybe (convert . snd) parameters
route (Proxy :: Proxy sublayout) (feedTo subserver values)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver [])
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing
convert (Just v) = parseQueryParamMaybe v
-- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function
-- that takes an argument of type 'Bool'.
--
-- Example:
--
-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]
-- >
-- > server :: Server MyApi
-- > server = getBooks
-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
instance (KnownSymbol sym, HasServer sublayout)
=> HasServer (MatrixFlag sym :> sublayout) where
type ServerT (MatrixFlag sym :> sublayout) m =
Bool -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request ->
case parsePathInfo request of
(first : _)
-> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
param = case lookup paramname matrixtext of
Just Nothing -> True -- param is there, with no value
Just (Just v) -> examine v -- param with a value
Nothing -> False -- param not in the query string
route (Proxy :: Proxy sublayout) (feedTo subserver param)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver False)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
examine v | v == "true" || v == "1" || v == "" = True
| otherwise = False
-- | Just pass the request to the underlying application and serve its response.
--
-- Example:
@ -762,5 +640,11 @@ instance HasServer api => HasServer (HttpVersion :> api) where
route Proxy subserver = WithRequest $ \req ->
route (Proxy :: Proxy api) (feedTo subserver $ httpVersion req)
pathIsEmpty :: Request -> Bool
pathIsEmpty = go . pathInfo
where go [] = True
go [""] = True
go _ = False
ct_wildcard :: B.ByteString
ct_wildcard = "*" <> "/" <> "*" -- Because CPP

38
servant-server/src/Servant/Server/Internal/PathInfo.hs
View file

@ -1,38 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Servant.Server.Internal.PathInfo where
import Data.List (unfoldr)
import Data.Text (Text)
import qualified Data.Text as T
import Network.Wai (Request, pathInfo)
-- | Like `null . pathInfo`, but works with redundant trailing slashes.
pathIsEmpty :: Request -> Bool
pathIsEmpty = f . processedPathInfo
where
f [] = True
f [""] = True
f _ = False
splitMatrixParameters :: Text -> (Text, Text)
splitMatrixParameters = T.break (== ';')
parsePathInfo :: Request -> [Text]
parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
where mergePairs = concat . unfoldr pairToList
pairToList [] = Nothing
pairToList ((a, b):xs) = Just ([a, b], xs)
-- | Returns a processed pathInfo from the request.
--
-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
-- processed, so routing works as intended. Therefor this function should be used to access
-- the pathInfo for routing purposes.
processedPathInfo :: Request -> [Text]
processedPathInfo r =
case pinfo of
(x:xs) | T.head x == ';' -> xs
_ -> pinfo
where pinfo = parsePathInfo r

5
servant-server/src/Servant/Server/Internal/Router.hs
View file

@ -7,7 +7,6 @@ import qualified Data.Map as M
import Data.Monoid ((<>))
import Data.Text (Text)
import Network.Wai (Request, Response, pathInfo)
import Servant.Server.Internal.PathInfo
import Servant.Server.Internal.RoutingApplication
type Router = Router' RoutingApplication
@ -59,14 +58,14 @@ runRouter :: Router -> RoutingApplication
runRouter (WithRequest router) request respond =
runRouter (router request) request respond
runRouter (StaticRouter table) request respond =
case processedPathInfo request of
case pathInfo request of
first : rest
| Just router <- M.lookup first table
-> let request' = request { pathInfo = rest }
in runRouter router request' respond
_ -> respond $ failWith NotFound
runRouter (DynamicRouter fun) request respond =
case processedPathInfo request of
case pathInfo request of
first : rest
-> let request' = request { pathInfo = rest }
in runRouter (fun first) request' respond

98
servant-server/test/Servant/ServerSpec.hs
View file

@ -38,13 +38,13 @@ import Test.Hspec (Spec, describe, it, shouldBe)
import Test.Hspec.Wai (get, liftIO, matchHeaders,
matchStatus, post, request,
shouldRespondWith, with, (<:>))
import Servant.API ((:<|>) (..), (:>),
addHeader, Capture,
Delete, Get, Header (..), Headers,
HttpVersion, IsSecure(..), JSON, MatrixFlag,
MatrixParam, MatrixParams, Patch, PlainText,
Post, Put, RemoteHost, QueryFlag, QueryParam,
QueryParams, Raw, ReqBody)
import Servant.API ((:<|>) (..), (:>), Capture, Delete,
Get, Header (..), Headers,
HttpVersion, IsSecure (..), JSON,
Patch, PlainText, Post, Put,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody,
addHeader)
import Servant.Server (Server, serve, ServantErr(..), err404)
import Servant.Server.Internal.Router
(tweakResponse, runRouter,
@ -95,7 +95,6 @@ spec = do
putSpec
patchSpec
queryParamSpec
matrixParamSpec
headerSpec
rawSpec
unionSpec
@ -275,89 +274,6 @@ queryParamSpec = do
name = "Alice"
}
type MatrixParamApi = "a" :> MatrixParam "name" String :> Get '[JSON] Person
:<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get '[JSON] Person
:<|> "c" :> MatrixFlag "capitalize" :> Get '[JSON] Person
:<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get '[JSON] Person
matrixParamApi :: Proxy MatrixParamApi
matrixParamApi = Proxy
mpServer :: Server MatrixParamApi
mpServer = matrixParamServer :<|> mpNames :<|> mpCapitalize alice :<|> mpComplex
where mpNames (_:name2:_) _ = return alice { name = name2 }
mpNames _ _ = return alice
mpCapitalize p False = return p
mpCapitalize p True = return p { name = map toUpper (name p) }
matrixParamServer (Just name) = return alice{name = name}
matrixParamServer Nothing = return alice
mpAge age p = return p { age = age }
mpComplex capture name cap = matrixParamServer name >>= flip mpCapitalize cap >>= mpAge capture
matrixParamSpec :: Spec
matrixParamSpec = do
describe "Servant.API.MatrixParam" $ do
it "allows to retrieve simple matrix parameters" $
(flip runSession) (serve matrixParamApi mpServer) $ do
response1 <- Network.Wai.Test.request defaultRequest{
pathInfo = ["a;name=bob"]
}
liftIO $ do
decode' (simpleBody response1) `shouldBe` Just alice{
name = "bob"
}
it "allows to retrieve lists in matrix parameters" $
(flip runSession) (serve matrixParamApi mpServer) $ do
response2 <- Network.Wai.Test.request defaultRequest{
pathInfo = ["b;names=bob;names=john", "bsub;names=anna;names=sarah"]
}
liftIO $
decode' (simpleBody response2) `shouldBe` Just alice{
name = "john"
}
it "allows to retrieve value-less matrix parameters" $
(flip runSession) (serve matrixParamApi mpServer) $ do
response3 <- Network.Wai.Test.request defaultRequest{
pathInfo = ["c;capitalize"]
}
liftIO $
decode' (simpleBody response3) `shouldBe` Just alice{
name = "ALICE"
}
response3' <- Network.Wai.Test.request defaultRequest{
pathInfo = ["c;capitalize="]
}
liftIO $
decode' (simpleBody response3') `shouldBe` Just alice{
name = "ALICE"
}
it "allows to retrieve matrix parameters on captured segments" $
(flip runSession) (serve matrixParamApi mpServer) $ do
response4 <- Network.Wai.Test.request defaultRequest{
pathInfo = ["d", "12;name=stephen;capitalize", "dsub"]
}
liftIO $
decode' (simpleBody response4) `shouldBe` Just alice{
name = "STEPHEN",
age = 12
}
response4' <- Network.Wai.Test.request defaultRequest{
pathInfo = ["d;ignored=1", "5", "dsub"]
}
liftIO $
decode' (simpleBody response4') `shouldBe` Just alice{
name = "Alice",
age = 5
}
type PostApi =
ReqBody '[JSON] Person :> Post '[JSON] Integer
:<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer

1
servant/servant.cabal
View file

@ -37,7 +37,6 @@ library
Servant.API.Post
Servant.API.Put
Servant.API.QueryParam
Servant.API.MatrixParam
Servant.API.Raw
Servant.API.RemoteHost
Servant.API.ReqBody

4
servant/src/Servant/API.hs
View file

@ -17,8 +17,6 @@ module Servant.API (
-- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@
module Servant.API.ReqBody,
-- | Accessing the request body as a JSON-encoded type: @'ReqBody'@
module Servant.API.MatrixParam,
-- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@
module Servant.API.RemoteHost,
-- | Retrieving the IP of the client
module Servant.API.IsSecure,
@ -71,8 +69,6 @@ import Servant.API.Get (Get)
import Servant.API.Header (Header (..))
import Servant.API.HttpVersion (HttpVersion (..))
import Servant.API.IsSecure (IsSecure (..))
import Servant.API.MatrixParam (MatrixFlag, MatrixParam,
MatrixParams)
import Servant.API.Patch (Patch)
import Servant.API.Post (Post)
import Servant.API.Put (Put)

51
servant/src/Servant/API/MatrixParam.hs
View file

@ -1,51 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.MatrixParam (MatrixFlag, MatrixParam, MatrixParams) where
import Data.Typeable (Typeable)
import GHC.TypeLits (Symbol)
-- | Lookup the value associated to the @sym@ matrix string parameter
-- and try to extract it as a value of type @a@.
--
-- Example:
--
-- >>> -- /books;author=<author name>
-- >>> type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book]
data MatrixParam (sym :: Symbol) a
deriving (Typeable)
-- | Lookup the values associated to the @sym@ matrix string parameter
-- and try to extract it as a value of type @[a]@. This is typically
-- meant to support matrix string parameters of the form
-- @param[]=val1;param[]=val2@ and so on. Note that servant doesn't actually
-- require the @[]@s and will fetch the values just fine with
-- @param=val1;param=val2@, too.
--
-- Example:
--
-- >>> -- /books;authors[]=<author1>;authors[]=<author2>;...
-- >>> type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book]
data MatrixParams (sym :: Symbol) a
deriving (Typeable)
-- | Lookup a potentially value-less matrix string parameter
-- with boolean semantics. If the param @sym@ is there without any value,
-- or if it's there with value "true" or "1", it's interpreted as 'True'.
-- Otherwise, it's interpreted as 'False'.
--
-- Example:
--
-- >>> -- /books;published
-- >>> type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book]
data MatrixFlag (sym :: Symbol)
deriving (Typeable)
-- $setup
-- >>> import Servant.API
-- >>> import Data.Aeson
-- >>> import Data.Text
-- >>> data Book
-- >>> instance ToJSON Book where { toJSON = undefined }

51
servant/src/Servant/Utils/Links.hs
View file

@ -117,7 +117,6 @@ import Web.HttpApiData
import Servant.API.Capture ( Capture )
import Servant.API.ReqBody ( ReqBody )
import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
import Servant.API.Header ( Header )
import Servant.API.Get ( Get )
import Servant.API.Post ( Post )
@ -173,9 +172,6 @@ type family IsElem endpoint api :: Constraint where
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
IsElem sa (QueryParams x y :> sb) = IsElem sa sb
IsElem sa (QueryFlag x :> sb) = IsElem sa sb
IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'
IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'
IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'
@ -192,10 +188,9 @@ type family IsSubList a b :: Constraint where
IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
-- Phantom types for Param
data Matrix
data Query
-- | Query/Matrix param
-- | Query param
data Param a
= SingleParam String Text
| ArrayElemParam String Text
@ -209,21 +204,6 @@ addQueryParam :: Param Query -> Link -> Link
addQueryParam qp l =
l { _queryParams = _queryParams l <> [qp] }
-- Not particularly efficient for many updates. Something to optimise if it's
-- a problem.
addMatrixParam :: Param Matrix -> Link -> Link
addMatrixParam param l = l { _segments = f (_segments l) }
where
f [] = []
f xs = init xs <> [g (last xs)]
-- Modify the segment at the "top" of the stack
g :: String -> String
g seg =
case param of
SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)
ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)
FlagParam k -> seg <> ";" <> k
linkURI :: Link -> URI
linkURI (Link segments q_params) =
URI mempty -- No scheme (relative)
@ -300,35 +280,6 @@ instance (KnownSymbol sym, HasLink sub)
where
k = symbolVal (Proxy :: Proxy sym)
-- MatrixParam instances
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (MatrixParam sym v :> sub) where
type MkLink (MatrixParam sym v :> sub) = Maybe v -> MkLink sub
toLink _ l mv =
toLink (Proxy :: Proxy sub) $
maybe id (addMatrixParam . SingleParam k . toQueryParam) mv l
where
k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (MatrixParams sym v :> sub) where
type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub
toLink _ l =
toLink (Proxy :: Proxy sub) .
foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toQueryParam v)) l') l
where
k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, HasLink sub)
=> HasLink (MatrixFlag sym :> sub) where
type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub
toLink _ l False =
toLink (Proxy :: Proxy sub) l
toLink _ l True =
toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
where
k = symbolVal (Proxy :: Proxy sym)
-- Misc instances
instance HasLink sub => HasLink (ReqBody ct a :> sub) where
type MkLink (ReqBody ct a :> sub) = MkLink sub

23
servant/test/Servant/Utils/LinksSpec.hs
View file

@ -11,14 +11,10 @@ import Data.Proxy ( Proxy(..) )
import Servant.API
type TestApi =
-- Capture and query/matrix params
-- Capture and query params
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] ()
:<|> "parent" :> MatrixParams "name" String :> "child"
:> MatrixParam "gender" String :> Get '[JSON] String
-- Flags
:<|> "ducks" :> MatrixFlag "yellow" :> MatrixFlag "loud" :> Delete '[JSON] ()
:<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] ()
-- All of the verbs
@ -34,7 +30,6 @@ type TestLink3 = "parent" :> "child" :> Get '[JSON] String
type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool
type BadTestLink2 = "greet" :> Get '[PlainText] Bool
type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get '[JSON] String
type BadTestLink' = "hello" :> "hi" :> Get '[OctetStream] Bool
type BadTestLink'2 = "greet" :> Get '[OctetStream] Bool
@ -54,7 +49,7 @@ shouldBeURI link expected =
spec :: Spec
spec = describe "Servant.Utils.Links" $ do
it "Generates correct links for capture query and matrix params" $ do
it "Generates correct links for capture query params" $ do
let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ())
apiLink l1 "hi" `shouldBeURI` "hello/hi"
@ -63,25 +58,13 @@ spec = describe "Servant.Utils.Links" $ do
:> Delete '[JSON] ())
apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String
:> "child"
:> MatrixParam "gender" String
:> Get '[JSON] String)
apiLink l3 ["Hubert?x=;&", "Cumberdale"] (Just "Edward?")
`shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\
\name[]=Cumberdale/child;gender=Edward%3F"
it "Generates correct links for query and matrix flags" $ do
it "Generates correct links for query flags" $ do
let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
:> QueryFlag "fast" :> Delete '[JSON] ())
apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
apiLink l1 False True `shouldBeURI` "balls?fast"
let l2 = Proxy :: Proxy ("ducks" :> MatrixFlag "yellow"
:> MatrixFlag "loud" :> Delete '[JSON] ())
apiLink l2 True True `shouldBeURI` "ducks;yellow;loud"
apiLink l2 False True `shouldBeURI` "ducks;loud"
it "Generates correct links for all of the verbs" $ do
apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"