{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

-- | Helpers for the generation of the operation functions
module OpenAPI.Generate.Internal.Operation
  ( getResponseObject,
    getResponseSchema,
    defineOperationFunction,
    getParameterDescription,
    generateParameterTypeFromOperation,
    getParametersTypeForSignature,
    getParametersTypeForSignatureWithMonadTransformer,
    getOperationName,
    getOperationDescription,
    getBodySchemaFromOperation,
    generateParameterizedRequestPath,
    generateQueryParams,
    shouldGenerateRequestBody,
    RequestBodyDefinition (..),
    ParameterTypeDefinition (..),
    ParameterCardinality (..),
  )
where

import Control.Monad
import qualified Data.Aeson as Aeson
import qualified Data.Bifunctor as BF
import qualified Data.Char as Char
import qualified Data.List.Split as Split
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH
import Language.Haskell.TH.PprLib hiding ((<>))
import qualified Network.HTTP.Simple as HS
import qualified Network.HTTP.Types as HT
import qualified OpenAPI.Common as OC
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Util
import qualified OpenAPI.Generate.Model as Model
import qualified OpenAPI.Generate.ModelDependencies as Dep
import qualified OpenAPI.Generate.Monad as OAM
import qualified OpenAPI.Generate.OptParse as OAO
import OpenAPI.Generate.OptParse.Types
import qualified OpenAPI.Generate.Types as OAT
import qualified OpenAPI.Generate.Types.Schema as OAS

-- | Extracted request body information which can be used for code generation
data RequestBodyDefinition = RequestBodyDefinition
  { RequestBodyDefinition -> Schema
requestBodyDefinitionSchema :: OAT.Schema,
    RequestBodyDefinition -> RequestBodyEncoding
requestBodyDefinitionEncoding :: OC.RequestBodyEncoding,
    RequestBodyDefinition -> Bool
requestBodyDefinitionRequired :: Bool
  }

-- | Defines the type of a parameter bundle including the information to access the specific parameters
data ParameterTypeDefinition = ParameterTypeDefinition
  { ParameterTypeDefinition -> Q Type
parameterTypeDefinitionType :: Q Type,
    ParameterTypeDefinition -> Q Doc
parameterTypeDefinitionDoc :: Q Doc,
    ParameterTypeDefinition -> Models
parameterTypeDefinitionDependencies :: Dep.Models,
    ParameterTypeDefinition -> [(Name, ParameterObject)]
parameterTypeDefinitionQueryParams :: [(Name, OAT.ParameterObject)],
    ParameterTypeDefinition -> [(Name, ParameterObject)]
parameterTypeDefinitionPathParams :: [(Name, OAT.ParameterObject)]
  }

-- | Represents the number of (supported) parameters and the generated types which result of it
--
-- * No type is generated when no parameters are present
-- * Only the type of the parameter is generated if a single parameter is present
-- * A combined parameter type is generated for multiple parameters
data ParameterCardinality
  = NoParameters
  | SingleParameter (Q Type) Dep.ModelContentWithDependencies OAT.ParameterObject
  | MultipleParameters ParameterTypeDefinition

-- | Generates the parameter type for an operation. See 'ParameterCardinality' for further information.
generateParameterTypeFromOperation :: Text -> OAT.OperationObject -> OAM.Generator ParameterCardinality
generateParameterTypeFromOperation :: Text -> OperationObject -> Generator ParameterCardinality
generateParameterTypeFromOperation Text
operationName = OperationObject -> Generator [(ParameterObject, [Text])]
getParametersFromOperationConcrete (OperationObject -> Generator [(ParameterObject, [Text])])
-> ([(ParameterObject, [Text])] -> Generator ParameterCardinality)
-> OperationObject
-> Generator ParameterCardinality
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text
-> [(ParameterObject, [Text])] -> Generator ParameterCardinality
generateParameterType Text
operationName

generateParameterType :: Text -> [(OAT.ParameterObject, [Text])] -> OAM.Generator ParameterCardinality
generateParameterType :: Text
-> [(ParameterObject, [Text])] -> Generator ParameterCardinality
generateParameterType Text
operationName [(ParameterObject, [Text])]
parameters = Text
-> Generator ParameterCardinality -> Generator ParameterCardinality
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"parameters" (Generator ParameterCardinality -> Generator ParameterCardinality)
-> Generator ParameterCardinality -> Generator ParameterCardinality
forall a b. (a -> b) -> a -> b
$ do
  [Maybe Schema]
maybeSchemas <- ((ParameterObject, [Text]) -> Generator (Maybe Schema))
-> [(ParameterObject, [Text])] -> Generator [Maybe Schema]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(ParameterObject
p, [Text]
path) -> [Text] -> Generator (Maybe Schema) -> Generator (Maybe Schema)
forall a. [Text] -> Generator a -> Generator a
OAM.resetPath [Text]
path (Generator (Maybe Schema) -> Generator (Maybe Schema))
-> Generator (Maybe Schema) -> Generator (Maybe Schema)
forall a b. (a -> b) -> a -> b
$ ParameterObject -> Generator (Maybe Schema)
getSchemaFromParameter ParameterObject
p) [(ParameterObject, [Text])]
parameters
  Text
parametersSuffix <- (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingParametersTypeSuffix
  let parametersWithSchemas :: [((ParameterObject, [Text]), Schema)]
parametersWithSchemas =
        [ ((ParameterObject
parameter, [Text]
path), ParameterObject -> Schema -> Schema
mergeDescriptionOfParameterWithSchema ParameterObject
parameter Schema
schema)
          | ((ParameterObject
parameter, [Text]
path), Just Schema
schema) <-
              [(ParameterObject, [Text])]
-> [Maybe Schema] -> [((ParameterObject, [Text]), Maybe Schema)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(ParameterObject, [Text])]
parameters [Maybe Schema]
maybeSchemas,
            ParameterObject -> ParameterObjectLocation
OAT.parameterObjectIn ParameterObject
parameter ParameterObjectLocation -> [ParameterObjectLocation] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ParameterObjectLocation
OAT.QueryParameterObjectLocation, ParameterObjectLocation
OAT.PathParameterObjectLocation]
        ]
      schemaName :: Text
schemaName = Text
operationName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
parametersSuffix
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(ParameterObject, [Text])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ParameterObject, [Text])]
parameters Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [((ParameterObject, [Text]), Schema)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((ParameterObject, [Text]), Schema)]
parametersWithSchemas) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning Text
"Parameters are only supported in query and path (skipping parameters in cookie and header)."
  case [((ParameterObject, [Text]), Schema)]
parametersWithSchemas of
    [] -> ParameterCardinality -> Generator ParameterCardinality
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterCardinality
NoParameters
    [((ParameterObject
parameter, [Text]
path), Schema
schema)] -> do
      -- TODO disable fixed value generation for parameters
      (Q Type
paramType, ModelContentWithDependencies
model) <- [Text]
-> Generator (Q Type, ModelContentWithDependencies)
-> Generator (Q Type, ModelContentWithDependencies)
forall a. [Text] -> Generator a -> Generator a
OAM.resetPath ([Text]
path [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"schema"]) (Generator (Q Type, ModelContentWithDependencies)
 -> Generator (Q Type, ModelContentWithDependencies))
-> Generator (Q Type, ModelContentWithDependencies)
-> Generator (Q Type, ModelContentWithDependencies)
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Generator (Q Type, ModelContentWithDependencies)
Model.defineModelForSchemaNamed (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
uppercaseFirstText (ParameterObject -> Text
OAT.parameterObjectName ParameterObject
parameter)) Schema
schema
      ParameterCardinality -> Generator ParameterCardinality
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterCardinality -> Generator ParameterCardinality)
-> ParameterCardinality -> Generator ParameterCardinality
forall a b. (a -> b) -> a -> b
$
        Q Type
