@@ -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,12 +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 (Rep, datatypeName, D1, Meta(..))
3336import GHC.TypeLits
3437import Network.HTTP.Media (MediaType)
3538import Servant.API
3639import Servant.API.Description (FoldDescription,
3740 reflectDescription)
38−import Servant.API.Generic (ToServantApi)
41+import Servant.API.Generic (ToServantApi, AsApi)
3942import Servant.API.Modifiers (FoldRequired)
4043
4144import Servant.Swagger.Internal.TypeLevel.API
@@ -150,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty
150153addParam :: Param -> Swagger -> Swagger
151154addParam param = allOperations.parameters %~ (Inline param :)
152155
156+-- | Add a tag to every operation in the spec.
157+addTag :: Text -> Swagger -> Swagger
158+addTag tag = allOperations.tags %~ ([tag] <>)
159+
153160-- | Add accepted content types to every operation in the spec.
154161addConsumes :: [MediaType] -> Swagger -> Swagger
155162addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@@ -440,8 +447,8 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
440447 & required ?~ True
441448 & schema .~ ParamBody ref
442449
443−instance HasSwagger (ToServantApi routes) => HasSwagger (NamedRoutes routes) where
444− toSwagger _ = toSwagger (Proxy :: Proxy (ToServantApi routes))
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)))
445452
446453-- =======================================================================
447454-- Below are the definitions that should be in Servant.API.ContentTypes