{-# 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
{-# OPTIONS_GHC -Wno-orphans #-}
module Servant.OpenApi.Internal where

import Prelude ()
import Prelude.Compat

#if MIN_VERSION_servant(0,18,1)
import           Control.Applicative                    ((<|>))
#endif
import           Control.Lens
import           Data.Aeson
import           Data.Foldable              (toList)
import           Data.HashMap.Strict.InsOrd (InsOrdHashMap)
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import           Data.OpenApi               hiding (Header, contentType)
import qualified Data.OpenApi               as OpenApi
import           Data.OpenApi.Declare
import           Data.Proxy
import           Data.Singletons.Bool
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Data.Typeable              (Typeable)
import           GHC.TypeLits
import           Network.HTTP.Media         (MediaType)
import           Servant.API
import           Servant.API.Description    (FoldDescription, reflectDescription)
import           Servant.API.Modifiers      (FoldRequired)
#if MIN_VERSION_servant(0,19,0)
import           Servant.API.Generic        (ToServantApi)
#endif

import           Servant.OpenApi.Internal.TypeLevel.API

-- | Generate a OpenApi specification for a servant API.
--
-- To generate OpenApi 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/openapi3/docs/Data-OpenApi.html openapi3 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
--
-- myOpenApi :: OpenApi
-- myOpenApi = toOpenApi (Proxy :: Proxy MyAPI)
-- @
class HasOpenApi api where
  -- | Generate a OpenApi specification for a servant API.
  toOpenApi :: Proxy api -> OpenApi

instance HasOpenApi Raw where
  toOpenApi :: Proxy Raw -> OpenApi
toOpenApi 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 HasOpenApi EmptyAPI where
  toOpenApi :: Proxy EmptyAPI -> OpenApi
toOpenApi 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, HasOpenApi sub) =>
  Proxy sub     -- ^ Part of a servant API.
  -> Proxy api  -- ^ The whole servant API.
  -> Traversal' OpenApi Operation
subOperations :: forall sub api.
(IsSubAPI sub api, HasOpenApi sub) =>
Proxy sub -> Proxy api -> Traversal' OpenApi Operation
subOperations Proxy sub
sub Proxy api
_ = OpenApi -> Traversal' OpenApi Operation
operationsOf (forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi Proxy sub
sub)

-- | Make a singleton OpenApi 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, OpenApiMethod method, KnownNat status)
  => FilePath                                       -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs a))  -- ^ Method, content-types, headers and response.
  -> OpenApi
mkEndpoint :: forall {k1} a (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(ToSchema a, AllAccept cs, AllToResponseHeader hs,
 OpenApiMethod method, KnownNat status) =>
FilePath -> proxy (Verb method status cs (Headers hs a)) -> OpenApi
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, OpenApiMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
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. HasComponents s a => Lens' s a
componentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasSchemas s a => Lens' s a
schemas 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 'OpenApi' spec (with only one endpoint) and with no content schema.
mkEndpointNoContent :: forall nocontent cs hs proxy method status.
  (AllAccept cs, AllToResponseHeader hs, OpenApiMethod method, KnownNat status)
  => FilePath                                               -- ^ Endpoint path.
  -> proxy (Verb method status cs (Headers hs nocontent))  -- ^ Method, content-types, headers and response.
  -> OpenApi
mkEndpointNoContent :: forall {k1} nocontent (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat).
(AllAccept cs, AllToResponseHeader hs, OpenApiMethod method,
 KnownNat status) =>
FilePath
-> proxy (Verb method status cs (Headers hs nocontent)) -> OpenApi
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, OpenApiMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
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, OpenApiMethod method, KnownNat status)
  => Maybe (Referenced Schema)
  -> FilePath
  -> proxy (Verb method status cs (Headers hs a))
  -> OpenApi
mkEndpointWithSchemaRef :: forall {k1} (cs :: [*]) (hs :: [*]) (proxy :: * -> *)
       (method :: k1) (status :: Nat) a.
(AllAccept cs, AllToResponseHeader hs, OpenApiMethod method,
 KnownNat status) =>
Maybe (Referenced Schema)
-> FilePath
-> proxy (Verb method status cs (Headers hs a))
-> OpenApi
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 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. HasContent s a => Lens' s a
content forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
              [(MediaType
t, 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) | MediaType
t <- [MediaType]
responseContentTypes]
            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 (Referenced Header)
responseHeaders)))
  where
    method :: (Maybe Operation -> Identity (Maybe Operation))
