{-# LANGUAGE CPP                  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# 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
module Servant.Swagger.Internal where

import Prelude ()
import Prelude.Compat

import           Control.Applicative                    ((<|>))
import           Control.Lens
import           Data.Aeson
import           Data.HashMap.Strict.InsOrd             (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd             as InsOrdHashMap
import           Data.Foldable (toList)
import           Data.Proxy
import           Data.Typeable
import           Data.Singletons.Bool
import           Data.Swagger                           hiding (Header)
import qualified Data.Swagger                           as Swagger
import           Data.Swagger.Declare
import           Data.Text                              (Text)
import qualified Data.Text                              as Text
import           GHC.Generics                           (D1, Meta(..), Rep)
import           GHC.TypeLits
import           Network.HTTP.Media                     (MediaType)
import           Servant.API
import           Servant.API.Description                (FoldDescription,
                                                         reflectDescription)
import           Servant.API.Generic                    (ToServantApi, AsApi)
import           Servant.API.Modifiers                  (FoldRequired)

import           Servant.Swagger.Internal.TypeLevel.API

-- | Generate a Swagger specification for a servant API.
--
-- To generate Swagger specification, your data types need
-- @'ToParamSchema'@ and/or @'ToSchema'@ instances.
--
-- @'ToParamSchema'@ is used for @'Capture'@, @'QueryParam'@ and @'Header'@.
-- @'ToSchema'@ is used for @'ReqBody'@ and response data types.
--
-- You can easily derive those instances via @Generic@.
-- For more information, refer to <http://hackage.haskell.org/package/swagger2/docs/Data-Swagger.html swagger2 documentation>.
--
-- Example:
--
-- @
-- newtype Username = Username String deriving (Generic, ToText)
--
-- instance ToParamSchema Username
--
-- data User = User
--   { username :: Username
--   , fullname :: String
--   } deriving (Generic)
--
-- instance ToJSON User
-- instance ToSchema User
--
-- type MyAPI = QueryParam "username" Username :> Get '[JSON] User
--
-- mySwagger :: Swagger
-- mySwagger = toSwagger (Proxy :: Proxy MyAPI)
-- @
class HasSwagger api where
  -- | Generate a Swagger specification for a servant API.
  toSwagger :: Proxy api -> Swagger

instance HasSwagger Raw where
  toSwagger :: Proxy Raw -> Swagger
toSwagger Proxy Raw
_ = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall s a. HasPaths s a => Lens' s a
paths forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap FilePath PathItem)
"/" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. Monoid a => a
mempty

instance HasSwagger EmptyAPI where
  toSwagger :: Proxy EmptyAPI -> Swagger
toSwagger Proxy EmptyAPI
_ = forall a. Monoid a => a
mempty

-- | All operations of sub API.
-- This is similar to @'operationsOf'@ but ensures that operations
-- indeed belong to the API at compile time.
subOperations :: (IsSubAPI sub api, HasSwagger sub) =>
  Proxy sub     -- ^ Part of a servant API.
  -> Proxy api  -- ^ The whole servant API.
  -> Traversal' Swagger Operation
subOperations :: forall sub api.
(IsSubAPI sub api, HasSwagger sub) =>
Proxy sub -> Proxy api -> Traversal' Swagger Operation
subOperations Proxy sub
sub Proxy api
_ = Swagger -> Traversal' Swagger Operation
operationsOf (forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger Proxy sub
sub)

-- | Make a singleton Swagger spec (with only one endpoint).
-- For endpoints with no content see 'mkEndpointNoContent'.
mkEndpoint :: forall a cs hs proxy method status.
  (ToSchema a, AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
  => FilePath                                       -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs a))  -- ^ Method, content-types, headers and response.
  -> Swagger
