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

Merge pull request #252 from haskell-servant/jkarni/removeMatrix

Browse source 
Remove matrix
This commit is contained in:
Julian Arni 2015-10-14 08:52:08 +02:00
commit c970b2bffe
25 changed files with 99 additions and 851 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/CHANGELOG.md
View file

@ -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
-----

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

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

@ -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,23 @@ 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, 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)
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 (Status (..), badRequest400,
methodGet, ok200, status400)
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
@ -96,9 +98,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" :>
@ -120,13 +119,7 @@ server = serve api (
:<|> 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
:<|> (\ 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
@ -198,26 +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.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
let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
res <- runExceptT (getRawSuccess methodGet)
case res of
Left e -> assertFailure $ show e
@ -227,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"
@ -236,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
@ -244,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)

1
servant-docs/CHANGELOG.md
View file

@ -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
---

9
servant-docs/example/greet.hs
View file

@ -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

75
servant-docs/example/greet.md
View file

@ -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=<value>/: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

121
servant-docs/src/Servant/Docs.hs
View file

@ -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

60
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -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 ++ "=<value>") 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 ++ "=<value>"]) 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

52
servant-foreign/src/Servant/Foreign.hs
View file

@ -20,7 +20,6 @@ module Servant.Foreign
( HasForeign(..)
, Segment(..)
, SegmentType(..)
, MatrixArg
, FunctionName
, QueryArg(..)
, HeaderArg(..)
@ -47,15 +46,13 @@ module Servant.Foreign
, module Servant.API
) where
import Control.Lens (makeLenses, (%~), (&), (.~),
(<>~), _last)
import Data.Monoid ((<>))
import Data.Text
import Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
import Data.Proxy
import Data.Text
import GHC.Exts (Constraint)
import GHC.TypeLits
import Servant.API
import Prelude hiding (concat)
import Servant.API
-- | Function name builder that simply concat each part together
concatCase :: FunctionName -> Text
@ -76,7 +73,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 +102,6 @@ data HeaderArg = HeaderArg
} deriving (Eq, Show)
type MatrixArg = QueryArg
data Url = Url
{ _path :: Path
, _queryStr :: [QueryArg]
@ -132,11 +127,11 @@ makeLenses ''Url
makeLenses ''Req
isCapture :: Segment -> Bool
isCapture (Segment (Cap _) _) = True
isCapture (Segment (Cap _)) = True
isCapture _ = False
captureArg :: Segment -> Arg
captureArg (Segment (Cap s) _) = s
captureArg (Segment (Cap s)) = s
captureArg _ = error "captureArg called on non capture"
defReq :: Req
@ -169,7 +164,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 +237,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 +257,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)

1
servant-js/CHANGELOG.md
View file

@ -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
---

9
servant-js/src/Servant/JS/Internal.hs
View file

@ -9,7 +9,6 @@ module Servant.JS.Internal
, segmentTypeToStr
, jsParams
, jsGParams
, jsMParams
, paramToStr
, toValidFunctionName
, toJSHeader
@ -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

11
servant-mock/src/Servant/Mock.hs
View file

@ -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)

1
servant-server/CHANGELOG.md
View file

@ -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
-----

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/CHANGELOG.md
View file

@ -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
-----

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"