{-# LANGUAGE CPP                  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeOperators        #-}
#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.TypeLits
import           Network.HTTP.Media                     (MediaType)
import           Servant.API
import           Servant.API.Description                (FoldDescription,
                                                         reflectDescription)
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
_ = Swagger
forall a. Monoid a => a
mempty Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
paths ((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (InsOrdHashMap FilePath PathItem)
"/" ((Maybe PathItem -> Identity (Maybe PathItem))
 -> Swagger -> Identity Swagger)
-> PathItem -> Swagger -> Swagger
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PathItem
forall a. Monoid a => a
mempty

instance HasSwagger EmptyAPI where
  toSwagger :: Proxy EmptyAPI -> Swagger
toSwagger Proxy EmptyAPI
_ = Swagger
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 :: Proxy sub -> Proxy api -> Traversal' Swagger Operation
subOperations Proxy sub
sub Proxy api
_ = Swagger -> Traversal' Swagger Operation
operationsOf (Proxy sub -> Swagger
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 :: FilePath -> proxy (Verb method status cs (Headers hs a)) -> Swagger
mkEndpoint FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
  = Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> Swagger
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 (Referenced Schema -> Maybe (Referenced Schema)
forall a. a -> Maybe a
Just Referenced Schema
ref) FilePath
path proxy (Verb method status cs (Headers hs a))
proxy
      Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> Definitions Schema -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Definitions Schema
defs
  where
    (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
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 :: FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> Swagger
mkEndpointNoContent FilePath
path proxy (Verb method status cs (Headers hs nocontent))
proxy
  = Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs nocontent))
-> Swagger
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)
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 :: 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))
_ = Swagger
forall a. Monoid a => a
mempty
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
Index (InsOrdHashMap FilePath PathItem)
path ((Maybe PathItem -> Identity (Maybe PathItem))
 -> Swagger -> Identity Swagger)
-> PathItem -> Swagger -> Swagger
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (PathItem
forall a. Monoid a => a
mempty PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Operation
forall a. Monoid a => a
mempty
      Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& (Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasProduces s a => Lens' s a
produces ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Operation -> Identity Operation)
-> MimeList -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [MediaType] -> MimeList
MimeList [MediaType]
responseContentTypes
      Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline (Response
forall a. Monoid a => a
mempty
            Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (Maybe (Referenced Schema) -> Identity (Maybe (Referenced Schema)))
-> Response -> Identity Response
forall s a. HasSchema s a => Lens' s a
schema  ((Maybe (Referenced Schema)
  -> Identity (Maybe (Referenced Schema)))
 -> Response -> Identity Response)
-> Maybe (Referenced Schema) -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Referenced Schema)
mref
            Response -> (Response -> Response) -> Response
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap HeaderName Header
 -> Identity (InsOrdHashMap HeaderName Header))
-> Response -> Identity Response
forall s a. HasHeaders s a => Lens' s a
headers ((InsOrdHashMap HeaderName Header
  -> Identity (InsOrdHashMap HeaderName Header))
 -> Response -> Identity Response)
-> InsOrdHashMap HeaderName Header -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InsOrdHashMap HeaderName Header
responseHeaders)))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = Proxy method -> Lens' PathItem (Maybe Operation)
forall k (method :: k) (proxy :: k -> *).
SwaggerMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
swaggerMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
    code :: HttpStatusCode
code                 = Integer -> HttpStatusCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy status -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy status
forall k (t :: k). Proxy t
Proxy :: Proxy status))
    responseContentTypes :: [MediaType]
responseContentTypes = Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs)
    responseHeaders :: InsOrdHashMap HeaderName Header
responseHeaders      = Proxy hs -> InsOrdHashMap HeaderName Header
forall k (hs :: k).
AllToResponseHeader hs =>
Proxy hs -> InsOrdHashMap HeaderName Header
toAllResponseHeaders (Proxy hs
forall k (t :: k). Proxy t
Proxy :: Proxy hs)