mkEndpoint :: forall {k1} a (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(ToSchema a, AllAccept cs, AllToResponseHeader hs,
 SwaggerMethod method, KnownNat status) =>
FilePath -> proxy (Verb method status cs (Headers hs a)) -> Swagger
mkEndpoint FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
  = forall {k1} (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, SwaggerMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> Swagger
mkEndpointWithSchemaRef (forall a. a -> Maybe a
Just Referenced Schema
ref) FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
      forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions forall s t a b. ASetter s t a b -> b -> s -> t
.~ Definitions Schema
defs
  where
    (Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. Monoid a => a
mempty

-- | Make a singletone 'Swagger' spec (with only one endpoint) and with no content schema.
mkEndpointNoContent :: forall nocontent cs hs proxy method status.
  (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
  => FilePath                                               -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs nocontent))  -- ^ Method, content-types, headers and response.
  -> Swagger
mkEndpointNoContent :: forall {k1} nocontent (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(AllAccept cs, AllToResponseHeader hs, SwaggerMethod method,
 KnownNat status) =>
FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> Swagger
mkEndpointNoContent FilePath
path proxy (Verb method status cs (Headers hs nocontent))
proxy
  = forall {k1} (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, SwaggerMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> Swagger
mkEndpointWithSchemaRef forall a. Maybe a
Nothing FilePath
path proxy (Verb method status cs (Headers hs nocontent))
proxy

-- | Like @'mkEndpoint'@ but with explicit schema reference.
-- Unlike @'mkEndpoint'@ this function does not update @'definitions'@.
mkEndpointWithSchemaRef :: forall cs hs proxy method status a.
  (AllAccept cs, AllToResponseHeader hs, SwaggerMethod method, KnownNat status)
  => Maybe (Referenced Schema)
  -> FilePath
  -> proxy (Verb method status cs (Headers hs a))
  -> Swagger
mkEndpointWithSchemaRef :: forall {k1} (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, SwaggerMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> Swagger
mkEndpointWithSchemaRef Maybe (Referenced Schema)
mref FilePath
path proxy (Verb method status cs (Headers hs a))
_ = forall a. Monoid a => a
mempty
  forall a b. a -> (a -> b) -> b
& forall s a. HasPaths s a => Lens' s a
pathsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
path forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (forall a. Monoid a => a
mempty
      forall a b. a -> (a -> b) -> b
& forall s a. HasProduces s a => Lens' s a
produces forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [MediaType] -> MimeList
MimeList [MediaType]
responseContentTypes
      forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
code forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline (forall a. Monoid a => a
mempty
            forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema  forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Referenced Schema)
mref
            forall a b. a -> (a -> b) -> b
& forall s a. HasHeaders s a => Lens' s a
headers forall s t a b. ASetter s t a b -> b -> s -> t
.~ InsOrdHashMap Text Header
responseHeaders)))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = forall {k} (method :: k) (proxy :: k -> *).
SwaggerMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
swaggerMethod (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
    code :: HttpStatusCode
code                 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy status))
    responseContentTypes :: [MediaType]
responseContentTypes = forall {k} (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (forall {k} (t :: k). Proxy t
Proxy :: Proxy cs)
    responseHeaders :: InsOrdHashMap Text Header
responseHeaders      = forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text Header
toAllResponseHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy hs)

mkEndpointNoContentVerb :: forall proxy method.
  (SwaggerMethod method)
  => FilePath                      -- ^ Endpoint path.
  -> proxy (NoContentVerb method)  -- ^ Method
  -> Swagger
mkEndpointNoContentVerb :: forall {k1} (proxy :: * -> *) (method :: k1).
SwaggerMethod method =>
FilePath -> proxy (NoContentVerb method) -> Swagger
mkEndpointNoContentVerb FilePath
path proxy (NoContentVerb method)
_ = forall a. Monoid a => a
mempty
  forall a b. a -> (a -> b) -> b
& forall s a. HasPaths s a => Lens' s a
pathsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
path forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (forall a. Monoid a => a
mempty
      forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
code forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline forall a. Monoid a => a
mempty))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = forall {k} (method :: k) (proxy :: k -> *).
SwaggerMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
swaggerMethod (forall {k} (t :: k). Proxy t
Proxy :: Proxy method)
    code :: HttpStatusCode
code                 = HttpStatusCode
204 -- hardcoded in servant-server

-- | Add parameter to every operation in the spec.
addParam :: Param -> Swagger -> Swagger
addParam :: Param -> Swagger -> Swagger
addParam Param
param = Traversal' Swagger Operation
allOperationsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasParameters s a => Lens' s a
parameters forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. a -> Referenced a
Inline Param
param forall a. a -> [a] -> [a]
:)