-> PathItem -> Identity PathItem
method               = forall {k} (method :: k) (proxy :: k -> *).
OpenApiMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
openApiMethod (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 (Referenced Header)
responseHeaders      = forall a. a -> Referenced a
Inline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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.
  (OpenApiMethod method)
  => FilePath                      -- ^ Endpoint path.
  -> proxy (NoContentVerb method)  -- ^ Method
  -> OpenApi
mkEndpointNoContentVerb :: forall {k1} (proxy :: * -> *) (method :: k1).
OpenApiMethod method =>
FilePath -> proxy (NoContentVerb method) -> OpenApi
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 -> *).
OpenApiMethod method =>
proxy method -> Lens' PathItem (Maybe Operation)
openApiMethod (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 -> OpenApi -> OpenApi
addParam :: Param -> OpenApi -> OpenApi
addParam Param
param = Traversal' OpenApi 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 RequestBody to every operations in the spec.
addRequestBody :: RequestBody -> OpenApi -> OpenApi
addRequestBody :: RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
rb = Traversal' OpenApi Operation
allOperations forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRequestBody s a => Lens' s a
requestBody forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline RequestBody
rb

-- | 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
"`"

addDefaultResponse404 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse404 :: Text -> OpenApi -> OpenApi
addDefaultResponse404 Text
pname = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
setResponseWith (\Response
old Response
_new -> Response -> Response
alter404 Response
old) HttpStatusCode
404 (forall (m :: * -> *) a. Monad m => a -> m a
return Response
response404)
  where
    sname :: Text
sname = Text -> Text
markdownCode Text
pname
    description404 :: Text
description404 = Text
sname forall a. Semigroup a => a -> a -> a
<> Text
" not found"
    alter404 :: Response -> Response
alter404 = forall s a. HasDescription s a => Lens' s a
description forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Text
sname forall a. Semigroup a => a -> a -> a
<> Text
" or ") forall a. Semigroup a => a -> a -> a
<>)
    response404 :: Response
response404 = 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
description404

addDefaultResponse400 :: ParamName -> OpenApi -> OpenApi
addDefaultResponse400 :: Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
pname = (Response -> Response -> Response)
-> HttpStatusCode
-> Declare (Definitions Schema) Response
-> OpenApi
-> OpenApi
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 OpenApi.
class OpenApiMethod method where
  openApiMethod :: proxy method -> Lens' PathItem (Maybe Operation)

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

