eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

servant-swagger: tag NamedRoutes endpoints with datatype name

Browse source
This commit is contained in:
Isaac Elliott 2022-04-29 16:38:29 +10:00
parent cb310b8294
commit ae8e1e6003
1 changed files with 10 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
servant-swagger/src/Servant/Swagger/Internal.hs
View file

@ -3,11 +3,13 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#endif #endif
@ -30,12 +32,13 @@ import qualified Data.Swagger as Swagger
import Data.Swagger.Declare import Data.Swagger.Declare
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import GHC.Generics (Rep, datatypeName, D1, Meta(..))
import GHC.TypeLits import GHC.TypeLits
import Network.HTTP.Media (MediaType) import Network.HTTP.Media (MediaType)
import Servant.API import Servant.API
import Servant.API.Description (FoldDescription, import Servant.API.Description (FoldDescription,
reflectDescription) reflectDescription)
import Servant.API.Generic (ToServantApi) import Servant.API.Generic (ToServantApi, AsApi)
import Servant.API.Modifiers (FoldRequired) import Servant.API.Modifiers (FoldRequired)
import Servant.Swagger.Internal.TypeLevel.API import Servant.Swagger.Internal.TypeLevel.API
@ -150,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty
addParam :: Param -> Swagger -> Swagger addParam :: Param -> Swagger -> Swagger
addParam param = allOperations.parameters %~ (Inline param :) addParam param = allOperations.parameters %~ (Inline param :)
-- | Add a tag to every operation in the spec.
addTag :: Text -> Swagger -> Swagger
addTag tag = allOperations.tags %~ ([tag] <>)
-- | Add accepted content types to every operation in the spec. -- | Add accepted content types to every operation in the spec.
addConsumes :: [MediaType] -> Swagger -> Swagger addConsumes :: [MediaType] -> Swagger -> Swagger
addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs)) addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@ -440,8 +447,8 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
& required ?~ True & required ?~ True
& schema .~ ParamBody ref & schema .~ ParamBody ref
instance HasSwagger (ToServantApi routes) => HasSwagger (NamedRoutes routes) where instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
toSwagger _ = toSwagger (Proxy :: Proxy (ToServantApi routes)) toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))
-- ======================================================================= -- =======================================================================
-- Below are the definitions that should be in Servant.API.ContentTypes -- Below are the definitions that should be in Servant.API.ContentTypes