-- | Add a tag to every operation in the spec.
addTag :: Text -> Swagger -> Swagger
addTag :: Text -> Swagger -> Swagger
addTag Text
tag = Traversal' Swagger Operation
allOperationsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasTags s a => Lens' s a
tags forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Text
tag] forall a. Semigroup a => a -> a -> a
<>)

-- | Add accepted content types to every operation in the spec.
addConsumes :: [MediaType] -> Swagger -> Swagger
addConsumes :: [MediaType] -> Swagger -> Swagger
addConsumes [MediaType]
cs = Traversal' Swagger Operation
allOperationsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasConsumes s a => Lens' s a
consumes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a
Just ([MediaType] -> MimeList
MimeList [MediaType]
cs))

-- | Format given text as inline code in Markdown.
markdownCode :: Text -> Text
markdownCode :: Text -> Text
markdownCode Text
s = Text
"`" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"`"

addDefaultResponse400 :: ParamName -> Swagger -> Swagger
addDefaultResponse400 :: Text -> Swagger -> Swagger
addDefaultResponse400 Text
pname = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> Swagger
-> Swagger
setResponseWith (\Response
old Response
_new -> Response -> Response
alter400 Response
old) HttpStatusCode
400 (forall (m :: * -> *) a. Monad m => a -> m a
return Response
response400)
  where
    sname :: Text
sname = Text -> Text
markdownCode Text
pname
    description400 :: Text
description400 = Text
"Invalid " forall a. Semigroup a => a -> a -> a
<> Text
sname
    alter400 :: Response -> Response
alter400 = forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> (Text
" or " forall a. Semigroup a => a -> a -> a
<> Text
sname))
    response400 :: Response
response400 = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
description400

-- | Methods, available for Swagger.
class SwaggerMethod method where
  swaggerMethod :: proxy method -> Lens' PathItem (Maybe Operation)

instance SwaggerMethod 'GET     where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'GET -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'GET
_ = forall s a. HasGet s a => Lens' s a
get
instance SwaggerMethod 'PUT     where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'PUT -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'PUT
_ = forall s a. HasPut s a => Lens' s a
put
instance SwaggerMethod 'POST    where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'POST -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'POST
_ = forall s a. HasPost s a => Lens' s a
post
instance SwaggerMethod 'DELETE  where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'DELETE -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'DELETE
_ = forall s a. HasDelete s a => Lens' s a
delete
instance SwaggerMethod 'OPTIONS where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'OPTIONS -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'OPTIONS
_ = forall s a. HasOptions s a => Lens' s a
options
instance SwaggerMethod 'HEAD    where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'HEAD -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'HEAD
_ = forall s a. HasHead s a => Lens' s a
head_
instance SwaggerMethod 'PATCH   where swaggerMethod :: forall (proxy :: StdMethod -> *).
proxy 'PATCH -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'PATCH
_ = forall s a. HasPatch s a => Lens' s a
patch

