on master help sign in
Merge pull request #1588 from LightAndLight/master

Add HasSwagger instance for NamedRoutes

commit8ef5021a5fbd2893a2f6fef6c70a60e61be20aac authorGaël Deest <gael.deest@tweag.io> dateFri 13 May 2022, 07:41 (4 years ago) parent036102a59b5fe6
1 file changed+11
servant-swagger/src/Servant/Swagger/Internal.hs+11
servant-swagger/src/Servant/Swagger/Internal.hs+11
@@ -3,11 +3,13 @@
33{-# LANGUAGE DataKinds #-}
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedLists #-}
67{-# LANGUAGE OverloadedStrings #-}
78{-# LANGUAGE PolyKinds #-}
89{-# LANGUAGE RankNTypes #-}
910{-# LANGUAGE ScopedTypeVariables #-}
1011{-# LANGUAGE TypeOperators #-}
12+{-# LANGUAGE TypeFamilies #-}
1113#if __GLASGOW_HASKELL__ >= 806
1214{-# LANGUAGE UndecidableInstances #-}
1315#endif
@@ -30,11 +32,13 @@ import qualified Data.Swagger as Swagger
3032import Data.Swagger.Declare
3133import Data.Text (Text)
3234import qualified Data.Text as Text
35+import GHC.Generics (D1, Meta(..), Rep)
3336import GHC.TypeLits
3437import Network.HTTP.Media (MediaType)
3538import Servant.API
3639import Servant.API.Description (FoldDescription,
3740 reflectDescription)
41+import Servant.API.Generic (ToServantApi, AsApi)
3842import Servant.API.Modifiers (FoldRequired)
3943
4044import Servant.Swagger.Internal.TypeLevel.API
@@ -149,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty
149153addParam :: Param -> Swagger -> Swagger
150154addParam param = allOperations.parameters %~ (Inline param :)
151155
156+-- | Add a tag to every operation in the spec.
157+addTag :: Text -> Swagger -> Swagger
158+addTag tag = allOperations.tags %~ ([tag] <>)
159+
152160-- | Add accepted content types to every operation in the spec.
153161addConsumes :: [MediaType] -> Swagger -> Swagger
154162addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@@ -439,6 +447,9 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
439447 & required ?~ True
440448 & schema .~ ParamBody ref
441449
450+instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
451+ toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))
452+
442453-- =======================================================================
443454-- Below are the definitions that should be in Servant.API.ContentTypes
444455-- =======================================================================