mkEndpointNoContentVerb :: forall proxy method.
  (SwaggerMethod method)
  => FilePath                      -- ^ Endpoint path.
  -> proxy (NoContentVerb method)  -- ^ Method
  -> Swagger
mkEndpointNoContentVerb :: FilePath -> proxy (NoContentVerb method) -> Swagger
mkEndpointNoContentVerb FilePath
path proxy (NoContentVerb method)
_ = Swagger
forall a. Monoid a => a
mempty
  Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap FilePath PathItem
 -> Identity (InsOrdHashMap FilePath PathItem))
-> Swagger -> Identity Swagger
forall s a. HasPaths s a => Lens' s a
paths((InsOrdHashMap FilePath PathItem
  -> Identity (InsOrdHashMap FilePath PathItem))
 -> Swagger -> Identity Swagger)
-> ((Maybe PathItem -> Identity (Maybe PathItem))
    -> InsOrdHashMap FilePath PathItem
    -> Identity (InsOrdHashMap FilePath PathItem))
-> (Maybe PathItem -> Identity (Maybe PathItem))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (InsOrdHashMap FilePath PathItem)
-> Lens'
     (InsOrdHashMap FilePath PathItem)
     (Maybe (IxValue (InsOrdHashMap FilePath PathItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at FilePath
Index (InsOrdHashMap FilePath PathItem)
path ((Maybe PathItem -> Identity (Maybe PathItem))
 -> Swagger -> Identity Swagger)
-> PathItem -> Swagger -> Swagger
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~
    (PathItem
forall a. Monoid a => a
mempty PathItem -> (PathItem -> PathItem) -> PathItem
forall a b. a -> (a -> b) -> b
& (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method ((Maybe Operation -> Identity (Maybe Operation))
 -> PathItem -> Identity PathItem)
-> Operation -> PathItem -> PathItem
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Operation
forall a. Monoid a => a
mempty
      Operation -> (Operation -> Operation) -> Operation
forall a b. a -> (a -> b) -> b
& Index Operation -> Lens' Operation (Maybe (IxValue Operation))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at HttpStatusCode
Index Operation
code ((Maybe (Referenced Response)
  -> Identity (Maybe (Referenced Response)))
 -> Operation -> Identity Operation)
-> Referenced Response -> Operation -> Operation
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Response -> Referenced Response
forall a. a -> Referenced a
Inline Response
forall a. Monoid a => a
mempty))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = Proxy method -> Lens' PathItem (Maybe Operation)
forall k (method :: k) (proxy :: k -> *).
SwaggerMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
swaggerMethod (Proxy method
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 = (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> (([Referenced Param] -> Identity [Referenced Param])
    -> Operation -> Identity Operation)
-> ([Referenced Param] -> Identity [Referenced Param])
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Referenced Param] -> Identity [Referenced Param])
-> Operation -> Identity Operation
forall s a. HasParameters s a => Lens' s a
parameters (([Referenced Param] -> Identity [Referenced Param])
 -> Swagger -> Identity Swagger)
-> ([Referenced Param] -> [Referenced Param]) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Param -> Referenced Param
forall a. a -> Referenced a
Inline Param
param Referenced Param -> [Referenced Param] -> [Referenced Param]
forall 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 = (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe MimeList -> Identity (Maybe MimeList))
    -> Operation -> Identity Operation)
-> (Maybe MimeList -> Identity (Maybe MimeList))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe MimeList -> Identity (Maybe MimeList))
-> Operation -> Identity Operation
forall s a. HasConsumes s a => Lens' s a
consumes ((Maybe MimeList -> Identity (Maybe MimeList))
 -> Swagger -> Identity Swagger)
-> (Maybe MimeList -> Maybe MimeList) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe MimeList -> Maybe MimeList -> Maybe MimeList
forall a. Semigroup a => a -> a -> a
<> MimeList -> Maybe MimeList
forall a. a -> Maybe a
Just ([MediaType] -> MimeList
MimeList [MediaType]
cs))

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

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

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