instance HasSwagger (UVerb method cs '[]) where
  toSwagger :: Proxy (UVerb method cs '[]) -> Swagger
toSwagger Proxy (UVerb method cs '[])
_ = forall a. Monoid a => a
mempty

-- | @since <TODO>
instance
  {-# OVERLAPPABLE #-}
  ( ToSchema a,
    HasStatus a,
    AllAccept cs,
    SwaggerMethod method,
    HasSwagger (UVerb method cs as)
  ) =>
  HasSwagger (UVerb method cs (a ': as))
  where
  toSwagger :: Proxy (UVerb method cs (a : as)) -> Swagger
toSwagger Proxy (UVerb method cs (a : as))
_ =
    forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method (StatusOf a) cs a))
      Swagger -> Swagger -> Swagger
`combineSwagger` forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (UVerb method cs as))

-- ATTENTION: do not remove this instance!
-- A similar instance above will always use the more general
-- polymorphic -- HasSwagger instance and will result in a type error
-- since 'NoContent' does not have a 'ToSchema' instance.
instance
  ( KnownNat status,
    AllAccept cs,
    SwaggerMethod method,
    HasSwagger (UVerb method cs as)
  ) =>
  HasSwagger (UVerb method cs (WithStatus status NoContent ': as))
  where
  toSwagger :: Proxy (UVerb method cs (WithStatus status NoContent : as))
-> Swagger
toSwagger Proxy (UVerb method cs (WithStatus status NoContent : as))
_ =
    forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs NoContent))
      Swagger -> Swagger -> Swagger
`combineSwagger` forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (UVerb method cs as))


-- workaround for https://github.com/GetShopTV/swagger2/issues/218
-- We'd like to juse use (<>) but the instances are wrong
combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem :: PathItem -> PathItem -> PathItem
combinePathItem PathItem
s PathItem
t = PathItem
    { _pathItemGet :: Maybe Operation
_pathItemGet = PathItem -> Maybe Operation
_pathItemGet PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemGet PathItem
t
    , _pathItemPut :: Maybe Operation
_pathItemPut = PathItem -> Maybe Operation
_pathItemPut PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPut PathItem
t
    , _pathItemPost :: Maybe Operation
_pathItemPost = PathItem -> Maybe Operation
_pathItemPost PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPost PathItem
t
    , _pathItemDelete :: Maybe Operation
_pathItemDelete = PathItem -> Maybe Operation
_pathItemDelete PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemDelete PathItem
t
    , _pathItemOptions :: Maybe Operation
_pathItemOptions = PathItem -> Maybe Operation
_pathItemOptions PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemOptions PathItem
t
    , _pathItemHead :: Maybe Operation
_pathItemHead = PathItem -> Maybe Operation
_pathItemHead PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemHead PathItem
t
    , _pathItemPatch :: Maybe Operation
_pathItemPatch = PathItem -> Maybe Operation
_pathItemPatch PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPatch PathItem
t
    , _pathItemParameters :: [Referenced Param]
_pathItemParameters = PathItem -> [Referenced Param]
_pathItemParameters PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> [Referenced Param]
_pathItemParameters PathItem
t
    }

combineSwagger :: Swagger -> Swagger -> Swagger
combineSwagger :: Swagger -> Swagger -> Swagger
combineSwagger Swagger
s Swagger
t = Swagger
    { _swaggerInfo :: Info
_swaggerInfo = Swagger -> Info
_swaggerInfo Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Info
_swaggerInfo Swagger
t
    , _swaggerHost :: Maybe Host
_swaggerHost = Swagger -> Maybe Host
_swaggerHost Swagger
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Swagger -> Maybe Host
_swaggerHost Swagger
t
    , _swaggerBasePath :: Maybe FilePath
_swaggerBasePath = Swagger -> Maybe FilePath
_swaggerBasePath Swagger
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Swagger -> Maybe FilePath
_swaggerBasePath Swagger
t
    , _swaggerSchemes :: Maybe [Scheme]
_swaggerSchemes = Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
t
    , _swaggerConsumes :: MimeList
_swaggerConsumes = Swagger -> MimeList
_swaggerConsumes Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerConsumes Swagger
t
    , _swaggerProduces :: MimeList
_swaggerProduces = Swagger -> MimeList
_swaggerProduces Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerProduces Swagger
t
    , _swaggerPaths :: InsOrdHashMap FilePath PathItem
_swaggerPaths = forall k v.
(Eq k, Hashable k) =>
(v -> v -> v)
-> InsOrdHashMap k v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.unionWith PathItem -> PathItem -> PathItem
combinePathItem (Swagger -> InsOrdHashMap FilePath PathItem
_swaggerPaths Swagger
s) (Swagger -> InsOrdHashMap FilePath PathItem
_swaggerPaths Swagger
t)
    , _swaggerDefinitions :: Definitions Schema
_swaggerDefinitions = Swagger -> Definitions Schema
_swaggerDefinitions Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Schema
_swaggerDefinitions Swagger
t
    , _swaggerParameters :: Definitions Param
_swaggerParameters = Swagger -> Definitions Param
_swaggerParameters Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Param
_swaggerParameters Swagger
t
    , _swaggerResponses :: Definitions Response
_swaggerResponses = Swagger -> Definitions Response
_swaggerResponses Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Response
_swaggerResponses Swagger
t
    , _swaggerSecurityDefinitions :: SecurityDefinitions
_swaggerSecurityDefinitions = Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
t
    , _swaggerSecurity :: [SecurityRequirement]
_swaggerSecurity = Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
t
    , _swaggerTags :: InsOrdHashSet Tag
_swaggerTags = Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
s forall a. Semigroup a => a -> a -> a
<> Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
t
    , _swaggerExternalDocs :: Maybe ExternalDocs
_swaggerExternalDocs = Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
t
    }

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs a) where
  toSwagger :: Proxy (Verb method status cs a) -> Swagger
toSwagger Proxy (Verb method status cs a)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs (Headers '[] a)))

-- | @since 1.1.7
instance (ToSchema a, Accept ct, KnownNat status, SwaggerMethod method) => HasSwagger (Stream method status fr ct a) where
  toSwagger :: Proxy (Stream method status fr ct a) -> Swagger
toSwagger Proxy (Stream method status fr ct a)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method status '[ct] (Headers '[] a)))

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
  => HasSwagger (Verb method status cs (Headers hs a)) where
  toSwagger :: Proxy (Verb method status cs (Headers hs a)) -> Swagger
