git.iko.soy/typeable/servant
on master help sign in
Add CaptureAll to the API definitions
commita616a8d6898363e16b8ef658c68ac9481054c0d4 authorJonathan Lange <jml@mumak.net> dateThu 26 May 2016, 16:49 (10 years ago) parent8eb412f
4 files changed+31−4
servant/src/Servant/API.hs+2−2 servant/src/Servant/API/Capture.hs+14−1 servant/src/Servant/Utils/Links.hs+10−1 servant/test/Servant/Utils/LinksSpec.hs+5
servant/src/Servant/API.hs+2−2
@@ -8,7 +8,7 @@ module Servant.API (
88
99 -- * Accessing information from the request
1010 module Servant.API.Capture,
11− -- | Capturing parts of the url path as parsed values: @'Capture'@
11+ -- | Capturing parts of the url path as parsed values: @'Capture'@ and @'CaptureAll'@
1212 module Servant.API.Header,
1313 -- | Retrieving specific headers from the request
1414 module Servant.API.HttpVersion,
@@ -60,7 +60,7 @@ module Servant.API (
6060
6161import Servant.API.Alternative ((:<|>) (..))
6262import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
63−import Servant.API.Capture (Capture)
63+import Servant.API.Capture (Capture, CaptureAll)
6464import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
6565 FromFormUrlEncoded (..), JSON,
6666 MimeRender (..), NoContent (NoContent),
servant/src/Servant/API/Capture.hs+14−1
@@ -2,7 +2,7 @@
22{-# LANGUAGE DeriveDataTypeable #-}
33{-# LANGUAGE PolyKinds #-}
44{-# OPTIONS_HADDOCK not-home #-}
5−module Servant.API.Capture (Capture) where
5+module Servant.API.Capture (Capture, CaptureAll) where
66
77import Data.Typeable (Typeable)
88import GHC.TypeLits (Symbol)
@@ -15,9 +15,22 @@ import GHC.TypeLits (Symbol)
1515data Capture (sym :: Symbol) a
1616 deriving (Typeable)
1717
18+
19+-- | Capture all remaining values from the request path under a certain type
20+-- @a@.
21+--
22+-- Example:
23+--
24+-- >>> -- GET /src/*
25+-- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile
26+data CaptureAll (sym :: Symbol) a
27+ deriving (Typeable)
28+
1829-- $setup
1930-- >>> import Servant.API
2031-- >>> import Data.Aeson
2132-- >>> import Data.Text
2233-- >>> data Book
2334-- >>> instance ToJSON Book where { toJSON = undefined }
35+-- >>> data SourceFile
36+-- >>> instance ToJSON SourceFile where { toJSON = undefined }
servant/src/Servant/Utils/Links.hs+10−1
@@ -107,7 +107,7 @@ import Prelude.Compat
107107
108108import Web.HttpApiData
109109import Servant.API.BasicAuth ( BasicAuth )
110−import Servant.API.Capture ( Capture )
110+import Servant.API.Capture ( Capture, CaptureAll )
111111import Servant.API.ReqBody ( ReqBody )
112112import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
113113import Servant.API.Header ( Header )
@@ -163,6 +163,8 @@ type family IsElem endpoint api :: Constraint where
163163 IsElem sa (ReqBody y x :> sb) = IsElem sa sb
164164 IsElem (Capture z y :> sa) (Capture x y :> sb)
165165 = IsElem sa sb
166+ IsElem (CaptureAll z y :> sa) (CaptureAll x y :> sb)
167+ = IsElem sa sb
166168 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
167169 IsElem sa (QueryParams x y :> sb) = IsElem sa sb
168170 IsElem sa (QueryFlag x :> sb) = IsElem sa sb
@@ -284,6 +286,13 @@ instance (ToHttpApiData v, HasLink sub)
284286 toLink (Proxy :: Proxy sub) $
285287 addSegment (escape . Text.unpack $ toUrlPiece v) l
286288
289+instance (ToHttpApiData v, HasLink sub)
290+ => HasLink (CaptureAll sym v :> sub) where
291+ type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
292+ toLink _ l vs =
293+ toLink (Proxy :: Proxy sub) $
294+ foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs
295+
287296instance HasLink sub => HasLink (Header sym a :> sub) where
288297 type MkLink (Header sym a :> sub) = MkLink sub
289298 toLink _ = toLink (Proxy :: Proxy sub)
servant/test/Servant/Utils/LinksSpec.hs+5
@@ -13,6 +13,7 @@ import Servant.API
1313type TestApi =
1414 -- Capture and query params
1515 "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] NoContent
16+ :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent
1617
1718 -- Flags
1819 :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] NoContent
@@ -46,6 +47,10 @@ spec = describe "Servant.Utils.Links" $ do
4647 :> Delete '[JSON] NoContent)
4748 apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
4849
50+ it "generates correct links for CaptureAll" $ do
51+ apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent))
52+ ["roads", "lead", "to", "rome"]
53+ `shouldBeURI` "all/roads/lead/to/rome"
4954
5055 it "generates correct links for query flags" $ do
5156 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"