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

servant-swagger: tag NamedRoutes endpoints with datatype name

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 FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE UndecidableInstances #-}
#endif
@ -30,12 +32,13 @@ import qualified Data.Swagger as Swagger
import Data.Swagger.Declare
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Rep, datatypeName, D1, Meta(..))
import GHC.TypeLits
import Network.HTTP.Media (MediaType)
import Servant.API
import Servant.API.Description (FoldDescription,
reflectDescription)
import Servant.API.Generic (ToServantApi)
import Servant.API.Generic (ToServantApi, AsApi)
import Servant.API.Modifiers (FoldRequired)
import Servant.Swagger.Internal.TypeLevel.API
@ -150,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty
addParam :: Param -> Swagger -> Swagger
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.
addConsumes :: [MediaType] -> Swagger -> Swagger
addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@ -440,8 +447,8 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
& required ?~ True
& schema .~ ParamBody ref
instance HasSwagger (ToServantApi routes) => HasSwagger (NamedRoutes routes) where
toSwagger _ = toSwagger (Proxy :: Proxy (ToServantApi routes))
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