diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 5ea7b480..cbb0db09 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, @@ -60,7 +60,7 @@ module Servant.API ( import Servant.API.Alternative ((:<|>) (..)) import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..)) -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..7ee7972a 100644 --- a/servant/src/Servant/API/Capture.hs +++ b/servant/src/Servant/API/Capture.hs @@ -2,7 +2,7 @@ {-# 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) @@ -15,9 +15,22 @@ import GHC.TypeLits (Symbol) data Capture (sym :: Symbol) a deriving (Typeable) + +-- | Capture all remaining values from the request path under a certain type +-- @a@. +-- +-- Example: +-- +-- >>> -- GET /src/* +-- >>> type MyAPI = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile +data CaptureAll (sym :: Symbol) 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 c312997c..d6b218be 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -107,7 +107,7 @@ import Prelude.Compat import Web.HttpApiData import Servant.API.BasicAuth ( BasicAuth ) -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 ) @@ -163,6 +163,8 @@ type family IsElem endpoint api :: Constraint where IsElem sa (ReqBody y x :> sb) = IsElem sa sb IsElem (Capture z y :> sa) (Capture x y :> sb) = IsElem sa sb + IsElem (CaptureAll z y :> sa) (CaptureAll x y :> sb) + = IsElem sa sb 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 @@ -284,6 +286,13 @@ instance (ToHttpApiData v, HasLink sub) toLink (Proxy :: Proxy sub) $ addSegment (escape . Text.unpack $ toUrlPiece v) l +instance (ToHttpApiData v, HasLink sub) + => HasLink (CaptureAll sym v :> sub) where + type MkLink (CaptureAll sym 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 5a7ea4c4..2040fc55 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] NoContent + :<|> "all" :> CaptureAll "names" String :> Get '[JSON] NoContent -- Flags :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] NoContent @@ -46,6 +47,10 @@ spec = describe "Servant.Utils.Links" $ do :> Delete '[JSON] NoContent) apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true" + it "generates correct links for CaptureAll" $ do + apiLink (Proxy :: Proxy ("all" :> CaptureAll "names" String :> Get '[JSON] NoContent)) + ["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"