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

Merge pull request #1588 from LightAndLight/master

Browse source 
Add HasSwagger instance for NamedRoutes
This commit is contained in:
Gaël Deest 2022-05-13 07:41:12 +02:00 committed by GitHub
commit 8ef5021a5f
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 11 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
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,11 +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 (D1, Meta(..), Rep)
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, AsApi)
import Servant.API.Modifiers (FoldRequired) import Servant.API.Modifiers (FoldRequired)
import Servant.Swagger.Internal.TypeLevel.API import Servant.Swagger.Internal.TypeLevel.API
@ -149,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))
@ -439,6 +447,9 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
& required ?~ True & required ?~ True
& schema .~ ParamBody ref & schema .~ ParamBody ref
instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
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
-- ======================================================================= -- =======================================================================