instance SwaggerMethod 'GET     where swaggerMethod :: proxy 'GET -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'GET
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasGet s a => Lens' s a
get
instance SwaggerMethod 'PUT     where swaggerMethod :: proxy 'PUT -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'PUT
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPut s a => Lens' s a
put
instance SwaggerMethod 'POST    where swaggerMethod :: proxy 'POST -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'POST
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasPost s a => Lens' s a
post
instance SwaggerMethod 'DELETE  where swaggerMethod :: proxy 'DELETE -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'DELETE
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasDelete s a => Lens' s a
delete
instance SwaggerMethod 'OPTIONS where swaggerMethod :: proxy 'OPTIONS -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'OPTIONS
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasOptions s a => Lens' s a
options
instance SwaggerMethod 'HEAD    where swaggerMethod :: proxy 'HEAD -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'HEAD
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
forall s a. HasHead s a => Lens' s a
head_
instance SwaggerMethod 'PATCH   where swaggerMethod :: proxy 'PATCH -> Lens' PathItem (Maybe Operation)
swaggerMethod proxy 'PATCH
_ = (Maybe Operation -> f (Maybe Operation)) -> PathItem -> f PathItem
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 '[])
_ = Swagger
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))
_ =
    Proxy (Verb method (StatusOf a) cs a) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Verb method (StatusOf a) cs a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method (StatusOf a) cs a))
      Swagger -> Swagger -> Swagger
`combineSwagger` Proxy (UVerb method cs as) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (UVerb method cs as)
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))
_ =
    Proxy (Verb method status cs NoContent) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Verb method status cs NoContent)
forall k (t :: k). Proxy t
Proxy :: Proxy (Verb method status cs NoContent))
      Swagger -> Swagger -> Swagger