#if MIN_VERSION_servant(0,18,1)
instance HasOpenApi (UVerb method cs '[]) where
  toOpenApi :: Proxy (UVerb method cs '[]) -> OpenApi
toOpenApi Proxy (UVerb method cs '[])
_ = forall a. Monoid a => a
mempty

-- | @since <2.0.1.0>
instance
  {-# OVERLAPPABLE #-}
  ( ToSchema a,
    HasStatus a,
    AllAccept cs,
    OpenApiMethod method,
    HasOpenApi (UVerb method cs as)
  ) =>
  HasOpenApi (UVerb method cs (a ': as))
  where
  toOpenApi :: Proxy (UVerb method cs (a : as)) -> OpenApi
toOpenApi Proxy (UVerb method cs (a : as))
_ =
    forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method (StatusOf a) cs a))
      OpenApi -> OpenApi -> OpenApi
`combineSwagger` forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy (UVerb method cs as))
    where
      -- workaround for https://github.com/GetShopTV/swagger2/issues/218
      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
        , _pathItemTrace :: Maybe Operation
_pathItemTrace = PathItem -> Maybe Operation
_pathItemTrace PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> Maybe Operation
_pathItemTrace 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
        , _pathItemSummary :: Maybe Text
_pathItemSummary = PathItem -> Maybe Text
_pathItemSummary PathItem
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_pathItemSummary PathItem
t
        , _pathItemDescription :: Maybe Text
_pathItemDescription = PathItem -> Maybe Text
_pathItemDescription PathItem
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PathItem -> Maybe Text
_pathItemDescription PathItem
t
        , _pathItemServers :: [Server]
_pathItemServers = PathItem -> [Server]
_pathItemServers PathItem
s forall a. Semigroup a => a -> a -> a
<> PathItem -> [Server]
_pathItemServers PathItem
t
        }

      combineSwagger :: OpenApi -> OpenApi -> OpenApi
      combineSwagger :: OpenApi -> OpenApi -> OpenApi
combineSwagger OpenApi
s OpenApi
t = OpenApi
        { _openApiOpenapi :: OpenApiSpecVersion
_openApiOpenapi = OpenApi -> OpenApiSpecVersion
_openApiOpenapi OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> OpenApiSpecVersion
_openApiOpenapi OpenApi
t
        , _openApiInfo :: Info
_openApiInfo = OpenApi -> Info
_openApiInfo OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> Info
_openApiInfo OpenApi
t
        , _openApiServers :: [Server]
_openApiServers = OpenApi -> [Server]
_openApiServers OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> [Server]
_openApiServers OpenApi
t
        , _openApiPaths :: InsOrdHashMap FilePath PathItem
_openApiPaths = 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 (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
s) (OpenApi -> InsOrdHashMap FilePath PathItem
_openApiPaths OpenApi
t)
        , _openApiComponents :: Components
_openApiComponents = OpenApi -> Components
_openApiComponents OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> Components
_openApiComponents OpenApi
t
        , _openApiSecurity :: [SecurityRequirement]
_openApiSecurity = OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> [SecurityRequirement]
_openApiSecurity OpenApi
t
        , _openApiTags :: InsOrdHashSet Tag
_openApiTags = OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
s forall a. Semigroup a => a -> a -> a
<> OpenApi -> InsOrdHashSet Tag
_openApiTags OpenApi
t
        , _openApiExternalDocs :: Maybe ExternalDocs
_openApiExternalDocs = OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenApi -> Maybe ExternalDocs
_openApiExternalDocs OpenApi
t
        }

instance (Typeable (WithStatus s a), ToSchema a) => ToSchema (WithStatus s a) where
  declareNamedSchema :: Proxy (WithStatus s a) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (WithStatus s a)
_ = forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
#endif

instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs, KnownNat status, OpenApiMethod method) => HasOpenApi (Verb method status cs a) where
  toOpenApi :: Proxy (Verb method status cs a) -> OpenApi
toOpenApi Proxy (Verb method status cs a)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (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, OpenApiMethod method) => HasOpenApi (Stream method status fr ct a) where
  toOpenApi :: Proxy (Stream method status fr ct a) -> OpenApi
toOpenApi Proxy (Stream method status fr ct a)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Verb method status '[ct] (Headers '[] a)))

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

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

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

instance (OpenApiMethod method) => HasOpenApi (NoContentVerb method) where
  toOpenApi :: Proxy (NoContentVerb method) -> OpenApi
toOpenApi =  forall {k1} (proxy :: * -> *) (method :: k1).
OpenApiMethod method =>
FilePath -> proxy (NoContentVerb method) -> OpenApi
mkEndpointNoContentVerb FilePath
"/"

instance (HasOpenApi a, HasOpenApi b) => HasOpenApi (a :<|> b) where
  toOpenApi :: Proxy (a :<|> b) -> OpenApi
toOpenApi Proxy (a :<|> b)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Semigroup a => a -> a -> a
<> forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)

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

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

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

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

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

instance (KnownSymbol sym, HasOpenApi sub) => HasOpenApi (sym :> sub) where
  toOpenApi :: Proxy (sym :> sub) -> OpenApi
