From afc76b8f6cf023840ce17ccb583e8e5cad7fabe4 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Thu, 8 Oct 2015 22:40:46 +0200 Subject: [PATCH 1/5] Remove MatrixParam. In servant, servant-server, and servant-client. --- servant-client/src/Servant/Client.hs | 128 ----------------- servant-client/src/Servant/Common/Req.hs | 7 - servant-client/test/Servant/ClientSpec.hs | 30 +--- servant-server/servant-server.cabal | 1 - servant-server/src/Servant/Server/Internal.hs | 132 ++---------------- .../src/Servant/Server/Internal/PathInfo.hs | 38 ----- .../src/Servant/Server/Internal/Router.hs | 5 +- servant-server/test/Servant/ServerSpec.hs | 98 +------------ servant/servant.cabal | 1 - servant/src/Servant/API.hs | 4 - servant/src/Servant/API/MatrixParam.hs | 51 ------- servant/src/Servant/Utils/Links.hs | 51 +------ servant/test/Servant/Utils/LinksSpec.hs | 23 +-- 13 files changed, 22 insertions(+), 547 deletions(-) delete mode 100644 servant-server/src/Servant/Server/Internal/PathInfo.hs delete mode 100644 servant/src/Servant/API/MatrixParam.hs diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 6a7b89c2..987a2bd4 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -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`. diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 4a7c1cba..38aa39b5 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -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 diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 04e69d31..7d41e8d9 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -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 diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal index 8704a437..1a7335d3 100644 --- a/servant-server/servant-server.cabal +++ b/servant-server/servant-server.cabal @@ -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 diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 2e6ade1a..c5e1cf70 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -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 diff --git a/servant-server/src/Servant/Server/Internal/PathInfo.hs b/servant-server/src/Servant/Server/Internal/PathInfo.hs deleted file mode 100644 index 454516f0..00000000 --- a/servant-server/src/Servant/Server/Internal/PathInfo.hs +++ /dev/null @@ -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 - diff --git a/servant-server/src/Servant/Server/Internal/Router.hs b/servant-server/src/Servant/Server/Internal/Router.hs index 89f7c144..6d41d6cd 100644 --- a/servant-server/src/Servant/Server/Internal/Router.hs +++ b/servant-server/src/Servant/Server/Internal/Router.hs @@ -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 diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 9c7e85c3..9926dea5 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -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 diff --git a/servant/servant.cabal b/servant/servant.cabal index 4e72b8af..854e499b 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -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 diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index f17f2b67..2e6abb2a 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -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) diff --git a/servant/src/Servant/API/MatrixParam.hs b/servant/src/Servant/API/MatrixParam.hs deleted file mode 100644 index f91c4050..00000000 --- a/servant/src/Servant/API/MatrixParam.hs +++ /dev/null @@ -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= --- >>> 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[]=;authors[]=;... --- >>> 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 } diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index 0b660797..b83d1178 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -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 diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index 07aeb051..c25cccb9 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -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" From ec55f4b981f81ca536913e1538cb1ef0959dd3b9 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Thu, 8 Oct 2015 23:33:32 +0200 Subject: [PATCH 2/5] Remove Matrix params. For servant-docs, -foreign, -js, and -mock. --- servant-docs/example/greet.hs | 9 +- servant-docs/example/greet.md | 75 +++++++------- servant-docs/src/Servant/Docs.hs | 121 +--------------------- servant-docs/src/Servant/Docs/Internal.hs | 60 +---------- servant-foreign/src/Servant/Foreign.hs | 65 +++--------- servant-js/src/Servant/JS/Internal.hs | 13 +-- servant-mock/src/Servant/Mock.hs | 11 -- 7 files changed, 60 insertions(+), 294 deletions(-) diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 50051258..e94e065b 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -46,13 +46,6 @@ instance ToParam (QueryParam "capital" Bool) where \Default is false." Normal -instance ToParam (MatrixParam "lang" String) where - toParam _ = - DocQueryParam "lang" - ["en", "sv", "fr"] - "Get the greeting message selected language. Default is en." - Normal - instance ToSample Greet where toSamples _ = [ ("If you use ?capital=true", Greet "HELLO, HASKELLER") @@ -81,7 +74,7 @@ intro2 = DocIntro "This title is below the last" -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText - "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet + "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet -- POST /greet with a Greet as JSON in the request body, -- returns a Greet as JSON diff --git a/servant-docs/example/greet.md b/servant-docs/example/greet.md index 16ab9782..67e1a666 100644 --- a/servant-docs/example/greet.md +++ b/servant-docs/example/greet.md @@ -1,10 +1,10 @@ -#### On proper introductions. +## On proper introductions. Hello there. As documentation is usually written for humans, it's often useful to introduce concepts with a few words. -#### This title is below the last +## This title is below the last You'll also note that multiple intros are possible. @@ -19,12 +19,13 @@ You'll also note that multiple intros are possible. - Example: `application/json` ```javascript -"Hello, haskeller!" +"HELLO, HASKELLER" ``` #### Response: - Status code 201 +- Headers: [("X-Example","1729")] - Supported content types are: @@ -42,22 +43,44 @@ You'll also note that multiple intros are possible. "Hello, haskeller" ``` -## GET /hello;lang=/:name +## DELETE /greet/:greetid + +#### Title + +This is some text + +#### Second secton + +And some more + +#### Captures: + +- *greetid*: identifier of the greet msg to remove + + +- This endpoint is sensitive to the value of the **unicorns** HTTP header. + +#### Response: + +- Status code 200 +- Headers: [] + +- Supported content types are: + + - `application/json` + +- Response body as below. + +```javascript +[] +``` + +## GET /hello/:name #### Captures: - *name*: name of the person to greet -#### Matrix Parameters: - -**hello**: - -- lang - - **Values**: *en, sv, fr* - - **Description**: Get the greeting message selected language. Default is en. - - - #### GET Parameters: - capital @@ -68,6 +91,7 @@ You'll also note that multiple intros are possible. #### Response: - Status code 200 +- Headers: [] - Supported content types are: @@ -98,27 +122,4 @@ You'll also note that multiple intros are possible. "Hello, haskeller" ``` -## DELETE /greet/:greetid - -#### Title - -This is some text - -#### Second secton - -And some more - -#### Captures: - -- *greetid*: identifier of the greet msg to remove - - -- This endpoint is sensitive to the value of the **unicorns** HTTP header. - -#### Response: - -- Status code 200 - -- No response body - diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index ac908c96..2f081127 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -20,126 +20,7 @@ -- The only thing you'll need to do will be to implement some classes -- for your captures, get parameters and request or response bodies. -- --- Here is a complete example that you can run to see the markdown pretty --- printer in action: --- --- > {-# LANGUAGE DataKinds #-} --- > {-# LANGUAGE DeriveGeneric #-} --- > {-# LANGUAGE FlexibleInstances #-} --- > {-# LANGUAGE MultiParamTypeClasses #-} --- > {-# LANGUAGE OverloadedStrings #-} --- > {-# LANGUAGE TypeOperators #-} --- > {-# OPTIONS_GHC -fno-warn-orphans #-} --- > import Control.Lens --- > import Data.Aeson --- > import Data.Proxy --- > import Data.String.Conversions --- > import Data.Text (Text) --- > import GHC.Generics --- > import Servant.API --- > import Servant.Docs --- > --- > -- * Example --- > --- > -- | A greet message data type --- > newtype Greet = Greet Text --- > deriving (Generic, Show) --- > --- > -- | We can get JSON support automatically. This will be used to parse --- > -- and encode a Greeting as 'JSON'. --- > instance FromJSON Greet --- > instance ToJSON Greet --- > --- > -- | We can also implement 'MimeRender' for additional formats like 'PlainText'. --- > instance MimeRender PlainText Greet where --- > mimeRender Proxy (Greet s) = "\"" <> cs s <> "\"" --- > --- > -- We add some useful annotations to our captures, --- > -- query parameters and request body to make the docs --- > -- really helpful. --- > instance ToCapture (Capture "name" Text) where --- > toCapture _ = DocCapture "name" "name of the person to greet" --- > --- > instance ToCapture (Capture "greetid" Text) where --- > toCapture _ = DocCapture "greetid" "identifier of the greet msg to remove" --- > --- > instance ToParam (QueryParam "capital" Bool) where --- > toParam _ = --- > DocQueryParam "capital" --- > ["true", "false"] --- > "Get the greeting message in uppercase (true) or not (false).\ --- > \Default is false." --- > Normal --- > --- > instance ToParam (MatrixParam "lang" String) where --- > toParam _ = --- > DocQueryParam "lang" --- > ["en", "sv", "fr"] --- > "Get the greeting message selected language. Default is en." --- > Normal --- > --- > instance ToSample Greet where --- > toSample _ = Just $ Greet "Hello, haskeller!" --- > --- > toSamples _ = --- > [ ("If you use ?capital=true", Greet "HELLO, HASKELLER") --- > , ("If you use ?capital=false", Greet "Hello, haskeller") --- > ] --- > --- > -- We define some introductory sections, these will appear at the top of the --- > -- documentation. --- > -- --- > -- We pass them in with 'docsWith', below. If you only want to add --- > -- introductions, you may use 'docsWithIntros' --- > intro1 :: DocIntro --- > intro1 = DocIntro "On proper introductions." -- The title --- > [ "Hello there." --- > , "As documentation is usually written for humans, it's often useful \ --- > \to introduce concepts with a few words." ] -- Elements are paragraphs --- > --- > intro2 :: DocIntro --- > intro2 = DocIntro "This title is below the last" --- > [ "You'll also note that multiple intros are possible." ] --- > --- > --- > -- API specification --- > type TestApi = --- > -- GET /hello/:name?capital={true, false} returns a Greet as JSON or PlainText --- > "hello" :> MatrixParam "lang" String :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON, PlainText] Greet --- > --- > -- POST /greet with a Greet as JSON in the request body, --- > -- returns a Greet as JSON --- > :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet --- > --- > -- DELETE /greet/:greetid --- > :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] () --- > --- > testApi :: Proxy TestApi --- > testApi = Proxy --- > --- > -- Build some extra information for the DELETE /greet/:greetid endpoint. We --- > -- want to add documentation about a secret unicorn header and some extra --- > -- notes. --- > extra :: ExtraInfo TestApi --- > extra = --- > extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] ())) $ --- > defAction & headers <>~ ["unicorns"] --- > & notes <>~ [ DocNote "Title" ["This is some text"] --- > , DocNote "Second secton" ["And some more"] --- > ] --- > --- > -- Generate the data that lets us have API docs. This --- > -- is derived from the type as well as from --- > -- the 'ToCapture', 'ToParam' and 'ToSample' instances from above. --- > -- --- > -- If you didn't want intros and extra information, you could just call: --- > -- --- > -- > docs testAPI :: API --- > docsGreet :: API --- > docsGreet = docsWith [intro1, intro2] extra testApi --- > --- > main :: IO () --- > main = putStrLn $ markdown docsGreet +-- See example/greet.hs for an example. module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, markdown diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index f02d8ac5..53ae472d 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -24,8 +24,7 @@ module Servant.Docs.Internal where import Control.Applicative import Control.Arrow (second) import Control.Lens (makeLenses, over, traversed, (%~), - (&), (.~), (<>~), (^.), _1, _2, - _last, (|>)) + (&), (.~), (<>~), (^.), (|>)) import qualified Control.Monad.Omega as Omega import Data.ByteString.Conversion (ToByteString, toByteString) import Data.ByteString.Lazy.Char8 (ByteString) @@ -546,7 +545,6 @@ markdown api = unlines $ "" : notesStr (action ^. notes) ++ capturesStr (action ^. captures) ++ - mxParamsStr (action ^. mxParams) ++ headersStr (action ^. headers) ++ paramsStr (action ^. params) ++ rqbodyStr (action ^. rqtypes) (action ^. rqbody) ++ @@ -590,20 +588,6 @@ markdown api = unlines $ captureStr cap = "- *" ++ (cap ^. capSymbol) ++ "*: " ++ (cap ^. capDesc) - mxParamsStr :: [(String, [DocQueryParam])] -> [String] - mxParamsStr [] = [] - mxParamsStr l = - "#### Matrix Parameters:" : - "" : - map segmentStr l - segmentStr :: (String, [DocQueryParam]) -> String - segmentStr (segment, l) = unlines $ - ("**" ++ segment ++ "**:") : - "" : - map paramStr l ++ - "" : - [] - headersStr :: [Text] -> [String] headersStr [] = [] headersStr l = [""] ++ map headerStr l ++ [""] @@ -898,48 +882,6 @@ instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout) action' = over params (|> toParam paramP) action -instance (KnownSymbol sym, ToParam (MatrixParam sym a), HasDocs sublayout) - => HasDocs (MatrixParam sym a :> sublayout) where - - docsFor Proxy (endpoint, action) = - docsFor sublayoutP (endpoint', action') - - where sublayoutP = Proxy :: Proxy sublayout - paramP = Proxy :: Proxy (MatrixParam sym a) - segment = endpoint ^. (path._last) - segment' = action ^. (mxParams._last._1) - endpoint' = over (path._last) (\p -> p ++ ";" ++ symbolVal symP ++ "=") endpoint - - action' = if segment' /= segment - -- This is the first matrix parameter for this segment, insert a new entry into the mxParams list - then over mxParams (|> (segment, [toParam paramP])) action - -- We've already inserted a matrix parameter for this segment, append to the existing list - else action & mxParams._last._2 <>~ [toParam paramP] - symP = Proxy :: Proxy sym - - -instance (KnownSymbol sym, {- ToParam (MatrixParams sym a), -} HasDocs sublayout) - => HasDocs (MatrixParams sym a :> sublayout) where - - docsFor Proxy (endpoint, action) = - docsFor sublayoutP (endpoint', action) - - where sublayoutP = Proxy :: Proxy sublayout - endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP ++ "="]) endpoint - symP = Proxy :: Proxy sym - - -instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout) - => HasDocs (MatrixFlag sym :> sublayout) where - - docsFor Proxy (endpoint, action) = - docsFor sublayoutP (endpoint', action) - - where sublayoutP = Proxy :: Proxy sublayout - - endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint - symP = Proxy :: Proxy sym - instance HasDocs Raw where docsFor _proxy (endpoint, action) _ = single endpoint action diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index d5ea0e29..49ef540d 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -20,7 +20,6 @@ module Servant.Foreign ( HasForeign(..) , Segment(..) , SegmentType(..) - , MatrixArg , FunctionName , QueryArg(..) , HeaderArg(..) @@ -47,15 +46,14 @@ module Servant.Foreign , module Servant.API ) where -import Control.Lens (makeLenses, (%~), (&), (.~), - (<>~), _last) -import Data.Monoid ((<>)) -import Data.Text -import Data.Proxy -import GHC.Exts (Constraint) -import GHC.TypeLits -import Servant.API -import Prelude hiding (concat) +import Control.Lens (makeLenses, (%~), (&), (.~), (<>~)) +import Data.Monoid ((<>)) +import Data.Proxy +import Data.Text +import GHC.Exts (Constraint) +import GHC.TypeLits +import Prelude hiding (concat) +import Servant.API -- | Function name builder that simply concat each part together concatCase :: FunctionName -> Text @@ -76,7 +74,7 @@ camelCase (p:ps) = concat $ p : camelCase' ps type Arg = Text -data Segment = Segment { _segment :: SegmentType, _matrix :: [MatrixArg] } +newtype Segment = Segment { _segment :: SegmentType } deriving (Eq, Show) data SegmentType = Static Text -- ^ a static path segment. like "/foo" @@ -105,8 +103,6 @@ data HeaderArg = HeaderArg } deriving (Eq, Show) -type MatrixArg = QueryArg - data Url = Url { _path :: Path , _queryStr :: [QueryArg] @@ -132,12 +128,12 @@ makeLenses ''Url makeLenses ''Req isCapture :: Segment -> Bool -isCapture (Segment (Cap _) _) = True -isCapture _ = False +isCapture (Segment (Cap _)) = True +isCapture _ = False captureArg :: Segment -> Arg -captureArg (Segment (Cap s) _) = s -captureArg _ = error "captureArg called on non capture" +captureArg (Segment (Cap s)) = s +captureArg _ = error "captureArg called on non capture" defReq :: Req defReq = Req defUrl "GET" [] False [] @@ -169,7 +165,7 @@ instance (KnownSymbol sym, HasForeign sublayout) foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Segment (Cap str) []] + req & reqUrl.path <>~ [Segment (Cap str)] & funcName %~ (++ ["by", str]) where str = pack . symbolVal $ (Proxy :: Proxy sym) @@ -242,37 +238,6 @@ instance (KnownSymbol sym, HasForeign sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) -instance (KnownSymbol sym, HasForeign sublayout) - => HasForeign (MatrixParam sym a :> sublayout) where - type Foreign (MatrixParam sym a :> sublayout) = Foreign sublayout - - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path._last.matrix <>~ [QueryArg strArg Normal] - - where str = pack . symbolVal $ (Proxy :: Proxy sym) - strArg = str <> "Value" - -instance (KnownSymbol sym, HasForeign sublayout) - => HasForeign (MatrixParams sym a :> sublayout) where - type Foreign (MatrixParams sym a :> sublayout) = Foreign sublayout - - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path._last.matrix <>~ [QueryArg str List] - - where str = pack . symbolVal $ (Proxy :: Proxy sym) - -instance (KnownSymbol sym, HasForeign sublayout) - => HasForeign (MatrixFlag sym :> sublayout) where - type Foreign (MatrixFlag sym :> sublayout) = Foreign sublayout - - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path._last.matrix <>~ [QueryArg str Flag] - - where str = pack . symbolVal $ (Proxy :: Proxy sym) - instance HasForeign Raw where type Foreign Raw = Method -> Req @@ -293,7 +258,7 @@ instance (KnownSymbol path, HasForeign sublayout) foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Segment (Static str) []] + req & reqUrl.path <>~ [Segment (Static str)] & funcName %~ (++ [str]) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index c53124f7..a5cb527c 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -9,7 +9,6 @@ module Servant.JS.Internal , segmentTypeToStr , jsParams , jsGParams - , jsMParams , paramToStr , toValidFunctionName , toJSHeader @@ -92,7 +91,7 @@ toValidFunctionName :: Text -> Text toValidFunctionName t = case T.uncons t of Just (x,xs) -> - setFirstChar x `T.cons` T.filter remainder xs + setFirstChar x `T.cons` T.filter remainder xs Nothing -> "_" where setFirstChar c = if firstChar c then c else '_' @@ -105,7 +104,7 @@ toValidFunctionName t = , Set.titlecaseLetter , Set.modifierLetter , Set.otherLetter - , Set.letterNumber + , Set.letterNumber ] remainderOK = firstLetterOK <> mconcat @@ -134,8 +133,8 @@ jsSegments [x] = "/" <> segmentToStr x False jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs segmentToStr :: Segment -> Bool -> Text -segmentToStr (Segment st ms) notTheEnd = - segmentTypeToStr st <> jsMParams ms <> if notTheEnd then "" else "'" +segmentToStr (Segment st) notTheEnd = + segmentTypeToStr st <> if notTheEnd then "" else "'" segmentTypeToStr :: SegmentType -> Text segmentTypeToStr (Static s) = s @@ -149,10 +148,6 @@ jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs jsParams :: [QueryArg] -> Text jsParams = jsGParams "&" -jsMParams :: [MatrixArg] -> Text -jsMParams [] = "" -jsMParams xs = ";" <> jsGParams ";" xs - paramToStr :: QueryArg -> Bool -> Text paramToStr qarg notTheEnd = case qarg ^. argType of diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs index bbd24b0e..3fa5d077 100644 --- a/servant-mock/src/Servant/Mock.hs +++ b/servant-mock/src/Servant/Mock.hs @@ -136,17 +136,6 @@ instance (KnownSymbol s, FromHttpApiData a, HasMock rest) instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where mock _ = \_ -> mock (Proxy :: Proxy rest) -instance (KnownSymbol s, FromHttpApiData a, HasMock rest) - => HasMock (MatrixParam s a :> rest) where - mock _ = \_ -> mock (Proxy :: Proxy rest) - -instance (KnownSymbol s, FromHttpApiData a, HasMock rest) - => HasMock (MatrixParams s a :> rest) where - mock _ = \_ -> mock (Proxy :: Proxy rest) - -instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where - mock _ = \_ -> mock (Proxy :: Proxy rest) - instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where mock _ = \_ -> mock (Proxy :: Proxy rest) From 2a894d861caf57ee5910a7c34537a3c1fab83252 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Fri, 9 Oct 2015 00:02:43 +0200 Subject: [PATCH 3/5] -Wall fixes --- servant-client/test/Servant/ClientSpec.hs | 19 ++++++++++++------- servant-foreign/src/Servant/Foreign.hs | 1 - 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 7d41e8d9..1d533ad8 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -18,6 +18,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fcontext-stack=100 #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Servant.ClientSpec where @@ -25,22 +26,26 @@ module Servant.ClientSpec where import Control.Applicative ((<$>)) #endif import Control.Arrow (left) -import Control.Concurrent -import Control.Exception -import Control.Monad.Trans.Except +import Control.Concurrent (forkIO, killThread, newEmptyMVar, + putMVar, readMVar) +import Control.Exception (bracket, finally) +import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Data.Aeson import Data.Char +import Data.Char (chr, isPrint) import Data.Foldable (forM_) import Data.Monoid hiding (getLast) import Data.Proxy import qualified Data.Text as T -import GHC.Generics +import GHC.Generics (Generic) import GHC.TypeLits import qualified Network.HTTP.Client as C import Network.HTTP.Media -import Network.HTTP.Types hiding (Header) +import Network.HTTP.Types (Method, Status (..), badRequest400, + methodGet, ok200) +import qualified Network.HTTP.Types as HTTP import Network.Socket -import Network.Wai hiding (Response) +import Network.Wai (Application, responseLBS) import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.Hspec @@ -117,7 +122,7 @@ server = serve api ( :<|> return :<|> (\ name -> case name of Just "alice" -> return alice - Just name -> throwE $ ServantErr 400 (name ++ " not found") "" [] + Just n -> throwE $ ServantErr 400 (n ++ " not found") "" [] Nothing -> throwE $ ServantErr 400 "missing parameter" "" []) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index 49ef540d..c12d6516 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -47,7 +47,6 @@ module Servant.Foreign ) where import Control.Lens (makeLenses, (%~), (&), (.~), (<>~)) -import Data.Monoid ((<>)) import Data.Proxy import Data.Text import GHC.Exts (Constraint) From 40686be83a20c430735e77ab639f0aa0f51cfae3 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Tue, 13 Oct 2015 21:45:22 +0200 Subject: [PATCH 4/5] Rebase fixes --- servant-client/test/Servant/ClientSpec.hs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 1d533ad8..fc3cdcfb 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -26,12 +26,10 @@ module Servant.ClientSpec where import Control.Applicative ((<$>)) #endif import Control.Arrow (left) -import Control.Concurrent (forkIO, killThread, newEmptyMVar, - putMVar, readMVar) -import Control.Exception (bracket, finally) +import Control.Concurrent (forkIO, killThread, ThreadId) +import Control.Exception (bracket) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Data.Aeson -import Data.Char import Data.Char (chr, isPrint) import Data.Foldable (forM_) import Data.Monoid hiding (getLast) @@ -41,9 +39,8 @@ import GHC.Generics (Generic) import GHC.TypeLits import qualified Network.HTTP.Client as C import Network.HTTP.Media -import Network.HTTP.Types (Method, Status (..), badRequest400, - methodGet, ok200) -import qualified Network.HTTP.Types as HTTP +import Network.HTTP.Types (Status (..), badRequest400, + methodGet, ok200, status400) import Network.Socket import Network.Wai (Application, responseLBS) import Network.Wai.Handler.Warp @@ -194,7 +191,8 @@ 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.Raw on success" $ do + it "Servant.API.Raw on success" $ \(_, baseUrl) -> do + let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager res <- runExceptT (getRawSuccess methodGet) case res of Left e -> assertFailure $ show e @@ -204,7 +202,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do C.responseStatus response `shouldBe` ok200 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do - let getRawFailure = getNth (Proxy :: Proxy 11) $ client api baseUrl manager + let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager res <- runExceptT (getRawFailure methodGet) case res of Right _ -> assertFailure "expected Left, but got Right" @@ -213,7 +211,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do Servant.Client.responseBody e `shouldBe` "rawFailure" it "Returns headers appropriately" $ \(_, baseUrl) -> do - let getRespHeaders = getNth (Proxy :: Proxy 13) $ client api baseUrl manager + let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager res <- runExceptT getRespHeaders case res of Left e -> assertFailure $ show e @@ -221,7 +219,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do modifyMaxSuccess (const 20) $ do it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) -> - let getMultiple = getNth (Proxy :: Proxy 12) $ client api baseUrl manager + let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> ioProperty $ do result <- left show <$> runExceptT (getMultiple cap num flag body) From c22b5d19389540cab0918faed05b76cf6a3a8916 Mon Sep 17 00:00:00 2001 From: "Julian K. Arni" Date: Tue, 13 Oct 2015 21:46:52 +0200 Subject: [PATCH 5/5] Changelogs for matrix params --- servant-client/CHANGELOG.md | 1 + servant-docs/CHANGELOG.md | 1 + servant-js/CHANGELOG.md | 1 + servant-server/CHANGELOG.md | 1 + servant/CHANGELOG.md | 1 + 5 files changed, 5 insertions(+) diff --git a/servant-client/CHANGELOG.md b/servant-client/CHANGELOG.md index a7cfed4a..2c9f5279 100644 --- a/servant-client/CHANGELOG.md +++ b/servant-client/CHANGELOG.md @@ -7,6 +7,7 @@ HEAD * `client` now takes an explicit `Manager` argument. * Use `http-api-data` instead of `Servant.Common.Text` * Client functions now consider any 2xx succesful. +* Remove matrix params. 0.4.1 ----- diff --git a/servant-docs/CHANGELOG.md b/servant-docs/CHANGELOG.md index d42daed7..a5be837a 100644 --- a/servant-docs/CHANGELOG.md +++ b/servant-docs/CHANGELOG.md @@ -8,6 +8,7 @@ HEAD * Add more `ToSamples` instances: `Bool`, `Ordering`, tuples (up to 7), `[]`, `Maybe`, `Either`, `Const`, `ZipList` and some monoids * Move `toSample` out of `ToSample` class * Add a few helper functions to define `toSamples` +* Remove matrix params. 0.4 --- diff --git a/servant-js/CHANGELOG.md b/servant-js/CHANGELOG.md index 2c115a02..575391d0 100644 --- a/servant-js/CHANGELOG.md +++ b/servant-js/CHANGELOG.md @@ -4,6 +4,7 @@ HEAD * Provide new targets for code generation along with the old jQuery one: vanilla Javascript and Angular.js * Greatly simplify usage of this library by reducing down the API to just 2 functions: `jsForAPI` and `writeJSForAPI` + the choice of a code generator * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators +* Remove matrix params. 0.4 --- diff --git a/servant-server/CHANGELOG.md b/servant-server/CHANGELOG.md index ce7acc78..eb46e994 100644 --- a/servant-server/CHANGELOG.md +++ b/servant-server/CHANGELOG.md @@ -4,6 +4,7 @@ HEAD * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators * Drop `EitherT` in favor of `ExceptT` * Use `http-api-data` instead of `Servant.Common.Text` +* Remove matrix params. 0.4.1 ----- diff --git a/servant/CHANGELOG.md b/servant/CHANGELOG.md index 82f3d816..012866f6 100644 --- a/servant/CHANGELOG.md +++ b/servant/CHANGELOG.md @@ -5,6 +5,7 @@ HEAD * Fix safeLink, so Header is not in fact required. * Add more instances for (:<|>) * Use `http-api-data` instead of `Servant.Common.Text` +* Remove matrix params. 0.4.2 -----