`combineSwagger` Proxy (UVerb method cs as) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (UVerb method cs as)
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 :: Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> Maybe Operation
-> [Referenced Param]
-> PathItem
PathItem
    { _pathItemGet :: Maybe Operation
_pathItemGet = PathItem -> Maybe Operation
_pathItemGet PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemGet PathItem
t
    , _pathItemPut :: Maybe Operation
_pathItemPut = PathItem -> Maybe Operation
_pathItemPut PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPut PathItem
t
    , _pathItemPost :: Maybe Operation
_pathItemPost = PathItem -> Maybe Operation
_pathItemPost PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPost PathItem
t
    , _pathItemDelete :: Maybe Operation
_pathItemDelete = PathItem -> Maybe Operation
_pathItemDelete PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemDelete PathItem
t
    , _pathItemOptions :: Maybe Operation
_pathItemOptions = PathItem -> Maybe Operation
_pathItemOptions PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemOptions PathItem
t
    , _pathItemHead :: Maybe Operation
_pathItemHead = PathItem -> Maybe Operation
_pathItemHead PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemHead PathItem
t
    , _pathItemPatch :: Maybe Operation
_pathItemPatch = PathItem -> Maybe Operation
_pathItemPatch PathItem
s Maybe Operation -> Maybe Operation -> Maybe Operation
forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemPatch PathItem
t
    , _pathItemParameters :: [Referenced Param]
_pathItemParameters = PathItem -> [Referenced Param]
_pathItemParameters PathItem
s [Referenced Param] -> [Referenced Param] -> [Referenced Param]
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 :: Info
-> Maybe Host
-> Maybe FilePath
-> Maybe [Scheme]
-> MimeList
-> MimeList
-> InsOrdHashMap FilePath PathItem
-> Definitions Schema
-> Definitions Param
-> Definitions Response
-> SecurityDefinitions
-> [SecurityRequirement]
-> InsOrdHashSet Tag
-> Maybe ExternalDocs
-> Swagger
Swagger
    { _swaggerInfo :: Info
_swaggerInfo = Swagger -> Info
_swaggerInfo Swagger
s Info -> Info -> Info
forall a. Semigroup a => a -> a -> a
<> Swagger -> Info
_swaggerInfo Swagger
t
    , _swaggerHost :: Maybe Host
_swaggerHost = Swagger -> Maybe Host
_swaggerHost Swagger
s Maybe Host -> Maybe Host -> Maybe Host
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 Maybe FilePath -> Maybe FilePath -> Maybe FilePath
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 Maybe [Scheme] -> Maybe [Scheme] -> Maybe [Scheme]
forall a. Semigroup a => a -> a -> a
<> Swagger -> Maybe [Scheme]
_swaggerSchemes Swagger
t
    , _swaggerConsumes :: MimeList
_swaggerConsumes = Swagger -> MimeList
_swaggerConsumes Swagger
s MimeList -> MimeList -> MimeList
forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerConsumes Swagger
t
    , _swaggerProduces :: MimeList
_swaggerProduces = Swagger -> MimeList
_swaggerProduces Swagger
s MimeList -> MimeList -> MimeList
forall a. Semigroup a => a -> a -> a
<> Swagger -> MimeList
_swaggerProduces Swagger
t
    , _swaggerPaths :: InsOrdHashMap FilePath PathItem
_swaggerPaths = (PathItem -> PathItem -> PathItem)
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
-> InsOrdHashMap FilePath PathItem
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 Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Schema
_swaggerDefinitions Swagger
t
    , _swaggerParameters :: Definitions Param
_swaggerParameters = Swagger -> Definitions Param
_swaggerParameters Swagger
s Definitions Param -> Definitions Param -> Definitions Param
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Param
_swaggerParameters Swagger
t
    , _swaggerResponses :: Definitions Response
_swaggerResponses = Swagger -> Definitions Response
_swaggerResponses Swagger
s Definitions Response
-> Definitions Response -> Definitions Response
forall a. Semigroup a => a -> a -> a
<> Swagger -> Definitions Response
_swaggerResponses Swagger
t
    , _swaggerSecurityDefinitions :: SecurityDefinitions
_swaggerSecurityDefinitions = Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
s SecurityDefinitions -> SecurityDefinitions -> SecurityDefinitions
forall a. Semigroup a => a -> a -> a
<> Swagger -> SecurityDefinitions
_swaggerSecurityDefinitions Swagger
t
    , _swaggerSecurity :: [SecurityRequirement]
_swaggerSecurity = Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
s [SecurityRequirement]
-> [SecurityRequirement] -> [SecurityRequirement]
forall a. Semigroup a => a -> a -> a
<> Swagger -> [SecurityRequirement]
_swaggerSecurity Swagger
t
    , _swaggerTags :: InsOrdHashSet Tag
_swaggerTags = Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
s InsOrdHashSet Tag -> InsOrdHashSet Tag -> InsOrdHashSet Tag
forall a. Semigroup a => a -> a -> a
<> Swagger -> InsOrdHashSet Tag
_swaggerTags Swagger
t
    , _swaggerExternalDocs :: Maybe ExternalDocs
_swaggerExternalDocs = Swagger -> Maybe ExternalDocs
_swaggerExternalDocs Swagger
s Maybe ExternalDocs -> Maybe ExternalDocs -> Maybe ExternalDocs
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)
_ = Proxy (Verb method status cs (Headers '[] a)) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Verb method status cs (Headers '[] a))
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)
_ = Proxy (Verb method status '[ct] (Headers '[] a)) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Verb method status '[ct] (Headers '[] a))
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 = FilePath -> Proxy (Verb method status cs (Headers hs a)) -> Swagger
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)
_ = Proxy (Verb method status cs (Headers '[] NoContent)) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Verb method status cs (Headers '[] NoContent))
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 = FilePath
-> Proxy (Verb method status cs (Headers hs NoContent)) -> Swagger
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 =  FilePath -> Proxy (NoContentVerb method) -> Swagger
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)
_ = Proxy a -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Swagger -> Swagger -> Swagger
forall a. Semigroup a => a -> a -> a
<> Proxy b -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy b
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
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 (Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub))
    where
      piece :: FilePath