toOpenApi Proxy (sym :> sub)
_ = FilePath -> OpenApi -> OpenApi
prependPath FilePath
piece (forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (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, ToParamSchema a, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (Capture' mods sym a :> sub) where
  toOpenApi :: Proxy (Capture' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (Capture' mods sym a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    forall a b. a -> (a -> b) -> b
& FilePath -> OpenApi -> OpenApi
prependPath FilePath
capture
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
addDefaultResponse404 Text
tname
    where
      pname :: FilePath
pname = forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> FilePath
symbolVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy sym)
      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. 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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline (forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

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

instance (KnownSymbol desc, HasOpenApi api) => HasOpenApi (Description desc :> api) where
  toOpenApi :: Proxy (Description desc :> api) -> OpenApi
toOpenApi Proxy (Description desc :> api)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
    forall a b. a -> (a -> b) -> b
& Traversal' OpenApi 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, HasOpenApi api) => HasOpenApi (Summary desc :> api) where
  toOpenApi :: Proxy (Summary desc :> api) -> OpenApi
toOpenApi Proxy (Summary desc :> api)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy api)
    forall a b. a -> (a -> b) -> b
& Traversal' OpenApi 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, HasOpenApi sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasOpenApi (QueryParam' mods sym a :> sub) where
  toOpenApi :: Proxy (QueryParam' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (QueryParam' mods sym a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
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. 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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline Schema
sch
      sch :: Schema
sch = forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub) => HasOpenApi (QueryParams sym a :> sub) where
  toOpenApi :: Proxy (QueryParams sym a :> sub) -> OpenApi
toOpenApi Proxy (QueryParams sym a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
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. 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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. a -> Referenced a
Inline Schema
pschema
      pschema :: Schema
pschema = forall a. Monoid a => a
mempty
        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
?~ OpenApiType
OpenApiArray
        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
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject (forall a. a -> Referenced a
Inline forall a b. (a -> b) -> a -> b
$ forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

instance (KnownSymbol sym, HasOpenApi sub) => HasOpenApi (QueryFlag sym :> sub) where
  toOpenApi :: Proxy (QueryFlag sym :> sub) -> OpenApi
toOpenApi Proxy (QueryFlag sym :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
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. 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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (forall a. a -> Referenced a
Inline forall a b. (a -> b) -> a -> b
$ (forall a. ToParamSchema a => Proxy a -> Schema
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, HasOpenApi sub, SBoolI (FoldRequired mods), KnownSymbol (FoldDescription mods)) => HasOpenApi (Header' mods  sym a :> sub) where
  toOpenApi :: Proxy (Header' mods sym a :> sub) -> OpenApi
toOpenApi Proxy (Header' mods sym a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& Param -> OpenApi -> OpenApi
addParam Param
param
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
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. 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. HasSchema s a => Lens' s a
schema forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (forall a. a -> Referenced a
Inline forall a b. (a -> b) -> a -> b
$ forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))

instance (ToSchema a, AllAccept cs, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (ReqBody' mods cs a :> sub) where
  toOpenApi :: Proxy (ReqBody' mods cs a :> sub) -> OpenApi
toOpenApi Proxy (ReqBody' mods cs a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqBody
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    forall a b. a -> (a -> b) -> b
& forall s a. HasComponents s a => Lens' s a
componentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasSchemas s a => Lens' s a
schemas 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
      reqBody :: RequestBody
reqBody = (forall a. Monoid a => a
mempty :: RequestBody)
        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. HasContent s a => Lens' s a
content forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(MediaType
t, 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 (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref) | MediaType
t <- forall {k} (cs :: k). AllAccept cs => Proxy cs -> [MediaType]
allContentType (forall {k} (t :: k). Proxy t
Proxy :: Proxy cs)]

-- | This instance is an approximation.
--
-- @since 1.1.7
instance (ToSchema a, Accept ct, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (StreamBody' mods fr ct a :> sub) where
  toOpenApi :: Proxy (StreamBody' mods fr ct a :> sub) -> OpenApi
toOpenApi Proxy (StreamBody' mods fr ct a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
    forall a b. a -> (a -> b) -> b
& RequestBody -> OpenApi -> OpenApi
addRequestBody RequestBody
reqBody
    forall a b. a -> (a -> b) -> b
& Text -> OpenApi -> OpenApi
addDefaultResponse400 Text
tname
    forall a b. a -> (a -> b) -> b
& forall s a. HasComponents s a => Lens' s a
componentsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. HasSchemas s a => Lens' s a
schemas 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
      reqBody :: RequestBody
reqBody = (forall a. Monoid a => a
mempty :: RequestBody)
        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. HasContent s a => Lens' s a
content forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(MediaType
t, 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 (Maybe b) -> b -> s -> t
?~ Referenced Schema
ref) | MediaType
t <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall {k} (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ct)]

#if MIN_VERSION_servant(0,18,2)
instance (HasOpenApi sub) => HasOpenApi (Fragment a :> sub) where
  toOpenApi :: Proxy (Fragment a :> sub) -> OpenApi
toOpenApi Proxy (Fragment a :> sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy sub)
#endif

#if MIN_VERSION_servant(0,19,0)
instance (HasOpenApi (ToServantApi sub)) => HasOpenApi (NamedRoutes sub) where
  toOpenApi :: Proxy (NamedRoutes sub) -> OpenApi
toOpenApi Proxy (NamedRoutes sub)
_ = forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ToServantApi sub))
#endif

-- =======================================================================
-- 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, OpenApi.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, 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 (Maybe b) -> b -> s -> t
?~ Referenced Schema
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 :: Referenced Schema
hschema = forall a. a -> Referenced a
Inline forall a b. (a -> b) -> a -> b
$ forall a. ToParamSchema a => Proxy a -> Schema
toParamSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

class AllToResponseHeader hs where
  toAllResponseHeaders :: Proxy hs -> InsOrdHashMap HeaderName OpenApi.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)