toSwagger = forall {k1} a (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(ToSchema a, AllAccept cs, AllToResponseHeader hs,
 SwaggerMethod method, KnownNat status) =>
FilePath -> proxy (Verb method status cs (Headers hs a)) -> Swagger
mkEndpoint FilePath
"/"

-- ATTENTION: do not remove this instance!
-- A similar instance above will always use the more general
-- polymorphic -- HasSwagger instance and will result in a type error
-- since 'NoContent' does not have a 'ToSchema' instance.
instance (AllAccept cs, KnownNat status, SwaggerMethod method) => HasSwagger (Verb method status cs NoContent) where
  toSwagger :: Proxy (Verb method status cs NoContent) -> Swagger
toSwagger Proxy (Verb method status cs NoContent)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs (Headers '[] NoContent)))

instance (AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod method)
  => HasSwagger (Verb method status cs (Headers hs NoContent)) where
  toSwagger :: Proxy (Verb method status cs (Headers hs NoContent)) -> Swagger
toSwagger = forall {k1} nocontent (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(AllAccept cs, AllToResponseHeader hs, SwaggerMethod method,
 KnownNat status) =>
FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> Swagger
mkEndpointNoContent FilePath
"/"

instance (SwaggerMethod method) => HasSwagger (NoContentVerb method) where
  toSwagger :: Proxy (NoContentVerb method) -> Swagger
toSwagger =  forall {k1} (proxy :: * -> *) (method :: k1).
SwaggerMethod method =>
FilePath -> proxy (NoContentVerb method) -> Swagger
mkEndpointNoContentVerb FilePath
"/"

instance (HasSwagger a, HasSwagger b) => HasSwagger (a :<|> b) where
  toSwagger :: Proxy (a :<|> b) -> Swagger
toSwagger Proxy (a :<|> b)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Semigroup a => a -> a -> a
<> forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

-- | @'Vault'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (Vault :> sub) where
  toSwagger :: Proxy (Vault :> sub) -> Swagger
toSwagger Proxy (Vault :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'IsSecure'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (IsSecure :> sub) where
  toSwagger :: Proxy (IsSecure :> sub) -> Swagger
toSwagger Proxy (IsSecure :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'RemoteHost'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (RemoteHost :> sub) where
  toSwagger :: Proxy (RemoteHost :> sub) -> Swagger
toSwagger Proxy (RemoteHost :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'Fragment'@ combinator does not change our specification at all.
instance HasSwagger sub => HasSwagger (Fragment a :> sub) where
  toSwagger :: Proxy (Fragment a :> sub) -> Swagger
toSwagger Proxy (Fragment a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'HttpVersion'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where
  toSwagger :: Proxy (HttpVersion :> sub) -> Swagger
toSwagger Proxy (HttpVersion :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'WithNamedContext'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where
  toSwagger :: Proxy (WithNamedContext x c sub) -> Swagger
toSwagger Proxy (WithNamedContext x c sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

-- | @'WithResource'@ combinator does not change our specification at all.
instance (HasSwagger sub) => HasSwagger (WithResource res :> sub) where
  toSwagger :: Proxy (WithResource res :> sub) -> Swagger
toSwagger Proxy (WithResource res :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)

instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where
  toSwagger :: Proxy (sym :> sub) -> Swagger
toSwagger Proxy (sym :> sub)
_ = FilePath -> Swagger -> Swagger
prependPath FilePath
piece (forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub))
    where
      piece :: FilePath
piece = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)

instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (Capture' mods sym a :> sub) where
  toSwagger :: Proxy (Capture' mods sym a :> sub) -> Swagger
toSwagger Proxy (Capture' mods sym a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& FilePath -> Swagger -> Swagger
prependPath FilePath
capture
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    where
      symbol :: FilePath
symbol = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      pname :: FilePath
pname = if FilePath
symbol forall a. Eq a => a -> a -> Bool
== FilePath
""
        then Char -> FilePath -> FilePath
camelTo2 Char
'-' forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> FilePath
tyConName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        else FilePath
symbol
      tname :: Text
tname = FilePath -> Text
Text.pack FilePath
pname
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = forall a. Maybe a
Nothing
      transDesc FilePath
desc = forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
desc)
      capture :: FilePath
capture = FilePath
"{" forall a. Semigroup a => a -> a -> a
<> FilePath
pname forall a. Semigroup a => a -> a -> a
<> FilePath
"}"
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (forall a. Monoid a => a
mempty
            forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamPath
            forall a b. a -> (a -> b) -> b
& forall s a. HasParamSchema s a => Lens' s a
paramSchema forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

-- | Swagger Spec doesn't have a notion of CaptureAll, this instance is the best effort.
instance (KnownSymbol sym, Typeable a, ToParamSchema a, HasSwagger sub) => HasSwagger (CaptureAll sym a :> sub) where
  toSwagger :: Proxy (CaptureAll sym a :> sub) -> Swagger
toSwagger Proxy (CaptureAll sym a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Capture sym a :> sub))

instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Description desc :> api) where
  toSwagger :: Proxy (Description desc :> api) -> Swagger
toSwagger Proxy (Description desc :> api)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
    forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
allOperationsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy desc))) forall a. Semigroup a => a -> a -> a
<>)

instance (KnownSymbol desc, HasSwagger api) => HasSwagger (Summary desc :> api) where
  toSwagger :: Proxy (Summary desc :> api) -> Swagger
toSwagger Proxy (Summary desc :> api)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
    forall a b. a -> (a -> b) -> b
& Traversal' Swagger Operation
allOperationsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasSummary s a => Lens' s a
summary forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy desc))) forall a. Semigroup a => a -> a -> a
<>)

instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (QueryParam' mods sym a :> sub) where
  toSwagger :: Proxy (QueryParam' mods sym a :> sub) -> Swagger
toSwagger Proxy (QueryParam' mods sym a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = forall a. Maybe a
Nothing
      transDesc FilePath
desc = forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
desc)
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (forall {k} (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther ParamOtherSchema
sch
      sch :: ParamOtherSchema
sch = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        forall a b. a -> (a -> b) -> b
& forall s a. HasParamSchema s a => Lens' s a
paramSchema forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub) => HasSwagger (QueryParams sym a :> sub) where
  toSwagger :: Proxy (QueryParams sym a :> sub) -> Swagger
toSwagger Proxy (QueryParams sym a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther ParamOtherSchema
sch
      sch :: ParamOtherSchema
sch = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        forall a b. a -> (a -> b) -> b
& forall s a. HasParamSchema s a => Lens' s a
paramSchema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamSchema 'SwaggerKindParamOtherSchema
pschema
      pschema :: ParamSchema 'SwaggerKindParamOtherSchema
pschema = forall a. Monoid a => a
mempty
#if MIN_VERSION_swagger2(2,4,0)
        forall a b. a -> (a -> b) -> b
& forall s a. HasType s a => Lens' s a
type_ forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerArray
#else
        & type_ .~ SwaggerArray
#endif
        forall a b. a -> (a -> b) -> b
& forall s a. HasItems s a => Lens' s a
items forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (t :: SwaggerKind (*)).
Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
SwaggerItemsPrimitive (forall a. a -> Maybe a
Just CollectionFormat 'SwaggerKindParamOtherSchema
CollectionMulti) (forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (QueryFlag sym :> sub) where
  toSwagger :: Proxy (QueryFlag sym :> sub) -> Swagger
toSwagger Proxy (QueryFlag sym :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (forall a. Monoid a => a
mempty
            forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
            forall a b. a -> (a -> b) -> b
& forall s a. HasAllowEmptyValue s a => Lens' s a
allowEmptyValue forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
            forall a b. a -> (a -> b) -> b
& forall s a. HasParamSchema s a => Lens' s a
paramSchema forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy Bool)
                forall a b. a -> (a -> b) -> b
& forall s a. HasDefault s a => Lens' s a
default_ forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
toJSON Bool
False))

instance (KnownSymbol sym, ToParamSchema a, HasSwagger sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasSwagger (Header' mods  sym a :> sub) where
  toSwagger :: Proxy (Header' mods sym a :> sub) -> Swagger
toSwagger Proxy (Header' mods sym a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    where
      tname :: Text
tname = FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = forall a. Maybe a
Nothing
      transDesc FilePath
desc = forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
desc)
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (forall {k} (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (forall a. Monoid a => a
mempty
            forall a b. a -> (a -> b) -> b
& forall s a. HasIn s a => Lens' s a
in_ forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamHeader
            forall a b. a -> (a -> b) -> b
& forall s a. HasParamSchema s a => Lens' s a
paramSchema forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

instance (ToSchema a, AllAccept cs, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (ReqBody' mods cs a :> sub) where
  toSwagger :: Proxy (ReqBody' mods cs a :> sub) -> Swagger
toSwagger Proxy (ReqBody' mods cs a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& [MediaType] -> Swagger -> Swagger
addConsumes (forall {k} (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (forall {k} (t :: k). Proxy t
Proxy :: Proxy cs))
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: Text
tname = Text
"body"
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = forall a. Maybe a
Nothing
      transDesc FilePath
desc = forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. Monoid a => a
mempty
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name      forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required  forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema    forall s t a b. ASetter s t a b -> b -> s -> t
.~ Referenced Schema -> ParamAnySchema
ParamBody Referenced Schema
ref

-- | This instance is an approximation.
--
-- @since 1.1.7
instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mods)) => HasSwagger (StreamBody' mods fr ct a :> sub) where
  toSwagger :: Proxy (StreamBody' mods fr ct a :> sub) -> Swagger
toSwagger Proxy (StreamBody' mods fr ct a :> sub)
_ = forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    forall a b. a -> (a -> b) -> b
& [MediaType] -> Swagger -> Swagger
addConsumes (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ct)))
    forall a b. a -> (a -> b) -> b
& Text -> Swagger -> Swagger
addDefaultResponse400 Text
tname
    forall a b. a -> (a -> b) -> b
& forall s a. HasDefinitions s a => Lens' s a
definitions forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: Text
tname = Text
"body"
      transDesc :: FilePath -> Maybe Text
transDesc FilePath
""   = forall a. Maybe a
Nothing
      transDesc FilePath
desc = forall a. a -> Maybe a
Just (FilePath -> Text
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. Monoid a => a
mempty
      param :: Param
param = forall a. Monoid a => a
mempty
        forall a b. a -> (a -> b) -> b
& forall s a. HasName s a => Lens' s a
name      forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
tname
        forall a b. a -> (a -> b) -> b
& forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe Text
transDesc (forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy mods))
        forall a b. a -> (a -> b) -> b
& forall s a. HasRequired s a => Lens' s a
required  forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        forall a b. a -> (a -> b) -> b
& forall s a. HasSchema s a => Lens' s a
schema    forall s t a b. ASetter s t a b -> b -> s -> t
.~ Referenced Schema -> ParamAnySchema
ParamBody Referenced Schema
ref

instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
  toSwagger :: Proxy (NamedRoutes routes) -> Swagger
toSwagger Proxy (NamedRoutes routes)
_ = Text -> Swagger -> Swagger
addTag (FilePath -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy datatypeName)) (forall {k} (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi routes)))

-- =======================================================================
-- Below are the definitions that should be in Servant.API.ContentTypes
-- =======================================================================

class AllAccept cs where
  allContentType :: Proxy cs -> [MediaType]

instance AllAccept '[] where
  allContentType :: Proxy '[] -> [MediaType]
allContentType Proxy '[]
_ = []

instance (Accept c, AllAccept cs) => AllAccept (c ': cs) where
  allContentType :: Proxy (c : cs) -> [MediaType]
allContentType Proxy (c : cs)
_ = forall {k} (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (forall {k} (t :: k). Proxy t
Proxy :: Proxy c) forall a. a -> [a] -> [a]
: forall {k} (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (forall {k} (t :: k). Proxy t
Proxy :: Proxy cs)

class ToResponseHeader h where
  toResponseHeader :: Proxy h -> (HeaderName, Swagger.Header)

instance (KnownSymbol sym, ToParamSchema a) => ToResponseHeader (Header sym a) where
  toResponseHeader :: Proxy (Header sym a) -> (Text, Header)
toResponseHeader Proxy (Header sym a)
_ = (Text
hname, Maybe Text -> ParamSchema ('SwaggerKindNormal Header) -> Header
Swagger.Header forall a. Maybe a
Nothing ParamSchema ('SwaggerKindNormal Header)
hschema)
    where
      hname :: Text
hname = FilePath -> Text
Text.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym))
      hschema :: ParamSchema ('SwaggerKindNormal Header)
hschema = forall a (t :: SwaggerKind (*)).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

class AllToResponseHeader hs where
  toAllResponseHeaders :: Proxy hs -> InsOrdHashMap HeaderName Swagger.Header

instance AllToResponseHeader '[] where
  toAllResponseHeaders :: Proxy '[] -> InsOrdHashMap Text Header
toAllResponseHeaders Proxy '[]
_ = forall a. Monoid a => a
mempty

instance (ToResponseHeader h, AllToResponseHeader hs) => AllToResponseHeader (h ': hs) where
  toAllResponseHeaders :: Proxy (h : hs) -> InsOrdHashMap Text Header
toAllResponseHeaders Proxy (h : hs)
_ = forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert Text
headerName Header
headerBS InsOrdHashMap Text Header
hdrs
    where
      (Text
headerName, Header
headerBS) = forall {k} (h :: k).
ToResponseHeader h =>
Proxy h -> (Text, Header)
toResponseHeader (forall {k} (t :: k). Proxy t
Proxy :: Proxy h)
      hdrs :: InsOrdHashMap Text Header
hdrs = forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text Header
toAllResponseHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy hs)

instance AllToResponseHeader hs => AllToResponseHeader (HList hs) where
  toAllResponseHeaders :: Proxy (HList hs) -> InsOrdHashMap Text Header
toAllResponseHeaders Proxy (HList hs)
_ = forall {k} (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap Text Header
toAllResponseHeaders (forall {k} (t :: k). Proxy t
Proxy :: Proxy hs)