piece = Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& FilePath -> Swagger -> Swagger
prependPath FilePath
capture
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    where
      symbol :: FilePath
symbol = Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
      pname :: FilePath
pname = if FilePath
symbol FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
""
        then Char -> FilePath -> FilePath
camelTo2 Char
'-' (FilePath -> FilePath)
-> (TypeRep -> FilePath) -> TypeRep -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> FilePath
tyConName (TyCon -> FilePath) -> (TypeRep -> TyCon) -> TypeRep -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> FilePath) -> TypeRep -> FilePath
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
        else FilePath
symbol
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack FilePath
pname
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      capture :: FilePath
capture = FilePath
"{" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
pname FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"}"
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (ParamOtherSchema
forall a. Monoid a => a
mempty
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamPath
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema
  -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamOtherSchema
-> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy a -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
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)
_ = Proxy (Capture sym a :> sub) -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy (Capture sym a :> sub)
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)
_ = Proxy api -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe HeaderName -> Identity (Maybe HeaderName))
    -> Operation -> Identity Operation)
-> (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe HeaderName -> Identity (Maybe HeaderName))
-> Operation -> Identity Operation
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Swagger -> Identity Swagger)
-> (Maybe HeaderName -> Maybe HeaderName) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack (Proxy desc -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy desc
forall k (t :: k). Proxy t
Proxy :: Proxy desc))) Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
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)
_ = Proxy api -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Operation -> Identity Operation) -> Swagger -> Identity Swagger
Traversal' Swagger Operation
allOperations((Operation -> Identity Operation) -> Swagger -> Identity Swagger)
-> ((Maybe HeaderName -> Identity (Maybe HeaderName))
    -> Operation -> Identity Operation)
