@@ -13,19 +13,21 @@ import Data.Aeson (ToJSON, FromJSON, encode, decode')
1313import qualified Data.ByteString as B
1414import qualified Data.ByteString.Lazy as BL
1515import Data.IORef (newIORef, readIORef, writeIORef)
16+import Data.List (unfoldr)
1617import Data.Maybe (catMaybes)
1718import Data.Monoid (Monoid, mempty, mappend)
1819import Data.Proxy (Proxy(Proxy))
1920import Data.String (fromString)
2021import Data.String.Conversions (cs, (<>))
21−import Data.Text.Encoding (decodeUtf8)
22+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
2223import Data.Text (Text)
24+import qualified Data.Text as T
2325import GHC.TypeLits (KnownSymbol, symbolVal)
2426import Network.HTTP.Types hiding (Header)
2527import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
2628 strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
2729 rawQueryString, responseLBS)
28−import Servant.API (QueryParams, QueryParam, QueryFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..))
30+import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Raw, (:>), (:<|>)(..))
2931import Servant.Common.Text (FromText, fromText)
3032
3133data ReqBodyState = Uncalled
@@ -108,7 +110,7 @@ isMismatch _ = False
108110
109111-- | Like `null . pathInfo`, but works with redundant trailing slashes.
110112pathIsEmpty :: Request -> Bool
111−pathIsEmpty = f . pathInfo
113+pathIsEmpty = f . processedPathInfo
112114 where
113115 f [] = True
114116 f [""] = True
@@ -129,13 +131,36 @@ type RoutingApplication =
129131 Request -- ^ the request, the field 'pathInfo' may be modified by url routing
130132 -> (RouteResult Response -> IO ResponseReceived) -> IO ResponseReceived
131133
134+splitMatrixParameters :: Text -> (Text, Text)
135+splitMatrixParameters = T.break (== ';')
136+
137+parsePathInfo :: Request -> [Text]
138+parsePathInfo = filter (/= "") . mergePairs . map splitMatrixParameters . pathInfo
139+ where mergePairs = concat . unfoldr pairToList
140+ pairToList [] = Nothing
141+ pairToList ((a, b):xs) = Just ([a, b], xs)
142+
143+-- | Returns a processed pathInfo from the request.
144+--
145+-- In order to handle matrix parameters in the request correctly, the raw pathInfo needs to be
146+-- processed, so routing works as intended. Therefor this function should be used to access
147+-- the pathInfo for routing purposes.
148+processedPathInfo :: Request -> [Text]
149+processedPathInfo r =
150+ case pinfo of
151+ (x:xs) | T.head x == ';' -> xs
152+ _ -> pinfo
153+ where pinfo = parsePathInfo r
154+
132155class HasServer layout where
133156 type Server layout :: *
134157 route :: Proxy layout -> Server layout -> RoutingApplication
135158
159+
160+
136161-- * Instances
137162
138−-- | A server for @a ':<|>' b@ first tries to match the request again the route
163+-- | A server for @a ':<|>' b@ first tries to match the request against the route
139164-- represented by @a@ and if it fails tries @b@. You must provide a request
140165-- handler for each route.
141166--
@@ -183,7 +208,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
183208 type Server (Capture capture a :> sublayout) =
184209 a -> Server sublayout
185210
186− route Proxy subserver request respond = case pathInfo request of
211+ route Proxy subserver request respond = case processedPathInfo request of
187212 (first : rest)
188213 -> case captured captureProxy first of
189214 Nothing -> respond $ failWith NotFound
@@ -193,6 +218,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
193218 _ -> respond $ failWith NotFound
194219
195220 where captureProxy = Proxy :: Proxy (Capture capture a)
221+
196222
197223-- | If you have a 'Delete' endpoint in your API,
198224-- the handler for this endpoint is meant to delete
@@ -441,6 +467,124 @@ instance (KnownSymbol sym, HasServer sublayout)
441467 examine v | v == "true" || v == "1" || v == "" = True
442468 | otherwise = False
443469
470+parseMatrixText :: B.ByteString -> QueryText
471+parseMatrixText = parseQueryText
472+
473+-- | If you use @'MatrixParam' "author" Text@ in one of the endpoints for your API,
474+-- this automatically requires your server-side handler to be a function
475+-- that takes an argument of type @'Maybe' 'Text'@.
476+--
477+-- This lets servant worry about looking it up in the query string
478+-- and turning it into a value of the type you specify, enclosed
479+-- in 'Maybe', because it may not be there and servant would then
480+-- hand you 'Nothing'.
481+--
482+-- You can control how it'll be converted from 'Text' to your type
483+-- by simply providing an instance of 'FromText' for your type.
484+--
485+-- Example:
486+--
487+-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
488+-- >
489+-- > server :: Server MyApi
490+-- > server = getBooksBy
491+-- > where getBooksBy :: Maybe Text -> EitherT (Int, String) IO [Book]
492+-- > getBooksBy Nothing = ...return all books...
493+-- > getBooksBy (Just author) = ...return books by the given author...
494+instance (KnownSymbol sym, FromText a, HasServer sublayout)
495+ => HasServer (MatrixParam sym a :> sublayout) where
496+
497+ type Server (MatrixParam sym a :> sublayout) =
498+ Maybe a -> Server sublayout
499+
500+ route Proxy subserver request respond = case parsePathInfo request of
501+ (first : _)
502+ -> do let querytext = parseMatrixText . encodeUtf8 $ T.tail first
503+ param = case lookup paramname querytext of
504+ Nothing -> Nothing -- param absent from the query string
505+ Just Nothing -> Nothing -- param present with no value -> Nothing
506+ Just (Just v) -> fromText v -- if present, we try to convert to
507+ -- the right type
508+ route (Proxy :: Proxy sublayout) (subserver param) request respond
509+ _ -> route (Proxy :: Proxy sublayout) (subserver Nothing) request respond
510+
511+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
512+
513+-- | If you use @'MatrixParams' "authors" Text@ in one of the endpoints for your API,
514+-- this automatically requires your server-side handler to be a function
515+-- that takes an argument of type @['Text']@.
516+--
517+-- This lets servant worry about looking up 0 or more values in the query string
518+-- associated to @authors@ and turning each of them into a value of
519+-- the type you specify.
520+--
521+-- You can control how the individual values are converted from 'Text' to your type
522+-- by simply providing an instance of 'FromText' for your type.
523+--
524+-- Example:
525+--
526+-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
527+-- >
528+-- > server :: Server MyApi
529+-- > server = getBooksBy
530+-- > where getBooksBy :: [Text] -> EitherT (Int, String) IO [Book]
531+-- > getBooksBy authors = ...return all books by these authors...
532+instance (KnownSymbol sym, FromText a, HasServer sublayout)
533+ => HasServer (MatrixParams sym a :> sublayout) where
534+
535+ type Server (MatrixParams sym a :> sublayout) =
536+ [a] -> Server sublayout
537+
538+ route Proxy subserver request respond = case parsePathInfo request of
539+ (first : _)
540+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
541+ -- if sym is "foo", we look for matrix parameters
542+ -- named "foo" or "foo[]" and call fromText on the
543+ -- corresponding values
544+ parameters = filter looksLikeParam matrixtext
545+ values = catMaybes $ map (convert . snd) parameters
546+ route (Proxy :: Proxy sublayout) (subserver values) request respond
547+ _ -> route (Proxy :: Proxy sublayout) (subserver []) request respond
548+
549+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
550+ looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
551+ convert Nothing = Nothing
552+ convert (Just v) = fromText v
553+
554+-- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API,
555+-- this automatically requires your server-side handler to be a function
556+-- that takes an argument of type 'Bool'.
557+--
558+-- Example:
559+--
560+-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]
561+-- >
562+-- > server :: Server MyApi
563+-- > server = getBooks
564+-- > where getBooks :: Bool -> EitherT (Int, String) IO [Book]
565+-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
566+instance (KnownSymbol sym, HasServer sublayout)
567+ => HasServer (MatrixFlag sym :> sublayout) where
568+
569+ type Server (MatrixFlag sym :> sublayout) =
570+ Bool -> Server sublayout
571+
572+ route Proxy subserver request respond = case parsePathInfo request of
573+ (first : _)
574+ -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
575+ param = case lookup paramname matrixtext of
576+ Just Nothing -> True -- param is there, with no value
577+ Just (Just v) -> examine v -- param with a value
578+ Nothing -> False -- param not in the query string
579+
580+ route (Proxy :: Proxy sublayout) (subserver param) request respond
581+
582+ _ -> route (Proxy :: Proxy sublayout) (subserver False) request respond
583+
584+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
585+ examine v | v == "true" || v == "1" || v == "" = True
586+ | otherwise = False
587+
444588-- | Just pass the request to the underlying application and serve its response.
445589--
446590-- Example:
@@ -486,7 +630,7 @@ instance (FromJSON a, HasServer sublayout)
486630-- pass the rest of the request path to @sublayout@.
487631instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout) where
488632 type Server (path :> sublayout) = Server sublayout
489− route Proxy subserver request respond = case pathInfo request of
633+ route Proxy subserver request respond = case processedPathInfo request of
490634 (first : rest)
491635 | first == cs (symbolVal proxyPath)
492636 -> route (Proxy :: Proxy sublayout) subserver request{