-> ModelContentWithDependencies
-> ParameterObject
-> ParameterCardinality
SingleParameter
          ( if ParameterObject -> Bool
OAT.parameterObjectRequired ParameterObject
parameter
              then Q Type
paramType
              else [t|Maybe $(Q Type
paramType)|]
          )
          ModelContentWithDependencies
model
          ParameterObject
parameter
    [((ParameterObject, [Text]), Schema)]
_ -> do
      [(Text, Schema)]
properties <-
        (((ParameterObject, [Text]), Schema) -> Generator (Text, Schema))
-> [((ParameterObject, [Text]), Schema)]
-> Generator [(Text, Schema)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          ( \((ParameterObject
parameter, [Text]
_), Schema
schema) -> do
              Text
prefix <- ParameterObject -> Generator Text
getParameterLocationPrefix ParameterObject
parameter
              (Text, Schema) -> Generator (Text, Schema)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
uppercaseFirstText (ParameterObject -> Text
OAT.parameterObjectName ParameterObject
parameter), Schema
schema)
          )
          [((ParameterObject, [Text]), Schema)]
parametersWithSchemas
      let parametersWithNames :: [(Text, (ParameterObject, [Text]))]
parametersWithNames = [Text]
-> [(ParameterObject, [Text])]
-> [(Text, (ParameterObject, [Text]))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Text, Schema) -> Text
forall a b. (a, b) -> a
fst ((Text, Schema) -> Text) -> [(Text, Schema)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Schema)]
properties) (((ParameterObject, [Text]), Schema) -> (ParameterObject, [Text])
forall a b. (a, b) -> a
fst (((ParameterObject, [Text]), Schema) -> (ParameterObject, [Text]))
-> [((ParameterObject, [Text]), Schema)]
-> [(ParameterObject, [Text])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((ParameterObject, [Text]), Schema)]
parametersWithSchemas)
          requiredProperties :: Models
requiredProperties =
            [Text] -> Models
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Models) -> [Text] -> Models
forall a b. (a -> b) -> a -> b
$
              (Text, (ParameterObject, [Text])) -> Text
forall a b. (a, b) -> a
fst ((Text, (ParameterObject, [Text])) -> Text)
-> [(Text, (ParameterObject, [Text]))] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, (ParameterObject, [Text])) -> Bool)
-> [(Text, (ParameterObject, [Text]))]
-> [(Text, (ParameterObject, [Text]))]
forall a. (a -> Bool) -> [a] -> [a]
filter (ParameterObject -> Bool
OAT.parameterObjectRequired (ParameterObject -> Bool)
-> ((Text, (ParameterObject, [Text])) -> ParameterObject)
-> (Text, (ParameterObject, [Text]))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParameterObject, [Text]) -> ParameterObject
forall a b. (a, b) -> a
fst ((ParameterObject, [Text]) -> ParameterObject)
-> ((Text, (ParameterObject, [Text])) -> (ParameterObject, [Text]))
-> (Text, (ParameterObject, [Text]))
-> ParameterObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, (ParameterObject, [Text])) -> (ParameterObject, [Text])
forall a b. (a, b) -> b
snd) [(Text, (ParameterObject, [Text]))]
parametersWithNames
      (Q Type
parameterTypeDefinitionType, (Q Doc
parameterTypeDefinitionDoc, Models
parameterTypeDefinitionDependencies)) <-
        -- Explicitly include fixed value properties since this is not
        -- a user defined object schema but one that is defined by the
        -- generator and is only here to make the usage easier.
        -- It should therefore not change the semantics.
        (Settings -> Settings)
-> Generator (Q Type, ModelContentWithDependencies)
-> Generator (Q Type, ModelContentWithDependencies)
forall a. (Settings -> Settings) -> Generator a -> Generator a
OAM.adjustSettings (\Settings
settings -> Settings
settings {OAO.settingFixedValueStrategy = FixedValueStrategyInclude}) (Generator (Q Type, ModelContentWithDependencies)
 -> Generator (Q Type, ModelContentWithDependencies))
-> Generator (Q Type, ModelContentWithDependencies)
-> Generator (Q Type, ModelContentWithDependencies)
forall a b. (a -> b) -> a -> b
$
          Text -> Schema -> Generator (Q Type, ModelContentWithDependencies)
Model.defineModelForSchemaNamed Text
schemaName (Schema -> Generator (Q Type, ModelContentWithDependencies))
-> Schema -> Generator (Q Type, ModelContentWithDependencies)
forall a b. (a -> b) -> a -> b
$
            SchemaObject -> Schema
forall a. a -> Referencable a
OAT.Concrete (SchemaObject -> Schema) -> SchemaObject -> Schema
forall a b. (a -> b) -> a -> b
$
              SchemaObject
OAS.defaultSchema {OAS.schemaObjectProperties = Map.fromList properties, OAS.schemaObjectRequired = requiredProperties}
      Bool
convertToCamelCase <- (Settings -> Bool) -> Generator Bool
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Bool
OAO.settingConvertToCamelCase
      let parametersWithPropertyNames :: [(Name, ParameterObject)]
parametersWithPropertyNames = (Text -> Name)
-> ((ParameterObject, [Text]) -> ParameterObject)
-> (Text, (ParameterObject, [Text]))
-> (Name, ParameterObject)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap (Bool -> Bool -> Text -> Name
haskellifyName Bool
convertToCamelCase Bool
False (Text -> Name) -> (Text -> Text) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
uppercaseFirstText) (ParameterObject, [Text]) -> ParameterObject
forall a b. (a, b) -> a
fst ((Text, (ParameterObject, [Text])) -> (Name, ParameterObject))
-> [(Text, (ParameterObject, [Text]))] -> [(Name, ParameterObject)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, (ParameterObject, [Text]))]
parametersWithNames
          filterByType :: ParameterObjectLocation -> [(Name, ParameterObject)]
filterByType ParameterObjectLocation
t = ((Name, ParameterObject) -> Bool)
-> [(Name, ParameterObject)] -> [(Name, ParameterObject)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ParameterObjectLocation -> ParameterObjectLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ParameterObjectLocation
t) (ParameterObjectLocation -> Bool)
-> ((Name, ParameterObject) -> ParameterObjectLocation)
-> (Name, ParameterObject)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterObject -> ParameterObjectLocation
OAT.parameterObjectIn (ParameterObject -> ParameterObjectLocation)
-> ((Name, ParameterObject) -> ParameterObject)
-> (Name, ParameterObject)
-> ParameterObjectLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, ParameterObject) -> ParameterObject
forall a b. (a, b) -> b
snd) [(Name, ParameterObject)]
parametersWithPropertyNames
          parameterTypeDefinitionQueryParams :: [(Name, ParameterObject)]
parameterTypeDefinitionQueryParams = ParameterObjectLocation -> [(Name, ParameterObject)]
filterByType ParameterObjectLocation
OAT.QueryParameterObjectLocation
          parameterTypeDefinitionPathParams :: [(Name, ParameterObject)]
parameterTypeDefinitionPathParams = ParameterObjectLocation -> [(Name, ParameterObject)]
filterByType ParameterObjectLocation
OAT.PathParameterObjectLocation
      ParameterCardinality -> Generator ParameterCardinality
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParameterCardinality -> Generator ParameterCardinality)
-> ParameterCardinality -> Generator ParameterCardinality
forall a b. (a -> b) -> a -> b
$ ParameterTypeDefinition -> ParameterCardinality
MultipleParameters ParameterTypeDefinition {[(Name, ParameterObject)]
Q Type
Q Doc
Models
parameterTypeDefinitionType :: Q Type
parameterTypeDefinitionDoc :: Q Doc
parameterTypeDefinitionDependencies :: Models
parameterTypeDefinitionQueryParams :: [(Name, ParameterObject)]
parameterTypeDefinitionPathParams :: [(Name, ParameterObject)]
parameterTypeDefinitionType :: Q Type
parameterTypeDefinitionDoc :: Q Doc
parameterTypeDefinitionDependencies :: Models
parameterTypeDefinitionQueryParams :: [(Name, ParameterObject)]
parameterTypeDefinitionPathParams :: [(Name, ParameterObject)]
..}