-> (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Swagger
-> Identity Swagger
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe HeaderName -> Identity (Maybe HeaderName))
-> Operation -> Identity Operation
forall s a. HasSummary s a => Lens' s a
summary ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Swagger -> Identity Swagger)
-> (Maybe HeaderName -> Maybe HeaderName) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack (Proxy desc -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy desc
forall k (t :: k). Proxy t
Proxy :: Proxy desc))) Maybe HeaderName -> Maybe HeaderName -> Maybe HeaderName
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Proxy (FoldRequired mods) -> Bool
forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (Proxy (FoldRequired mods)
forall k (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther ParamOtherSchema
sch
      sch :: ParamOtherSchema
sch = ParamOtherSchema
forall a. Monoid a => a
mempty
        ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema
  -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamOtherSchema
-> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy a -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther ParamOtherSchema
sch
      sch :: ParamOtherSchema
sch = ParamOtherSchema
forall a. Monoid a => a
mempty
        ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
        ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema
  -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamOtherSchema
-> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamSchema 'SwaggerKindParamOtherSchema
pschema
      pschema :: ParamSchema 'SwaggerKindParamOtherSchema
pschema = ParamSchema 'SwaggerKindParamOtherSchema
forall a. Monoid a => a
mempty
#if MIN_VERSION_swagger2(2,4,0)
        ParamSchema 'SwaggerKindParamOtherSchema
-> (ParamSchema 'SwaggerKindParamOtherSchema
    -> ParamSchema 'SwaggerKindParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
 -> Identity (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)))
-> ParamSchema 'SwaggerKindParamOtherSchema
-> Identity (ParamSchema 'SwaggerKindParamOtherSchema)
forall s a. HasType s a => Lens' s a
type_ ((Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
  -> Identity (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)))
 -> ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> SwaggerType 'SwaggerKindParamOtherSchema
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamSchema 'SwaggerKindParamOtherSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ SwaggerType 'SwaggerKindParamOtherSchema
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray
#else
        & type_ .~ SwaggerArray
#endif
        ParamSchema 'SwaggerKindParamOtherSchema
-> (ParamSchema 'SwaggerKindParamOtherSchema
    -> ParamSchema 'SwaggerKindParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
forall a b. a -> (a -> b) -> b
& (Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
 -> Identity (Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)))
-> ParamSchema 'SwaggerKindParamOtherSchema
-> Identity (ParamSchema 'SwaggerKindParamOtherSchema)
forall s a. HasItems s a => Lens' s a
items ((Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
  -> Identity (Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)))
 -> ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> SwaggerItems 'SwaggerKindParamOtherSchema
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamSchema 'SwaggerKindParamOtherSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Maybe (CollectionFormat 'SwaggerKindParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> SwaggerItems 'SwaggerKindParamOtherSchema
forall (t :: SwaggerKind *).
Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t
SwaggerItemsPrimitive (CollectionFormat 'SwaggerKindParamOtherSchema
-> Maybe (CollectionFormat 'SwaggerKindParamOtherSchema)
forall a. a -> Maybe a
Just CollectionFormat 'SwaggerKindParamOtherSchema
CollectionMulti) (Proxy a -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (ParamOtherSchema
forall a. Monoid a => a
mempty
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamQuery
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasAllowEmptyValue s a => Lens' s a
allowEmptyValue ((Maybe Bool -> Identity (Maybe Bool))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> Bool -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema
  -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamOtherSchema
-> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Proxy Bool -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy Bool
forall k (t :: k). Proxy t
Proxy :: Proxy Bool)
                ParamSchema 'SwaggerKindParamOtherSchema
-> (ParamSchema 'SwaggerKindParamOtherSchema
    -> ParamSchema 'SwaggerKindParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> ParamSchema 'SwaggerKindParamOtherSchema
-> Identity (ParamSchema 'SwaggerKindParamOtherSchema)
forall s a. HasDefault s a => Lens' s a
default_ ((Maybe Value -> Identity (Maybe Value))
 -> ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> Value
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamSchema 'SwaggerKindParamOtherSchema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    where
      tname :: HeaderName
tname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Proxy (FoldRequired mods) -> Bool
forall (b :: Bool) (proxy :: Bool -> *).
SBoolI b =>
proxy b -> Bool
reflectBool (Proxy (FoldRequired mods)
forall k (t :: k). Proxy t
Proxy :: Proxy (FoldRequired mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamOtherSchema -> ParamAnySchema
ParamOther (ParamOtherSchema
forall a. Monoid a => a
mempty
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamLocation -> Identity ParamLocation)
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasIn s a => Lens' s a
in_ ((ParamLocation -> Identity ParamLocation)
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamLocation -> ParamOtherSchema -> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ParamLocation
ParamHeader
            ParamOtherSchema
-> (ParamOtherSchema -> ParamOtherSchema) -> ParamOtherSchema
forall a b. a -> (a -> b) -> b
& (ParamSchema 'SwaggerKindParamOtherSchema
 -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
-> ParamOtherSchema -> Identity ParamOtherSchema
forall s a. HasParamSchema s a => Lens' s a
paramSchema ((ParamSchema 'SwaggerKindParamOtherSchema
  -> Identity (ParamSchema 'SwaggerKindParamOtherSchema))
 -> ParamOtherSchema -> Identity ParamOtherSchema)
-> ParamSchema 'SwaggerKindParamOtherSchema
-> ParamOtherSchema
-> ParamOtherSchema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Proxy a -> ParamSchema 'SwaggerKindParamOtherSchema
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& [MediaType] -> Swagger -> Swagger
addConsumes (Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
forall k (t :: k). Proxy t
Proxy :: Proxy cs))
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: HeaderName
tname = HeaderName
"body"
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name      ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required  ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema    ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
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)
_ = Proxy sub -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy sub
forall k (t :: k). Proxy t
Proxy :: Proxy sub)
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& Param -> Swagger -> Swagger
addParam Param
param
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& [MediaType] -> Swagger -> Swagger
addConsumes (NonEmpty MediaType -> [MediaType]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Proxy ct -> NonEmpty MediaType
forall k (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)))
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& HeaderName -> Swagger -> Swagger
addDefaultResponse400 HeaderName
tname
    Swagger -> (Swagger -> Swagger) -> Swagger
forall a b. a -> (a -> b) -> b
& (Definitions Schema -> Identity (Definitions Schema))
-> Swagger -> Identity Swagger
forall s a. HasDefinitions s a => Lens' s a
definitions ((Definitions Schema -> Identity (Definitions Schema))
 -> Swagger -> Identity Swagger)
-> (Definitions Schema -> Definitions Schema) -> Swagger -> Swagger
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definitions Schema -> Definitions Schema -> Definitions Schema
forall a. Semigroup a => a -> a -> a
<> Definitions Schema
defs)
    where
      tname :: HeaderName
tname = HeaderName
"body"
      transDesc :: FilePath -> Maybe HeaderName
transDesc FilePath
""   = Maybe HeaderName
forall a. Maybe a
Nothing
      transDesc FilePath
desc = HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
Just (FilePath -> HeaderName
Text.pack FilePath
desc)
      (Definitions Schema
defs, Referenced Schema
ref) = Declare (Definitions Schema) (Referenced Schema)
-> Definitions Schema -> (Definitions Schema, Referenced Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty
      param :: Param
param = Param
forall a. Monoid a => a
mempty
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (HeaderName -> Identity HeaderName) -> Param -> Identity Param
forall s a. HasName s a => Lens' s a
name      ((HeaderName -> Identity HeaderName) -> Param -> Identity Param)
-> HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HeaderName
tname
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe HeaderName -> Identity (Maybe HeaderName))
-> Param -> Identity Param
forall s a. HasDescription s a => Lens' s a
description ((Maybe HeaderName -> Identity (Maybe HeaderName))
 -> Param -> Identity Param)
-> Maybe HeaderName -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe HeaderName
transDesc (Proxy mods -> FilePath
forall (mods :: [*]).
KnownSymbol (FoldDescription mods) =>
Proxy mods -> FilePath
reflectDescription (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods))
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param
forall s a. HasRequired s a => Lens' s a
required  ((Maybe Bool -> Identity (Maybe Bool)) -> Param -> Identity Param)
-> Bool -> Param -> Param
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
        Param -> (Param -> Param) -> Param
forall a b. a -> (a -> b) -> b
& (ParamAnySchema -> Identity ParamAnySchema)
-> Param -> Identity Param
forall s a. HasSchema s a => Lens' s a
schema    ((ParamAnySchema -> Identity ParamAnySchema)
 -> Param -> Identity Param)
-> ParamAnySchema -> Param -> Param
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Referenced Schema -> ParamAnySchema
ParamBody Referenced Schema
ref

-- =======================================================================
-- 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)
_ = Proxy c -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) MediaType -> [MediaType] -> [MediaType]
forall a. a -> [a] -> [a]
: Proxy cs -> [MediaType]
forall k (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (Proxy cs
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) -> (HeaderName, Header)
toResponseHeader Proxy (Header sym a)
_ = (HeaderName
hname, Maybe HeaderName
-> ParamSchema ('SwaggerKindNormal Header) -> Header
Swagger.Header Maybe HeaderName
forall a. Maybe a
Nothing ParamSchema ('SwaggerKindNormal Header)
forall (t :: SwaggerKind *). ParamSchema t
hschema)
    where
      hname :: HeaderName
hname = FilePath -> HeaderName
Text.pack (Proxy sym -> FilePath
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym))
      hschema :: ParamSchema t
hschema = Proxy a -> ParamSchema t
forall a (t :: SwaggerKind *).
ToParamSchema a =>
Proxy a -> ParamSchema t
toParamSchema (Proxy a
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 HeaderName Header
toAllResponseHeaders Proxy '[]
_ = InsOrdHashMap HeaderName Header
forall a. Monoid a => a
mempty

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

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