diff --git a/servant-server/example/greet.hs b/servant-server/example/greet.hs index dca96612..65e4960b 100644 --- a/servant-server/example/greet.hs +++ b/servant-server/example/greet.hs @@ -85,7 +85,7 @@ server = (helloH :<|> postGreetH :<|> deleteGreetH :<|> otherRoutes) :<|> redire (\buildPath -> buildPath "Nicolas" (Just True)) redirect _ = pure $ - RedirectOf (Proxy @("bye" :> Capture "name" Text :> Get '[JSON] Text)) + RedirectOf (namedRoute @"bye" @OtherRoutes) (\buildPath -> buildPath "Gaƫl") -- Turn the server into a WAI app. 'serve' is provided by servant, diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index 69a4ceb0..d62e5b3b 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -143,7 +143,7 @@ import Servant.API.UVerb import Servant.API.Vault (Vault) import Servant.API.NamedRoutes - (NamedRoutes) + (NamedRoutes, namedRoute) import Servant.API.Verbs (Delete, DeleteAccepted, DeleteNoContent, DeleteNonAuthoritative, Get, GetAccepted, GetNoContent, diff --git a/servant/src/Servant/API/NamedRoutes.hs b/servant/src/Servant/API/NamedRoutes.hs index eefbe6d3..22aa9883 100644 --- a/servant/src/Servant/API/NamedRoutes.hs +++ b/servant/src/Servant/API/NamedRoutes.hs @@ -1,10 +1,28 @@ -{-# LANGUAGE KindSignatures #-} -{-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_HADDOCK not-home #-} module Servant.API.NamedRoutes ( -- * NamedRoutes combinator NamedRoutes + -- * Term-level helpers + , namedRoute ) where +import Data.Proxy (Proxy(..)) +import GHC.Records (HasField) +import GHC.TypeLits (Symbol) + +import Servant.API.Generic (AsApi) + +namedRoute + :: forall (field :: Symbol) (api :: * -> *) a. + HasField field (api AsApi) a + => Proxy a +namedRoute = Proxy + -- | Combinator for embedding a record of named routes into a Servant API type. data NamedRoutes (api :: * -> *) diff --git a/servant/src/Servant/API/TypeLevel.hs b/servant/src/Servant/API/TypeLevel.hs index 9e4313a2..4997201a 100644 --- a/servant/src/Servant/API/TypeLevel.hs +++ b/servant/src/Servant/API/TypeLevel.hs @@ -75,8 +75,6 @@ import Servant.API.UVerb import GHC.TypeLits (ErrorMessage (..), TypeError) - - -- * API predicates -- | Flatten API into a list of endpoints.