Named-based selection of sub-API

This commit is contained in:
Gaël Deest 2022-04-13 13:39:45 +02:00
parent 0f82519899
commit 8ed061b931
4 changed files with 22 additions and 6 deletions

View file

@ -85,7 +85,7 @@ server = (helloH :<|> postGreetH :<|> deleteGreetH :<|> otherRoutes) :<|> redire
(\buildPath -> buildPath "Nicolas" (Just True)) (\buildPath -> buildPath "Nicolas" (Just True))
redirect _ = pure $ redirect _ = pure $
RedirectOf (Proxy @("bye" :> Capture "name" Text :> Get '[JSON] Text)) RedirectOf (namedRoute @"bye" @OtherRoutes)
(\buildPath -> buildPath "Gaël") (\buildPath -> buildPath "Gaël")
-- Turn the server into a WAI app. 'serve' is provided by servant, -- Turn the server into a WAI app. 'serve' is provided by servant,

View file

@ -143,7 +143,7 @@ import Servant.API.UVerb
import Servant.API.Vault import Servant.API.Vault
(Vault) (Vault)
import Servant.API.NamedRoutes import Servant.API.NamedRoutes
(NamedRoutes) (NamedRoutes, namedRoute)
import Servant.API.Verbs import Servant.API.Verbs
(Delete, DeleteAccepted, DeleteNoContent, (Delete, DeleteAccepted, DeleteNoContent,
DeleteNonAuthoritative, Get, GetAccepted, GetNoContent, DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,

View file

@ -1,10 +1,28 @@
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.NamedRoutes ( module Servant.API.NamedRoutes (
-- * NamedRoutes combinator -- * NamedRoutes combinator
NamedRoutes NamedRoutes
-- * Term-level helpers
, namedRoute
) where ) 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. -- | Combinator for embedding a record of named routes into a Servant API type.
data NamedRoutes (api :: * -> *) data NamedRoutes (api :: * -> *)

View file

@ -75,8 +75,6 @@ import Servant.API.UVerb
import GHC.TypeLits import GHC.TypeLits
(ErrorMessage (..), TypeError) (ErrorMessage (..), TypeError)
-- * API predicates -- * API predicates
-- | Flatten API into a list of endpoints. -- | Flatten API into a list of endpoints.