mergeDescriptionOfParameterWithSchema :: OAT.ParameterObject -> OAS.Schema -> OAS.Schema
mergeDescriptionOfParameterWithSchema :: ParameterObject -> Schema -> Schema
mergeDescriptionOfParameterWithSchema ParameterObject
parameter (OAT.Concrete SchemaObject
schema) =
  let parameterName :: Text
parameterName = ParameterObject -> Text
OAT.parameterObjectName ParameterObject
parameter
      descriptionParameter :: [Text]
descriptionParameter = Maybe Text -> [Text]
forall a. Maybe a -> [a]
Maybe.maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ParameterObject -> Maybe Text
OAT.parameterObjectDescription ParameterObject
parameter
      descriptionSchema :: [Text]
descriptionSchema = Maybe Text -> [Text]
forall a. Maybe a -> [a]
Maybe.maybeToList (Maybe Text -> [Text]) -> Maybe Text -> [Text]
forall a b. (a -> b) -> a -> b
$ SchemaObject -> Maybe Text
OAS.schemaObjectDescription SchemaObject
schema
      mergedDescription :: Text
mergedDescription = Text -> [Text] -> Text
T.intercalate Text
"\n\n" ((Text
"Represents the parameter named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
parameterName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
descriptionParameter [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
descriptionSchema)
   in SchemaObject -> Schema
forall a. a -> Referencable a
OAT.Concrete (SchemaObject -> Schema) -> SchemaObject -> Schema
forall a b. (a -> b) -> a -> b
$ SchemaObject
schema {OAS.schemaObjectDescription = Just mergedDescription}
mergeDescriptionOfParameterWithSchema ParameterObject
_ Schema
schema = Schema
schema

getParameterLocationPrefix :: OAT.ParameterObject -> OAM.Generator Text
getParameterLocationPrefix :: ParameterObject -> Generator Text
getParameterLocationPrefix =
  ( \case
      ParameterObjectLocation
OAT.QueryParameterObjectLocation -> (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingParameterQueryPrefix
      ParameterObjectLocation
OAT.PathParameterObjectLocation -> (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingParameterPathPrefix
      ParameterObjectLocation
OAT.CookieParameterObjectLocation -> (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingParameterCookiePrefix
      ParameterObjectLocation
OAT.HeaderParameterObjectLocation -> (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingParameterHeaderPrefix
  )
    (ParameterObjectLocation -> Generator Text)
-> (ParameterObject -> ParameterObjectLocation)
-> ParameterObject
-> Generator Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterObject -> ParameterObjectLocation
OAT.parameterObjectIn

-- | Extracts all parameters of an operation
--
-- Concrete objects are always added. References try to get resolved to a concrete object.
-- If this fails, the parameter is skipped and a warning gets produced.
getParametersFromOperationConcrete :: OAT.OperationObject -> OAM.Generator [(OAT.ParameterObject, [Text])]
getParametersFromOperationConcrete :: OperationObject -> Generator [(ParameterObject, [Text])]
getParametersFromOperationConcrete =
  Text
-> Generator [(ParameterObject, [Text])]
-> Generator [(ParameterObject, [Text])]
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"parameters"
    (Generator [(ParameterObject, [Text])]
 -> Generator [(ParameterObject, [Text])])
-> (OperationObject -> Generator [(ParameterObject, [Text])])
-> OperationObject
-> Generator [(ParameterObject, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe (ParameterObject, [Text])] -> [(ParameterObject, [Text])])
-> Generator [Maybe (ParameterObject, [Text])]
-> Generator [(ParameterObject, [Text])]
forall a b. (a -> b) -> Generator a -> Generator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (ParameterObject, [Text])] -> [(ParameterObject, [Text])]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
    (Generator [Maybe (ParameterObject, [Text])]
 -> Generator [(ParameterObject, [Text])])
-> (OperationObject -> Generator [Maybe (ParameterObject, [Text])])
-> OperationObject
-> Generator [(ParameterObject, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Referencable ParameterObject)
 -> Generator (Maybe (ParameterObject, [Text])))
-> [(Int, Referencable ParameterObject)]
-> Generator [Maybe (ParameterObject, [Text])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      ( \case
          (Int
i, OAT.Concrete ParameterObject
p) -> do
            [Text]
path <- [Text] -> Generator [Text]
OAM.appendToPath [Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"]
            Maybe (ParameterObject, [Text])
-> Generator (Maybe (ParameterObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ParameterObject, [Text])
 -> Generator (Maybe (ParameterObject, [Text])))
-> Maybe (ParameterObject, [Text])
-> Generator (Maybe (ParameterObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (ParameterObject, [Text]) -> Maybe (ParameterObject, [Text])
forall a. a -> Maybe a
Just (ParameterObject
p, [Text]
path)
          (Int
i, OAT.Reference Text
ref) -> Text
-> Generator (Maybe (ParameterObject, [Text]))
-> Generator (Maybe (ParameterObject, [Text]))
forall a. Text -> Generator a -> Generator a
OAM.nested (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") (Generator (Maybe (ParameterObject, [Text]))
 -> Generator (Maybe (ParameterObject, [Text])))
-> Generator (Maybe (ParameterObject, [Text]))
-> Generator (Maybe (ParameterObject, [Text]))
forall a b. (a -> b) -> a -> b
$ do
            Maybe ParameterObject
p <- Text -> Generator (Maybe ParameterObject)
OAM.getParameterReferenceM Text
ref
            Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ParameterObject -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe ParameterObject
p) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Reference " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to parameter could not be found and therefore will be skipped."
            let name :: Text
name = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"#/components/parameters/" Text
"" Text
ref
            Maybe (ParameterObject, [Text])
-> Generator (Maybe (ParameterObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ParameterObject, [Text])
 -> Generator (Maybe (ParameterObject, [Text])))
-> Maybe (ParameterObject, [Text])
-> Generator (Maybe (ParameterObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (,[Text
"components", Text
"parameters", Text
name]) (ParameterObject -> (ParameterObject, [Text]))
-> Maybe ParameterObject -> Maybe (ParameterObject, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ParameterObject
p
      )
    ([(Int, Referencable ParameterObject)]
 -> Generator [Maybe (ParameterObject, [Text])])
-> (OperationObject -> [(Int, Referencable ParameterObject)])
-> OperationObject
-> Generator [Maybe (ParameterObject, [Text])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [Referencable ParameterObject]
-> [(Int, Referencable ParameterObject)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
0 ..] :: [Int])
    ([Referencable ParameterObject]
 -> [(Int, Referencable ParameterObject)])
-> (OperationObject -> [Referencable ParameterObject])
-> OperationObject
-> [(Int, Referencable ParameterObject)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationObject -> [Referencable ParameterObject]
OAT.operationObjectParameters

getSchemaFromParameterObjectSchema :: OAT.ParameterObjectSchema -> OAM.Generator (Maybe OAS.Schema)
getSchemaFromParameterObjectSchema :: ParameterObjectSchema -> Generator (Maybe Schema)
getSchemaFromParameterObjectSchema (OAT.SimpleParameterObjectSchema OAT.SimpleParameterSchema {Bool
Maybe Value
Maybe Text
Map Text (Referencable ExampleObject)
Schema
simpleParameterSchemaStyle :: Maybe Text
simpleParameterSchemaExplode :: Bool
simpleParameterSchemaAllowReserved :: Bool
simpleParameterSchemaSchema :: Schema
simpleParameterSchemaExample :: Maybe Value
simpleParameterSchemaExamples :: Map Text (Referencable ExampleObject)
simpleParameterSchemaStyle :: SimpleParameterSchema -> Maybe Text
simpleParameterSchemaExplode :: SimpleParameterSchema -> Bool
simpleParameterSchemaAllowReserved :: SimpleParameterSchema -> Bool
simpleParameterSchemaSchema :: SimpleParameterSchema -> Schema
simpleParameterSchemaExample :: SimpleParameterSchema -> Maybe Value
simpleParameterSchemaExamples :: SimpleParameterSchema -> Map Text (Referencable ExampleObject)
..}) = Maybe Schema -> Generator (Maybe Schema)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Schema -> Generator (Maybe Schema))
-> Maybe Schema -> Generator (Maybe Schema)
forall a b. (a -> b) -> a -> b
$ Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
simpleParameterSchemaSchema
getSchemaFromParameterObjectSchema (OAT.ComplexParameterObjectSchema Map Text MediaTypeObject
_) = Text -> Generator (Maybe Schema) -> Generator (Maybe Schema)
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"content" (Generator (Maybe Schema) -> Generator (Maybe Schema))
-> Generator (Maybe Schema) -> Generator (Maybe Schema)
forall a b. (a -> b) -> a -> b
$ do
  Text -> Generator ()
OAM.logWarning Text
"Complex parameter schemas are not supported and therefore will be skipped."
  Maybe Schema -> Generator (Maybe Schema)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Schema
forall a. Maybe a
Nothing

-- | Reads the schema from the parameter
getSchemaFromParameter :: OAT.ParameterObject -> OAM.Generator (Maybe OAS.Schema)
getSchemaFromParameter :: ParameterObject -> Generator (Maybe Schema)
getSchemaFromParameter = ParameterObjectSchema -> Generator (Maybe Schema)
getSchemaFromParameterObjectSchema (ParameterObjectSchema -> Generator (Maybe Schema))
-> (ParameterObject -> ParameterObjectSchema)
-> ParameterObject
-> Generator (Maybe Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterObject -> ParameterObjectSchema
OAT.parameterObjectSchema

-- | Gets the Type definition dependent on the number of parameters/types
--   A monadic name for which its forall structure is defined outside
--   this function can be given
--
--   @
--     [t|OC.Configuration -> Int -> $(varT monadName) ($(responseType) $(responseInnerType))|]
--       = getParametersTypeForSignature [conT ''Int] (monadName)
--   @
getParametersTypeForSignature :: [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignature :: [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignature [Q Type]
types Name
responseTypeName Name
monadName =
  [Q Type] -> Q Type
createFunctionType
    ( [t|OC.Configuration|]
        Q Type -> [Q Type] -> [Q Type]
forall a. a -> [a] -> [a]
: [Q Type]
types
          [Q Type] -> [Q Type] -> [Q Type]
forall a. Semigroup a => a -> a -> a
<> [[t|$(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
monadName) (HS.Response $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
responseTypeName))|]]
    )

-- | Same as 'getParametersTypeForSignature' but with the configuration in 'MR.ReaderT' instead of a parameter
getParametersTypeForSignatureWithMonadTransformer :: [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignatureWithMonadTransformer :: [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignatureWithMonadTransformer [Q Type]
types Name
responseTypeName Name
monadName =
  [Q Type] -> Q Type
createFunctionType
    ( [Q Type]
types
        [Q Type] -> [Q Type] -> [Q Type]
forall a. Semigroup a => a -> a -> a
<> [[t|OC.ClientT $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
monadName) (HS.Response $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
responseTypeName))|]]
    )

createFunctionType :: [Q Type] -> Q Type
createFunctionType :: [Q Type] -> Q Type
createFunctionType =
  (Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1
    (\Q Type
t1 Q Type
t2 -> [t|$Q Type
t1 -> $Q Type
t2|])

getParameterName :: OAT.ParameterObject -> OAM.Generator Name
getParameterName :: ParameterObject -> Generator Name
getParameterName ParameterObject
parameter = Bool -> Text -> Generator Name
haskellifyNameM Bool
False (Text -> Generator Name) -> Text -> Generator Name
forall a b. (a -> b) -> a -> b
$ ParameterObject -> Text
OAT.parameterObjectName ParameterObject
parameter

-- | Get a description of a parameter object (the name and if available the description from the specification)
getParameterDescription :: OAT.ParameterObject -> OAM.Generator Text
getParameterDescription :: ParameterObject -> Generator Text
getParameterDescription ParameterObject
parameter = do
  Maybe SchemaObject
schema <- case ParameterObject -> Maybe Schema
getSchemaOfParameterObject ParameterObject
parameter of
    Just Schema
schema -> Schema -> Generator (Maybe SchemaObject)
Model.resolveSchemaReferenceWithoutWarning Schema
schema
    Maybe Schema
Nothing -> Maybe SchemaObject -> Generator (Maybe SchemaObject)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SchemaObject
forall a. Maybe a
Nothing
  let name :: Text
name = ParameterObject -> Text
OAT.parameterObjectName ParameterObject
parameter
      description :: Text
description = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ParameterObject -> Maybe Text
OAT.parameterObjectDescription ParameterObject
parameter
      constraints :: Text
constraints = Text -> [Text] -> Text
forall a. Monoid a => a -> [a] -> a
joinWith Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject -> [Text]
Model.getConstraintDescriptionsOfSchema Maybe SchemaObject
schema
  Text -> Generator Text
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Generator Text) -> Text -> Generator Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Doc.escapeText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
constraints then Text
"" else Text
" | Constraints: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints)

getSchemaOfParameterObject :: OAT.ParameterObject -> Maybe OAS.Schema
getSchemaOfParameterObject :: ParameterObject -> Maybe Schema
getSchemaOfParameterObject ParameterObject
parameterObject = case ParameterObject -> ParameterObjectSchema
OAT.parameterObjectSchema ParameterObject
parameterObject of
  (OAT.SimpleParameterObjectSchema OAT.SimpleParameterSchema {Bool
Maybe Value
Maybe Text
Map Text (Referencable ExampleObject)
Schema
simpleParameterSchemaStyle :: SimpleParameterSchema -> Maybe Text
simpleParameterSchemaExplode :: SimpleParameterSchema -> Bool
simpleParameterSchemaAllowReserved :: SimpleParameterSchema -> Bool
simpleParameterSchemaSchema :: SimpleParameterSchema -> Schema
simpleParameterSchemaExample :: SimpleParameterSchema -> Maybe Value
simpleParameterSchemaExamples :: SimpleParameterSchema -> Map Text (Referencable ExampleObject)
simpleParameterSchemaStyle :: Maybe Text
simpleParameterSchemaExplode :: Bool
simpleParameterSchemaAllowReserved :: Bool
simpleParameterSchemaSchema :: Schema
simpleParameterSchemaExample :: Maybe Value
simpleParameterSchemaExamples :: Map Text (Referencable ExampleObject)
..}) -> Schema -> Maybe Schema
forall a. a -> Maybe a
Just Schema
simpleParameterSchemaSchema
  OAT.ComplexParameterObjectSchema Map Text MediaTypeObject
_ -> Maybe Schema
forall a. Maybe a
Nothing

-- | Defines the body of an Operation function
--   The Operation function calls an generall HTTP function
--   all Parameters are arguments to the function
defineOperationFunction ::
  -- | Should the configuration be passed explicitly as parameter?
  Bool ->
  -- | How the function should be called
  Name ->
  -- | The parameters
  ParameterCardinality ->
  -- | The request path. It may contain placeholders in the form /my/{var}/path/
  Text ->
  -- | HTTP Method (POST,GET,etc.)
  Text ->
  -- | Schema of body
  Maybe RequestBodyDefinition ->
  -- | An expression used to transform the response from 'BS.ByteString' to the required response type.
  -- Note that the response is nested within a HTTP monad and an 'Either'.
  Q Exp ->
  -- | Function body definition in TH
  OAM.Generator (Q Doc)
defineOperationFunction :: Bool
-> Name
-> ParameterCardinality
-> Text
-> Text
-> Maybe RequestBodyDefinition
-> Q Exp
-> Generator (Q Doc)
defineOperationFunction Bool
useExplicitConfiguration Name
fnName ParameterCardinality
parameterCardinality Text
requestPath Text
method Maybe RequestBodyDefinition
bodySchema Q Exp
responseTransformerExp = do
  let configName :: Name
configName = String -> Name
mkName String
"config"
      paramName :: Name
paramName = String -> Name
mkName String
"parameters"
      bodyName :: Name
bodyName = String -> Name
mkName String
"body"
  [Q Pat]
paraPattern <- case ParameterCardinality
parameterCardinality of
    ParameterCardinality
NoParameters -> [Q Pat] -> Generator [Q Pat]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    SingleParameter Q Type
_ ModelContentWithDependencies
_ ParameterObject
parameter -> do
      Name
paramName' <- ParameterObject -> Generator Name
getParameterName ParameterObject
parameter
      [Q Pat] -> Generator [Q Pat]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
paramName']
    MultipleParameters ParameterTypeDefinition
_ -> [Q Pat] -> Generator [Q Pat]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
paramName]
  ([(Q Exp, ParameterObject)]
pathParameters, [(Q Exp, ParameterObject)]
queryParameters) <- case ParameterCardinality
parameterCardinality of
    ParameterCardinality
NoParameters -> ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
-> Generator
     ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
    SingleParameter Q Type
_ ModelContentWithDependencies
_ ParameterObject
parameter -> do
      Name
paramName' <- ParameterObject -> Generator Name
getParameterName ParameterObject
parameter
      let paramExpr :: (Q Exp, ParameterObject)
paramExpr = (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
paramName', ParameterObject
parameter)
      ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
-> Generator
     ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
 -> Generator
      ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)]))
-> ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
-> Generator
     ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
forall a b. (a -> b) -> a -> b
$
        if ParameterObject -> ParameterObjectLocation
OAT.parameterObjectIn ParameterObject
parameter ParameterObjectLocation -> ParameterObjectLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ParameterObjectLocation
OAT.PathParameterObjectLocation
          then ([(Q Exp, ParameterObject)
paramExpr], [])
          else ([], [(Q Exp, ParameterObject)
paramExpr])
    MultipleParameters ParameterTypeDefinition
paramDefinition ->
      let toParamExpr :: (ParameterTypeDefinition -> f (p Name c)) -> f (p (m Exp) c)
toParamExpr ParameterTypeDefinition -> f (p Name c)
f = (Name -> m Exp) -> p Name c -> p (m Exp) c
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first (\Name
name -> [|$(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
name) $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
paramName)|]) (p Name c -> p (m Exp) c) -> f (p Name c) -> f (p (m Exp) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterTypeDefinition -> f (p Name c)
f ParameterTypeDefinition
paramDefinition
       in ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
-> Generator
     ([(Q Exp, ParameterObject)], [(Q Exp, ParameterObject)])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ParameterTypeDefinition -> [(Name, ParameterObject)])
-> [(Q Exp, ParameterObject)]
forall {p :: * -> * -> *} {m :: * -> *} {f :: * -> *} {c}.
(Bifunctor p, Quote m, Functor f) =>
(ParameterTypeDefinition -> f (p Name c)) -> f (p (m Exp) c)
toParamExpr ParameterTypeDefinition -> [(Name, ParameterObject)]
parameterTypeDefinitionPathParams, (ParameterTypeDefinition -> [(Name, ParameterObject)])
-> [(Q Exp, ParameterObject)]
forall {p :: * -> * -> *} {m :: * -> *} {f :: * -> *} {c}.
(Bifunctor p, Quote m, Functor f) =>
(ParameterTypeDefinition -> f (p Name c)) -> f (p (m Exp) c)
toParamExpr ParameterTypeDefinition -> [(Name, ParameterObject)]
parameterTypeDefinitionQueryParams)
  let queryParameters' :: Q Exp
queryParameters' = [(Q Exp, ParameterObject)] -> Q Exp
generateQueryParams [(Q Exp, ParameterObject)]
queryParameters
      request :: Q Exp
request = [(Q Exp, ParameterObject)] -> Text -> Q Exp
generateParameterizedRequestPath [(Q Exp, ParameterObject)]
pathParameters Text
requestPath
      methodLit :: Q Exp
methodLit = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
method
      fnPatterns :: [Q Pat]
fnPatterns = if Bool
useExplicitConfiguration then Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
configName Q Pat -> [Q Pat] -> [Q Pat]
forall a. a -> [a] -> [a]
: [Q Pat]
paraPattern else [Q Pat]
paraPattern
  Bool
generateBody <- Maybe RequestBodyDefinition -> Generator Bool
shouldGenerateRequestBody Maybe RequestBodyDefinition
bodySchema
  Q Doc -> Generator (Q Doc)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Doc -> Generator (Q Doc)) -> Q Doc -> Generator (Q Doc)
forall a b. (a -> b) -> a -> b
$
    Decs -> Doc
forall a. Ppr a => a -> Doc
ppr (Decs -> Doc) -> Q Decs -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe RequestBodyDefinition
bodySchema of
      Just RequestBodyDefinition {Bool
RequestBodyEncoding
Schema
requestBodyDefinitionSchema :: RequestBodyDefinition -> Schema
requestBodyDefinitionEncoding :: RequestBodyDefinition -> RequestBodyEncoding
requestBodyDefinitionRequired :: RequestBodyDefinition -> Bool
requestBodyDefinitionSchema :: Schema
requestBodyDefinitionEncoding :: RequestBodyEncoding
requestBodyDefinitionRequired :: Bool
..}
        | Bool
generateBody ->
            let encodeExpr :: Q Exp
encodeExpr =
                  Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$
                    case RequestBodyEncoding
requestBodyDefinitionEncoding of
                      RequestBodyEncoding
OC.RequestBodyEncodingFormData -> 'OC.RequestBodyEncodingFormData
                      RequestBodyEncoding
OC.RequestBodyEncodingJSON -> 'OC.RequestBodyEncodingJSON
             in [d|
                  $(Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
fnName ([Q Pat] -> Q Pat) -> [Q Pat] -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Q Pat]
fnPatterns [Q Pat] -> [Q Pat] -> [Q Pat]
forall a. Semigroup a => a -> a -> a
<> [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
bodyName]) =
                    $Q Exp
responseTransformerExp
                      ( $( if Bool
useExplicitConfiguration
                             then [|OC.doBodyCallWithConfiguration $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
configName)|]
                             else [|OC.doBodyCallWithConfigurationM|]
                         )
                          (T.toUpper $ T.pack $Q Exp
methodLit)
                          $(Q Exp
request)
                          $(Q Exp
queryParameters')
                          $(if Bool
requestBodyDefinitionRequired then [|Just $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
bodyName)|] else Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
bodyName)
                          $(Q Exp
encodeExpr)
                      )
                  |]
      Maybe RequestBodyDefinition
_ ->
        [d|
          $(Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
fnName [Q Pat]
fnPatterns) =
            $Q Exp
responseTransformerExp
              ( $( if Bool
useExplicitConfiguration
                     then [|OC.doCallWithConfiguration $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
configName)|]
                     else [|OC.doCallWithConfigurationM|]
                 )
                  (T.toUpper $ T.pack $Q Exp
methodLit)
                  $(Q Exp
request)
                  $(Q Exp
queryParameters')
              )
          |]

-- | Checks if a request body should be generated based on the CLI options and if the body type is an empty object
shouldGenerateRequestBody :: Maybe RequestBodyDefinition -> OAM.Generator Bool
shouldGenerateRequestBody :: Maybe RequestBodyDefinition -> Generator Bool
shouldGenerateRequestBody Maybe RequestBodyDefinition
Nothing = Bool -> Generator Bool
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
shouldGenerateRequestBody (Just RequestBodyDefinition {Bool
RequestBodyEncoding
Schema
requestBodyDefinitionSchema :: RequestBodyDefinition -> Schema
requestBodyDefinitionEncoding :: RequestBodyDefinition -> RequestBodyEncoding
requestBodyDefinitionRequired :: RequestBodyDefinition -> Bool
requestBodyDefinitionSchema :: Schema
requestBodyDefinitionEncoding :: RequestBodyEncoding
requestBodyDefinitionRequired :: Bool
..}) = do
  Maybe SchemaObject
maybeSchema <- Schema -> Generator (Maybe SchemaObject)
Model.resolveSchemaReferenceWithoutWarning Schema
requestBodyDefinitionSchema
  Bool
generateEmptyRequestBody <- (Settings -> Bool) -> Generator Bool
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Bool
OAO.settingGenerateOptionalEmptyRequestBody
  case Maybe SchemaObject
maybeSchema of
    Just SchemaObject
s
      | Bool -> Bool
not Bool
generateEmptyRequestBody
          Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
requestBodyDefinitionRequired
          Bool -> Bool -> Bool
&& SchemaObject -> Bool
OAS.isSchemaEmpty SchemaObject
s ->
          Bool -> Generator Bool
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Maybe SchemaObject
_ -> Bool -> Generator Bool
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | Extracts the request body schema from an operation and the encoding which should be used on the body data.
getBodySchemaFromOperation :: OAT.OperationObject -> OAM.Generator (Maybe RequestBodyDefinition, [Text])
getBodySchemaFromOperation :: OperationObject -> Generator (Maybe RequestBodyDefinition, [Text])
getBodySchemaFromOperation OperationObject
operation = Text
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"requestBody" (Generator (Maybe RequestBodyDefinition, [Text])
 -> Generator (Maybe RequestBodyDefinition, [Text]))
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a b. (a -> b) -> a -> b
$ do
  Maybe (RequestBodyObject, [Text])
requestBody <- OperationObject -> Generator (Maybe (RequestBodyObject, [Text]))
getRequestBodyObject OperationObject
operation
  case Maybe (RequestBodyObject, [Text])
requestBody of
    Just (RequestBodyObject
body, [Text]
path) -> [Text]
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. [Text] -> Generator a -> Generator a
OAM.resetPath [Text]
path (Generator (Maybe RequestBodyDefinition, [Text])
 -> Generator (Maybe RequestBodyDefinition, [Text]))
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a b. (a -> b) -> a -> b
$ RequestBodyObject
-> Generator (Maybe RequestBodyDefinition, [Text])
getRequestBodySchema RequestBodyObject
body
    Maybe (RequestBodyObject, [Text])
Nothing -> (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RequestBodyDefinition
forall a. Maybe a
Nothing, [])

getRequestBodySchema :: OAT.RequestBodyObject -> OAM.Generator (Maybe RequestBodyDefinition, [Text])
getRequestBodySchema :: RequestBodyObject
-> Generator (Maybe RequestBodyDefinition, [Text])
getRequestBodySchema RequestBodyObject
body = Text
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"content" (Generator (Maybe RequestBodyDefinition, [Text])
 -> Generator (Maybe RequestBodyDefinition, [Text]))
-> Generator (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a b. (a -> b) -> a -> b
$ do
  let contentMap :: Map Text MediaTypeObject
contentMap = RequestBodyObject -> Map Text MediaTypeObject
OAT.requestBodyObjectContent RequestBodyObject
body
      content :: Maybe MediaTypeObject
content = Map Text MediaTypeObject -> Maybe MediaTypeObject
getJsonMediaTypeObject Map Text MediaTypeObject
contentMap
      createRequestBodyDefinition :: RequestBodyEncoding -> Schema -> Maybe RequestBodyDefinition
createRequestBodyDefinition RequestBodyEncoding
encoding Schema
schema =
        RequestBodyDefinition -> Maybe RequestBodyDefinition
forall a. a -> Maybe a
Just (RequestBodyDefinition -> Maybe RequestBodyDefinition)
-> RequestBodyDefinition -> Maybe RequestBodyDefinition
forall a b. (a -> b) -> a -> b
$
          RequestBodyDefinition
            { requestBodyDefinitionSchema :: Schema
requestBodyDefinitionSchema = Schema
schema,
              requestBodyDefinitionEncoding :: RequestBodyEncoding
requestBodyDefinitionEncoding = RequestBodyEncoding
encoding,
              requestBodyDefinitionRequired :: Bool
requestBodyDefinitionRequired = RequestBodyObject -> Bool
OAT.requestBodyObjectRequired RequestBodyObject
body
            }
  case Maybe MediaTypeObject
content of
    Maybe MediaTypeObject
Nothing ->
      let formContent :: Maybe MediaTypeObject
formContent = Text -> Map Text MediaTypeObject -> Maybe MediaTypeObject
getValueByContentTypeIgnoringCharset Text
"application/x-www-form-urlencoded" Map Text MediaTypeObject
contentMap
       in case Maybe MediaTypeObject
formContent of
            Maybe MediaTypeObject
Nothing -> do
              Text -> Generator ()
OAM.logWarning Text
"Only content type application/json and application/x-www-form-urlencoded is supported"
              (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RequestBodyDefinition
forall a. Maybe a
Nothing, [])
            Just MediaTypeObject
media -> do
              [Text]
path <- [Text] -> Generator [Text]
OAM.appendToPath [Text
"application/x-www-form-urlencoded", Text
"schema"]
              (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( MediaTypeObject -> Maybe Schema
OAT.mediaTypeObjectSchema MediaTypeObject
media
                    Maybe Schema
-> (Schema -> Maybe RequestBodyDefinition)
-> Maybe RequestBodyDefinition
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RequestBodyEncoding -> Schema -> Maybe RequestBodyDefinition
createRequestBodyDefinition RequestBodyEncoding
OC.RequestBodyEncodingFormData,
                  [Text]
path
                )
    Just MediaTypeObject
media -> do
      [Text]
path <- [Text] -> Generator [Text]
OAM.appendToPath [Text
"application/json", Text
"schema"]
      (Maybe RequestBodyDefinition, [Text])
-> Generator (Maybe RequestBodyDefinition, [Text])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( MediaTypeObject -> Maybe Schema
OAT.mediaTypeObjectSchema MediaTypeObject
media
            Maybe Schema
-> (Schema -> Maybe RequestBodyDefinition)
-> Maybe RequestBodyDefinition
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RequestBodyEncoding -> Schema -> Maybe RequestBodyDefinition
createRequestBodyDefinition RequestBodyEncoding
OC.RequestBodyEncodingJSON,
          [Text]
path
        )

getRequestBodyObject :: OAT.OperationObject -> OAM.Generator (Maybe (OAT.RequestBodyObject, [Text]))
getRequestBodyObject :: OperationObject -> Generator (Maybe (RequestBodyObject, [Text]))
getRequestBodyObject OperationObject
operation =
  case OperationObject -> Maybe (Referencable RequestBodyObject)
OAT.operationObjectRequestBody OperationObject
operation of
    Maybe (Referencable RequestBodyObject)
Nothing -> Maybe (RequestBodyObject, [Text])
-> Generator (Maybe (RequestBodyObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (RequestBodyObject, [Text])
forall a. Maybe a
Nothing
    Just (OAT.Concrete RequestBodyObject
p) -> do
      [Text]
path <- Generator [Text]
OAM.getCurrentPath
      Maybe (RequestBodyObject, [Text])
-> Generator (Maybe (RequestBodyObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (RequestBodyObject, [Text])
 -> Generator (Maybe (RequestBodyObject, [Text])))
-> Maybe (RequestBodyObject, [Text])
-> Generator (Maybe (RequestBodyObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (RequestBodyObject, [Text]) -> Maybe (RequestBodyObject, [Text])
forall a. a -> Maybe a
Just (RequestBodyObject
p, [Text]
path)
    Just (OAT.Reference Text
ref) -> do
      Maybe RequestBodyObject
p <- Text -> Generator (Maybe RequestBodyObject)
OAM.getRequestBodyReferenceM Text
ref
      Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe RequestBodyObject -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe RequestBodyObject
p) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Reference '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' to request body could not be found and therefore will be skipped."
      let name :: Text
name = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"#/components/requestBodies/" Text
"" Text
ref
      Maybe (RequestBodyObject, [Text])
-> Generator (Maybe (RequestBodyObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (RequestBodyObject, [Text])
 -> Generator (Maybe (RequestBodyObject, [Text])))
-> Maybe (RequestBodyObject, [Text])
-> Generator (Maybe (RequestBodyObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (,[Text
"components", Text
"requestBodies", Text
name]) (RequestBodyObject -> (RequestBodyObject, [Text]))
-> Maybe RequestBodyObject -> Maybe (RequestBodyObject, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RequestBodyObject
p

-- | Extracts the response 'OAT.Schema' from a 'OAT.ResponseObject'.
--
-- A warning is logged if the response does not contain one of the supported media types.
getResponseSchema :: OAT.ResponseObject -> OAM.Generator (Maybe OAT.Schema, [Text])
getResponseSchema :: ResponseObject -> Generator (Maybe Schema, [Text])
getResponseSchema ResponseObject
response = Text
-> Generator (Maybe Schema, [Text])
-> Generator (Maybe Schema, [Text])
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"content" (Generator (Maybe Schema, [Text])
 -> Generator (Maybe Schema, [Text]))
-> Generator (Maybe Schema, [Text])
-> Generator (Maybe Schema, [Text])
forall a b. (a -> b) -> a -> b
$ do
  let contentMap :: Map Text MediaTypeObject
contentMap = ResponseObject -> Map Text MediaTypeObject
OAT.responseObjectContent ResponseObject
response
      schema :: Maybe Schema
schema = Map Text MediaTypeObject -> Maybe MediaTypeObject
getJsonMediaTypeObject Map Text MediaTypeObject
contentMap Maybe MediaTypeObject
-> (MediaTypeObject -> Maybe Schema) -> Maybe Schema
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MediaTypeObject -> Maybe Schema
OAT.mediaTypeObjectSchema
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Schema -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe Schema
schema Bool -> Bool -> Bool
&& Bool -> Bool
not (Map Text MediaTypeObject -> Bool
forall k a. Map k a -> Bool
Map.null Map Text MediaTypeObject
contentMap)) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning Text
"Only content type application/json is supported for response bodies."
  [Text]
path <- [Text] -> Generator [Text]
OAM.appendToPath [Text
"application/json", Text
"schema"]
  (Maybe Schema, [Text]) -> Generator (Maybe Schema, [Text])
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Schema
schema, [Text]
path)

getValueByContentTypeIgnoringCharset :: Text -> Map.Map Text OAT.MediaTypeObject -> Maybe OAT.MediaTypeObject
getValueByContentTypeIgnoringCharset :: Text -> Map Text MediaTypeObject -> Maybe MediaTypeObject
getValueByContentTypeIgnoringCharset Text
contentType Map Text MediaTypeObject
contentMap =
  case Text -> Map Text MediaTypeObject -> Maybe MediaTypeObject
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
contentType Map Text MediaTypeObject
contentMap of
    Just MediaTypeObject
content -> MediaTypeObject -> Maybe MediaTypeObject
forall a. a -> Maybe a
Just MediaTypeObject
content
    Maybe MediaTypeObject
Nothing -> case Map Text MediaTypeObject -> [MediaTypeObject]
forall k a. Map k a -> [a]
Map.elems (Map Text MediaTypeObject -> [MediaTypeObject])
-> Map Text MediaTypeObject -> [MediaTypeObject]
forall a b. (a -> b) -> a -> b
$ (Text -> MediaTypeObject -> Bool)
-> Map Text MediaTypeObject -> Map Text MediaTypeObject
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Text
key MediaTypeObject
_ -> Text -> Maybe Text
getMediaTypeWithoutCharset Text
key Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
contentType) Map Text MediaTypeObject
contentMap of
      [] -> Maybe MediaTypeObject
forall a. Maybe a
Nothing
      MediaTypeObject
content : [MediaTypeObject]
_ -> MediaTypeObject -> Maybe MediaTypeObject
forall a. a -> Maybe a
Just MediaTypeObject
content

getMediaTypeWithoutCharset :: Text -> Maybe Text
getMediaTypeWithoutCharset :: Text -> Maybe Text
getMediaTypeWithoutCharset = [Text] -> Maybe Text
forall a. [a] -> Maybe a
Maybe.listToMaybe ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
";"

getJsonMediaTypeObject :: Map.Map Text OAT.MediaTypeObject -> Maybe OAT.MediaTypeObject
getJsonMediaTypeObject :: Map Text MediaTypeObject -> Maybe MediaTypeObject
getJsonMediaTypeObject Map Text MediaTypeObject
contentMap =
  case Text -> Map Text MediaTypeObject -> Maybe MediaTypeObject
getValueByContentTypeIgnoringCharset Text
"application/json" Map Text MediaTypeObject
contentMap of
    Just MediaTypeObject
content -> MediaTypeObject -> Maybe MediaTypeObject
forall a. a -> Maybe a
Just MediaTypeObject
content
    Maybe MediaTypeObject
Nothing -> case Map Text MediaTypeObject -> [MediaTypeObject]
forall k a. Map k a -> [a]
Map.elems (Map Text MediaTypeObject -> [MediaTypeObject])
-> Map Text MediaTypeObject -> [MediaTypeObject]
forall a b. (a -> b) -> a -> b
$ (Text -> MediaTypeObject -> Bool)
-> Map Text MediaTypeObject -> Map Text MediaTypeObject
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Text
key MediaTypeObject
_ -> Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
isCustomJsonMediaType (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe Text
forall a. [a] -> Maybe a
Maybe.listToMaybe (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
";" Text
key)) Map Text MediaTypeObject
contentMap of
      [] -> Maybe MediaTypeObject
forall a. Maybe a
Nothing
      MediaTypeObject
content : [MediaTypeObject]
_ -> MediaTypeObject -> Maybe MediaTypeObject
forall a. a -> Maybe a
Just MediaTypeObject
content

isCustomJsonMediaType :: Text -> Bool
isCustomJsonMediaType :: Text -> Bool
isCustomJsonMediaType Text
mediaType = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"+" Text
mediaType of
  [Text
_, Text
"json"] -> Bool
True
  [Text]
_ -> Bool
False

-- | Resolve a possibly referenced response to a concrete value.
--
-- A warning is logged if the reference is not found.
getResponseObject :: OAT.Referencable OAT.ResponseObject -> OAM.Generator (Maybe (OAT.ResponseObject, [Text]))
getResponseObject :: Referencable ResponseObject
-> Generator (Maybe (ResponseObject, [Text]))
getResponseObject (OAT.Concrete ResponseObject
p) = do
  [Text]
path <- Generator [Text]
OAM.getCurrentPath
  Maybe (ResponseObject, [Text])
-> Generator (Maybe (ResponseObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ResponseObject, [Text])
 -> Generator (Maybe (ResponseObject, [Text])))
-> Maybe (ResponseObject, [Text])
-> Generator (Maybe (ResponseObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (ResponseObject, [Text]) -> Maybe (ResponseObject, [Text])
forall a. a -> Maybe a
Just (ResponseObject
p, [Text]
path)
getResponseObject (OAT.Reference Text
ref) = do
  Maybe ResponseObject
p <- Text -> Generator (Maybe ResponseObject)
OAM.getResponseReferenceM Text
ref
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ResponseObject -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe ResponseObject
p) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Reference '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' to response could not be found and therefore will be skipped."
  let name :: Text
name = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"#/components/responses/" Text
"" Text
ref
  Maybe (ResponseObject, [Text])
-> Generator (Maybe (ResponseObject, [Text]))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ResponseObject, [Text])
 -> Generator (Maybe (ResponseObject, [Text])))
-> Maybe (ResponseObject, [Text])
-> Generator (Maybe (ResponseObject, [Text]))
forall a b. (a -> b) -> a -> b
$ (,[Text
"components", Text
"responses", Text
name]) (ResponseObject -> (ResponseObject, [Text]))
-> Maybe ResponseObject -> Maybe (ResponseObject, [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ResponseObject
p

-- | Generates query params in the form of [(Text,ByteString)]
generateQueryParams :: [(Q Exp, OAT.ParameterObject)] -> Q Exp
generateQueryParams :: [(Q Exp, ParameterObject)] -> Q Exp
generateQueryParams [] = [|mempty|]
generateQueryParams [(Q Exp, ParameterObject)]
x =
  [Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
listE
    ([Q Exp] -> Q Exp)
-> ([(Q Exp, ParameterObject)] -> [Q Exp])
-> [(Q Exp, ParameterObject)]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Q Exp, ParameterObject) -> Q Exp)
-> [(Q Exp, ParameterObject)] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \(Q Exp
var, ParameterObject
param) ->
          let queryName :: Q Exp
queryName = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ParameterObject -> Text
OAT.parameterObjectName ParameterObject
param
              required :: Bool
required = ParameterObject -> Bool
OAT.parameterObjectRequired ParameterObject
param
              (Maybe Text
maybeStyle, Bool
explode') = case ParameterObject -> ParameterObjectSchema
OAT.parameterObjectSchema ParameterObject
param of
                (OAT.SimpleParameterObjectSchema OAT.SimpleParameterSchema {Bool
Maybe Value
Maybe Text
Map Text (Referencable ExampleObject)
Schema
simpleParameterSchemaStyle :: SimpleParameterSchema -> Maybe Text
simpleParameterSchemaExplode :: SimpleParameterSchema -> Bool
simpleParameterSchemaAllowReserved :: SimpleParameterSchema -> Bool
simpleParameterSchemaSchema :: SimpleParameterSchema -> Schema
simpleParameterSchemaExample :: SimpleParameterSchema -> Maybe Value
simpleParameterSchemaExamples :: SimpleParameterSchema -> Map Text (Referencable ExampleObject)
simpleParameterSchemaStyle :: Maybe Text
simpleParameterSchemaExplode :: Bool
simpleParameterSchemaAllowReserved :: Bool
simpleParameterSchemaSchema :: Schema
simpleParameterSchemaExample :: Maybe Value
simpleParameterSchemaExamples :: Map Text (Referencable ExampleObject)
..}) -> (Maybe Text
simpleParameterSchemaStyle, Bool
simpleParameterSchemaExplode)
                OAT.ComplexParameterObjectSchema Map Text MediaTypeObject
_ -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"form", Bool
True)
              style' :: Q Exp
style' =
                String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$
                  Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
                    Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe
                      ( case ParameterObject -> ParameterObjectLocation
OAT.parameterObjectIn ParameterObject
param of
                          ParameterObjectLocation
OAT.QueryParameterObjectLocation -> Text
"form"
                          ParameterObjectLocation
OAT.HeaderParameterObjectLocation -> Text
"simple"
                          ParameterObjectLocation
OAT.PathParameterObjectLocation -> Text
"simple"
                          ParameterObjectLocation
OAT.CookieParameterObjectLocation -> Text
"form"
                      )
                      Maybe Text
maybeStyle
              expr :: Q Exp
expr =
                if Bool
required
                  then [|Just $ Aeson.toJSON $Q Exp
var|]
                  else [|Aeson.toJSON <$> $Q Exp
var|]
           in [|OC.QueryParameter (T.pack $Q Exp
queryName) $Q Exp
expr (T.pack $Q Exp
style') explode'|]
      )
    ([(Q Exp, ParameterObject)] -> Q Exp)
-> [(Q Exp, ParameterObject)] -> Q Exp
forall a b. (a -> b) -> a -> b
$ [(Q Exp, ParameterObject)]
x

-- | Resolves placeholders in paths with dynamic expressions
--
--   "my/{var}/path" -> "my" ++ myVar ++ "/path"
--
--   If the placeholder is at the end or at the beginning an empty string gets appended
generateParameterizedRequestPath :: [(Q Exp, OAT.ParameterObject)] -> Text -> Q Exp
generateParameterizedRequestPath :: [(Q Exp, ParameterObject)] -> Text -> Q Exp
generateParameterizedRequestPath ((Q Exp
paramName, ParameterObject
param) : [(Q Exp, ParameterObject)]
xs) Text
path =
  (Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (Q Exp -> Q Exp -> Q Exp -> Q Exp
foldingFn Q Exp
paramName) [Q Exp]
partExpressiones
  where
    parts :: [String]
parts = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn (String
"{" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ParameterObject -> Text
OAT.parameterObjectName ParameterObject
param) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"}") (Text -> String
T.unpack Text
path)
    partExpressiones :: [Q Exp]
partExpressiones = [(Q Exp, ParameterObject)] -> Text -> Q Exp
generateParameterizedRequestPath [(Q Exp, ParameterObject)]
xs (Text -> Q Exp) -> (String -> Text) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Q Exp) -> [String] -> [Q Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
parts
    foldingFn :: Q Exp -> Q Exp -> Q Exp -> Q Exp
    foldingFn :: Q Exp -> Q Exp -> Q Exp -> Q Exp
foldingFn Q Exp
var Q Exp
a Q Exp
b = [|$(Q Exp
a) <> OC.byteToText (HT.urlEncode True $ OC.textToByte $ OC.stringifyModel $Q Exp
var) <> $(Q Exp
b)|]
generateParameterizedRequestPath [(Q Exp, ParameterObject)]
_ Text
path = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
path

-- | Extracts a description from an 'OAT.OperationObject'.
-- If available, the description is used, the summary otherwise.
-- If neither is available, an empty description is used.
getOperationDescription :: OAT.OperationObject -> Text
getOperationDescription :: OperationObject -> Text
getOperationDescription OperationObject
operation =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
    [Text] -> Maybe Text
forall a. [a] -> Maybe a
Maybe.listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$
      [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        [ OperationObject -> Maybe Text
OAT.operationObjectDescription OperationObject
operation,
          OperationObject -> Maybe Text
OAT.operationObjectSummary OperationObject
operation
        ]

-- | Constructs the name of an operation.
-- If an 'OAT.operationId' is available, this is the primary choice.
-- If it is not available, the id is constructed based on the request path and method.
getOperationName :: Text -> Text -> OAT.OperationObject -> OAM.Generator Name
getOperationName :: Text -> Text -> OperationObject -> Generator Name
getOperationName Text
requestPath Text
method OperationObject
operation =
  let operationId :: Maybe Text
operationId = OperationObject -> Maybe Text
OAT.operationObjectOperationId OperationObject
operation
      textName :: Text
textName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe ((Char -> Char) -> Text -> Text
T.map Char -> Char
Char.toLower Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
requestPath) Maybe Text
operationId
   in Bool -> Text -> Generator Name
haskellifyNameM Bool
False Text
textName