diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 03051533..6768d119 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -8,7 +8,7 @@ module Servant.API ( -- * Accessing information from the request module Servant.API.Capture, - -- | Capturing parts of the url path as parsed values: @'Capture'@ + -- | Capturing parts of the url path as parsed values: @'Capture'@ and @'CaptureAll'@ module Servant.API.Header, -- | Retrieving specific headers from the request module Servant.API.HttpVersion, @@ -49,7 +49,7 @@ module Servant.API ( ) where import Servant.API.Alternative ((:<|>) (..)) -import Servant.API.Capture (Capture) +import Servant.API.Capture (Capture, CaptureAll) import Servant.API.ContentTypes (Accept (..), FormUrlEncoded, FromFormUrlEncoded (..), JSON, MimeRender (..), NoContent (NoContent), diff --git a/servant/src/Servant/API/Capture.hs b/servant/src/Servant/API/Capture.hs index 9a2e1b61..8ea344cd 100644 --- a/servant/src/Servant/API/Capture.hs +++ b/servant/src/Servant/API/Capture.hs @@ -2,10 +2,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-} -module Servant.API.Capture (Capture) where +module Servant.API.Capture (Capture, CaptureAll) where import Data.Typeable (Typeable) import GHC.TypeLits (Symbol) + -- | Capture a value from the request path under a certain type @a@. -- -- Example: @@ -15,9 +16,20 @@ import GHC.TypeLits (Symbol) data Capture (sym :: Symbol) a deriving (Typeable) +-- | Capture all values from the request path under a certain type @a@. +-- +-- Example: +-- +-- >>> -- GET /src/* +-- >>> type MyApi = "src" :> CaptureAll Text :> Get '[JSON] SourceFile +data CaptureAll a + deriving (Typeable) + -- $setup -- >>> import Servant.API -- >>> import Data.Aeson -- >>> import Data.Text -- >>> data Book -- >>> instance ToJSON Book where { toJSON = undefined } +-- >>> data SourceFile +-- >>> instance ToJSON SourceFile where { toJSON = undefined } diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index d83ffc7e..ce3fc433 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -115,7 +115,7 @@ import GHC.TypeLits ( KnownSymbol, symbolVal ) import GHC.Exts(Constraint) import Web.HttpApiData -import Servant.API.Capture ( Capture ) +import Servant.API.Capture ( Capture, CaptureAll ) import Servant.API.ReqBody ( ReqBody ) import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag ) import Servant.API.Header ( Header ) @@ -291,6 +291,13 @@ instance (ToHttpApiData v, HasLink sub) toLink (Proxy :: Proxy sub) $ addSegment (escape . Text.unpack $ toUrlPiece v) l +instance (ToHttpApiData v, HasLink sub) + => HasLink (CaptureAll v :> sub) where + type MkLink (CaptureAll v :> sub) = [v] -> MkLink sub + toLink _ l vs = + toLink (Proxy :: Proxy sub) $ + foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs + instance HasLink sub => HasLink (Header sym a :> sub) where type MkLink (Header sym a :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub) diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index 07e0b068..2e36ee26 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -13,6 +13,7 @@ import Servant.API type TestApi = -- Capture and query params "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] () + :<|> "all" :> CaptureAll String :> Get '[JSON] () -- Flags :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] () @@ -46,6 +47,10 @@ spec = describe "Servant.Utils.Links" $ do :> Delete '[JSON] ()) apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true" + it "generates correct links for CaptureAll" $ do + apiLink (Proxy :: Proxy ("all" :> CaptureAll String :> Get '[JSON] ())) + ["roads", "lead", "to", "rome"] + `shouldBeURI` "all/roads/lead/to/rome" it "generates correct links for query flags" $ do let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"