{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections #-}

-- | Contains the functionality to define operation functions for path items.
module OpenAPI.Generate.Operation
  ( defineOperationsForPath,
  )
where

import qualified Control.Applicative as Applicative
import Control.Monad
import qualified Data.Bifunctor as BF
import qualified Data.ByteString as BS
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 OpenAPI.Common as OC
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Operation
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 qualified OpenAPI.Generate.Response as OAR
import qualified OpenAPI.Generate.Types as OAT

#if MIN_VERSION_template_haskell(2,17,0)
nameToTypeVariable :: Name -> Q (TyVarBndr Specificity)
nameToTypeVariable :: Name -> Q (TyVarBndr Specificity)
nameToTypeVariable Name
monadName = Name -> Specificity -> Q (TyVarBndr Specificity)
forall (m :: * -> *).
Quote m =>
Name -> Specificity -> m (TyVarBndr Specificity)
plainInvisTV Name
monadName Specificity
specifiedSpec
#else
nameToTypeVariable :: Name -> Q TyVarBndr
nameToTypeVariable monadName = pure $ plainTV monadName
#endif

-- | Defines the operations for all paths and their methods
defineOperationsForPath :: String -> Text -> OAT.PathItemObject -> OAM.Generator (Q [Dep.ModuleDefinition], Dep.Models)
defineOperationsForPath :: String
-> Text
-> PathItemObject
-> Generator (Q [ModuleDefinition], Models)
defineOperationsForPath String
mainModuleName Text
requestPath PathItemObject
pathItemObject = Text
-> Generator (Q [ModuleDefinition], Models)
-> Generator (Q [ModuleDefinition], Models)
forall a. Text -> Generator a -> Generator a
OAM.nested Text
requestPath (Generator (Q [ModuleDefinition], Models)
 -> Generator (Q [ModuleDefinition], Models))
-> Generator (Q [ModuleDefinition], Models)
-> Generator (Q [ModuleDefinition], Models)
forall a b. (a -> b) -> a -> b
$ do
  [Text]
operationsToGenerate <- (Settings -> [Text]) -> Generator [Text]
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> [Text]
OAO.settingOperationsToGenerate
  (([Q ModuleDefinition], [Models])
 -> (Q [ModuleDefinition], Models))
-> Generator ([Q ModuleDefinition], [Models])
-> Generator (Q [ModuleDefinition], Models)
forall a b. (a -> b) -> Generator a -> Generator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Q ModuleDefinition] -> Q [ModuleDefinition])
-> ([Models] -> Models)
-> ([Q ModuleDefinition], [Models])
-> (Q [ModuleDefinition], Models)
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 [Q ModuleDefinition] -> Q [ModuleDefinition]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions)
    (Generator ([Q ModuleDefinition], [Models])
 -> Generator (Q [ModuleDefinition], Models))
-> ([(Text, OperationObject)]
    -> Generator ([Q ModuleDefinition], [Models]))
-> [(Text, OperationObject)]
-> Generator (Q [ModuleDefinition], Models)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, OperationObject) -> Generator (Q ModuleDefinition, Models))
-> [(Text, OperationObject)]
-> Generator ([Q ModuleDefinition], [Models])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM
      ((Text -> OperationObject -> Generator (Q ModuleDefinition, Models))
-> (Text, OperationObject)
-> Generator (Q ModuleDefinition, Models)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String
-> Text
-> Text
-> OperationObject
-> Generator (Q ModuleDefinition, Models)
defineModuleForOperation String
mainModuleName Text
requestPath))
    ([(Text, OperationObject)]
 -> Generator (Q [ModuleDefinition], Models))
-> [(Text, OperationObject)]
-> Generator (Q [ModuleDefinition], Models)
forall a b. (a -> b) -> a -> b
$ [Text]
-> [(Text, Maybe OperationObject)] -> [(Text, OperationObject)]
filterEmptyAndOmittedOperations
      [Text]
operationsToGenerate
      [ (Text
"GET", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectGet PathItemObject
pathItemObject),
        (Text
"PUT", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectPut PathItemObject
pathItemObject),
        (Text
"POST", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectPost PathItemObject
pathItemObject),
        (Text
"DELETE", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectDelete PathItemObject
pathItemObject),
        (Text
"OPTIONS", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectOptions PathItemObject
pathItemObject),
        (Text
"HEAD", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectHead PathItemObject
pathItemObject),
        (Text
"PATCH", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectPatch PathItemObject
pathItemObject),
        (Text
"TRACE", PathItemObject -> Maybe OperationObject
OAT.pathItemObjectTrace PathItemObject
pathItemObject)
      ]

filterEmptyAndOmittedOperations :: [Text] -> [(Text, Maybe OAT.OperationObject)] -> [(Text, OAT.OperationObject)]
filterEmptyAndOmittedOperations :: [Text]
-> [(Text, Maybe OperationObject)] -> [(Text, OperationObject)]
filterEmptyAndOmittedOperations [Text]
operationsToGenerate [(Text, Maybe OperationObject)]
xs =
  [ (Text
method, OperationObject
operation)
    | (Text
method, Just OperationObject
operation) <- [(Text, Maybe OperationObject)]
xs,
      [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
operationsToGenerate Bool -> Bool -> Bool
|| OperationObject -> Maybe Text
OAT.operationObjectOperationId OperationObject
operation Maybe Text -> [Maybe Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just [Text]
operationsToGenerate
  ]

-- |
--  Defines an Operation for a Method and a Path
--  Uses an OperationObject
--
--  Returns a commented function definition and implementation in a Q Monad
defineModuleForOperation ::
  -- | The main module name passed via CLI options
  String ->
  -- | The path to the request (This is the key from the map of Operations)
  --  It may contain placeholder variables in the form of /my/{var}/path/
  Text ->
  -- | HTTP Method (GET,POST,etc)
  Text ->
  -- | The Operation Object
  OAT.OperationObject ->
  -- | commented function definition and implementation
  OAM.Generator (Q Dep.ModuleDefinition, Dep.Models)
defineModuleForOperation :: String
-> Text
-> Text
-> OperationObject
-> Generator (Q ModuleDefinition, Models)
defineModuleForOperation String
mainModuleName Text
requestPath Text
method OperationObject
operation = Text
-> Generator (Q ModuleDefinition, Models)
-> Generator (Q ModuleDefinition, Models)
forall a. Text -> Generator a -> Generator a
OAM.nested Text
method (Generator (Q ModuleDefinition, Models)
 -> Generator (Q ModuleDefinition, Models))
-> Generator (Q ModuleDefinition, Models)
-> Generator (Q ModuleDefinition, Models)
forall a b. (a -> b) -> a -> b
$ do
  Name
operationIdName <- Text -> Text -> OperationObject -> Generator Name
getOperationName Text
requestPath Text
method OperationObject
operation
  Bool
convertToCamelCase <- (Settings -> Bool) -> Generator Bool
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Bool
OAO.settingConvertToCamelCase
  let operationIdAsText :: Text
operationIdAsText = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
operationIdName
      appendToOperationName :: Text -> Text
appendToOperationName = ((String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
operationIdName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      moduleName :: String
moduleName = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Text -> Text
haskellifyText Bool
convertToCamelCase Bool
True Text
operationIdAsText
  Text -> Generator ()
OAM.logInfo (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Generating operation with name '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationIdAsText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
  (Maybe RequestBodyDefinition
bodySchema, [Text]
bodyPath) <- OperationObject -> Generator (Maybe RequestBodyDefinition, [Text])
getBodySchemaFromOperation OperationObject
operation
  (Name
responseTypeName, Q Exp
responseTransformerExp, Q Doc
responseBodyDefinitions, Models
responseBodyDependencies) <- OperationObject
-> (Text -> Text) -> Generator (Name, Q Exp, Q Doc, Models)
OAR.getResponseDefinitions OperationObject
operation Text -> Text
appendToOperationName
  ([Q Type]
bodyType, (Q Doc
bodyDefinition, Models
bodyDependencies)) <- [Text]
-> Generator ([Q Type], ModelContentWithDependencies)
-> Generator ([Q Type], ModelContentWithDependencies)
forall a. [Text] -> Generator a -> Generator a
OAM.resetPath [Text]
bodyPath (Generator ([Q Type], ModelContentWithDependencies)
 -> Generator ([Q Type], ModelContentWithDependencies))
-> Generator ([Q Type], ModelContentWithDependencies)
-> Generator ([Q Type], ModelContentWithDependencies)
forall a b. (a -> b) -> a -> b
$ Maybe RequestBodyDefinition
-> (Text -> Text)
-> Generator ([Q Type], ModelContentWithDependencies)
getBodyType Maybe RequestBodyDefinition
bodySchema Text -> Text
appendToOperationName
  ParameterCardinality
parameterCardinality <- Text -> OperationObject -> Generator ParameterCardinality
generateParameterTypeFromOperation Text
operationIdAsText OperationObject
operation
  [Text]
paramDescriptions <-
    ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"The request body to send" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Q Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Q Type]
bodyType])
      ([Text] -> [Text]) -> Generator [Text] -> Generator [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( case ParameterCardinality
parameterCardinality of
              ParameterCardinality
NoParameters -> [Text] -> Generator [Text]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
              SingleParameter Q Type
_ ModelContentWithDependencies
_ ParameterObject
parameter -> Text -> [Text]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> [Text]) -> Generator Text -> Generator [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParameterObject -> Generator Text
getParameterDescription ParameterObject
parameter
              MultipleParameters ParameterTypeDefinition
_ -> [Text] -> Generator [Text]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"Contains all available parameters of this operation (query and path parameters)"]
          )
  let ([Q Type]
paramType, Q Doc
paramDoc, Models
paramDependencies) = case ParameterCardinality
parameterCardinality of
        ParameterCardinality
NoParameters -> ([], Q Doc
forall (f :: * -> *). Applicative f => f Doc
Doc.emptyDoc, Models
forall a. Set a
Set.empty)
        SingleParameter Q Type
paramType' (Q Doc
doc, Models
deps) ParameterObject
_ -> ([Q Type
paramType'], Q Doc
doc, Models
deps)
        MultipleParameters ParameterTypeDefinition
paramDefinition ->
          ( [ParameterTypeDefinition -> Q Type
parameterTypeDefinitionType ParameterTypeDefinition
paramDefinition],
            ParameterTypeDefinition -> Q Doc
parameterTypeDefinitionDoc ParameterTypeDefinition
paramDefinition,
            ParameterTypeDefinition -> Models
parameterTypeDefinitionDependencies ParameterTypeDefinition
paramDefinition
          )
      types :: [Q Type]
types = [Q Type]
paramType [Q Type] -> [Q Type] -> [Q Type]
forall a. Semigroup a => a -> a -> a
<> [Q Type]
bodyType
      monadName :: Name
monadName = String -> Name
mkName String
"m"
      createFunSignature :: Name -> Q Type -> Q Doc
createFunSignature Name
operationName Q Type
fnType' = do
        TyVarBndr Specificity
tv <- Name -> Q (TyVarBndr Specificity)
nameToTypeVariable Name
monadName
        Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
          (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD
            Name
operationName
            ( [TyVarBndr Specificity] -> Q Cxt -> Q Type -> Q Type
forall (m :: * -> *).
Quote m =>
[TyVarBndr Specificity] -> m Cxt -> m Type -> m Type
forallT
                [TyVarBndr Specificity
tv]
                ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''OC.MonadHTTP) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
monadName)])
                Q Type
fnType'
            )
      methodAndPath :: Text
methodAndPath = Text -> Text
T.toUpper Text
method Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
requestPath
      operationNameAsString :: String
operationNameAsString = Name -> String
nameBase Name
operationIdName
      operationDescription :: [Text] -> Q Doc
operationDescription = Doc -> Q Doc
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Q Doc) -> ([Text] -> Doc) -> [Text] -> Q Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Doc
Doc.generateHaddockComment ([Text] -> Doc) -> ([Text] -> [Text]) -> [Text] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
methodAndPath Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
      cartesianProduct :: [a] -> [b] -> [(a, b)]
cartesianProduct = (a -> b -> (a, b)) -> [a] -> [b] -> [(a, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Applicative.liftA2 (,)
      addToName :: String -> Name -> Name
addToName String
suffix = String -> Name
mkName (String -> Name) -> (Name -> String) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix) (String -> String) -> (Name -> String) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameBase
      availableOperationCombinations :: [((Name -> Name, Q Exp, Name),
  (Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type))]
availableOperationCombinations =
        [(Name -> Name, Q Exp, Name)]
-> [(Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type)]
-> [((Name -> Name, Q Exp, Name),
     (Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type))]
forall {a} {b}. [a] -> [b] -> [(a, b)]
cartesianProduct
          [ (Name -> Name
forall a. a -> a
id, Q Exp
responseTransformerExp, Name
responseTypeName),
            (String -> Name -> Name
addToName String
"Raw", [|id|], ''BS.ByteString)
          ]
          [ (Name -> Name
forall a. a -> a
id, Bool
False, [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignatureWithMonadTransformer),
            (String -> Name -> Name
addToName String
"WithConfiguration", Bool
True, [Q Type] -> Name -> Name -> Q Type
getParametersTypeForSignature)
          ]
      description :: Text
description = Text -> Text
Doc.escapeText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OperationObject -> Text
getOperationDescription OperationObject
operation
      comments :: [[Q Doc]]
comments =
        [ [[Text] -> Q Doc
operationDescription [Text
description]],
          [Q Doc
paramDoc, Q Doc
bodyDefinition, Q Doc
responseBodyDefinitions, [Text] -> Q Doc
operationDescription [Text
"The same as '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationIdAsText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' but accepts an explicit configuration."]],
          [[Text] -> Q Doc
operationDescription [Text
"The same as '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationIdAsText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' but returns the raw 'Data.ByteString.ByteString'."]],
          [[Text] -> Q Doc
operationDescription [Text
"The same as '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operationIdAsText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' but accepts an explicit configuration and returns the raw 'Data.ByteString.ByteString'."]]
        ]
  [[Q Doc]]
functionDefinitions <-
    (((Name -> Name, Q Exp, Name),
  (Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type))
 -> Generator [Q Doc])
-> [((Name -> Name, Q Exp, Name),
     (Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type))]
-> Generator [[Q Doc]]
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
      ( \((Name -> Name
f1, Q Exp
transformExp, Name
responseType), (Name -> Name
f2, Bool
explicitConfiguration, [Q Type] -> Name -> Name -> Q Type
getParameterType)) -> do
          let fnName :: Name
fnName = Name -> Name
f1 (Name -> Name) -> (Name -> Name) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
f2 (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name
operationIdName
              fnSignature :: Q Doc
fnSignature = Name -> Q Type -> Q Doc
createFunSignature Name
fnName (Q Type -> Q Doc) -> Q Type -> Q Doc
forall a b. (a -> b) -> a -> b
$ [Q Type] -> Name -> Name -> Q Type
getParameterType [Q Type]
types Name
responseType Name
monadName
              addCommentsToFnSignature :: Doc -> Doc
addCommentsToFnSignature =
                ( Doc -> Doc -> Doc
`Doc.sideBySide`
                    [Text] -> Doc
Doc.sideComments
                      ((if Bool
explicitConfiguration then (Text
"The configuration to use in the request" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) else [Text] -> [Text]
forall a. a -> a
id) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
paramDescriptions [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"Monadic computation which returns the result of the operation"])
                )
                  (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Doc -> Doc
Doc.breakOnTokens [Text
"->"]
          Q Doc
functionBody <- Bool
-> Name
-> ParameterCardinality
-> Text
-> Text
-> Maybe RequestBodyDefinition
-> Q Exp
-> Generator (Q Doc)
defineOperationFunction Bool
explicitConfiguration Name
fnName ParameterCardinality
parameterCardinality Text
requestPath Text
method Maybe RequestBodyDefinition
bodySchema Q Exp
transformExp
          [Q Doc] -> Generator [Q Doc]
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Doc -> Doc) -> Q Doc -> Q Doc
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
addCommentsToFnSignature Q Doc
fnSignature Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`Doc.appendDoc` Q Doc
functionBody]
      )
      [((Name -> Name, Q Exp, Name),
  (Name -> Name, Bool, [Q Type] -> Name -> Name -> Q Type))]
availableOperationCombinations
  Bool
omitAdditionalFunctions <- (Settings -> Bool) -> Generator Bool
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Bool
OAO.settingOmitAdditionalOperationFunctions
  let content :: [Q Doc]
content =
        [[Q Doc]] -> [Q Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Q Doc]] -> [Q Doc]) -> [[Q Doc]] -> [Q Doc]
forall a b. (a -> b) -> a -> b
$
          if Bool
omitAdditionalFunctions
            then
              ([Q Doc] -> [Q Doc] -> [Q Doc])
-> [[Q Doc]] -> [[Q Doc]] -> [[Q Doc]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
                [Q Doc] -> [Q Doc] -> [Q Doc]
forall a. Semigroup a => a -> a -> a
(<>)
                [ [[Text] -> Q Doc
operationDescription [Text
description]],
                  [Q Doc
paramDoc, Q Doc
bodyDefinition, Q Doc
responseBodyDefinitions]
                ]
                ([[Q Doc]] -> [[Q Doc]]) -> [[Q Doc]] -> [[Q Doc]]
forall a b. (a -> b) -> a -> b
$ ([[Q Doc]] -> [[Q Doc]] -> [[Q Doc]]
forall a. Semigroup a => a -> a -> a
<> [[Q Doc
forall (f :: * -> *). Applicative f => f Doc
Doc.emptyDoc]])
                ([[Q Doc]] -> [[Q Doc]]) -> [[Q Doc]] -> [[Q Doc]]
forall a b. (a -> b) -> a -> b
$ [[Q Doc]] -> ([Q Doc] -> [[Q Doc]]) -> Maybe [Q Doc] -> [[Q Doc]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Q Doc] -> [[Q Doc]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (Maybe [Q Doc] -> [[Q Doc]]) -> Maybe [Q Doc] -> [[Q Doc]]
forall a b. (a -> b) -> a -> b
$ [[Q Doc]] -> Maybe [Q Doc]
forall a. [a] -> Maybe a
Maybe.listToMaybe [[Q Doc]]
functionDefinitions
            else ([Q Doc] -> [Q Doc] -> [Q Doc])
-> [[Q Doc]] -> [[Q Doc]] -> [[Q Doc]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Q Doc] -> [Q Doc] -> [Q Doc]
forall a. Semigroup a => a -> a -> a
(<>) [[Q Doc]]
comments [[Q Doc]]
functionDefinitions
  Text -> Generator ()
OAM.logTrace (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Models -> [Text]
forall a. Set a -> [a]
Set.toList (Models -> [Text]) -> Models -> [Text]
forall a b. (a -> b) -> a -> b
$ [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Models
paramDependencies, Models
bodyDependencies, Models
responseBodyDependencies]
  (Q ModuleDefinition, Models)
-> Generator (Q ModuleDefinition, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ([String
moduleName],)
        (Doc -> ModuleDefinition)
-> (Doc -> Doc) -> Doc -> ModuleDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String -> Doc -> Doc
Doc.addOperationsModuleHeader String
mainModuleName String
moduleName String
operationNameAsString
        (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc
$$ String -> Doc
text String
"")
        (Doc -> ModuleDefinition) -> Q Doc -> Q ModuleDefinition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( [Doc] -> Doc
vcat
                ([Doc] -> Doc) -> Q [Doc] -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Q Doc] -> Q [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Q Doc]
content
            ),
      [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Models
paramDependencies, Models
bodyDependencies, Models
responseBodyDependencies]
    )

getBodyType :: Maybe RequestBodyDefinition -> (Text -> Text) -> OAM.Generator ([Q Type], Dep.ModelContentWithDependencies)
getBodyType :: Maybe RequestBodyDefinition
-> (Text -> Text)
-> Generator ([Q Type], ModelContentWithDependencies)
getBodyType Maybe RequestBodyDefinition
requestBody Text -> Text
appendToOperationName = do
  Bool
generateBody <- Maybe RequestBodyDefinition -> Generator Bool
shouldGenerateRequestBody Maybe RequestBodyDefinition
requestBody
  case Maybe RequestBodyDefinition
requestBody of
    Just RequestBodyDefinition {Bool
RequestBodyEncoding
Schema
requestBodyDefinitionSchema :: Schema
requestBodyDefinitionEncoding :: RequestBodyEncoding
requestBodyDefinitionRequired :: Bool
requestBodyDefinitionSchema :: RequestBodyDefinition -> Schema
requestBodyDefinitionEncoding :: RequestBodyDefinition -> RequestBodyEncoding
requestBodyDefinitionRequired :: RequestBodyDefinition -> Bool
..} | Bool
generateBody -> do
      let transformType :: Q Type -> [Q Type]
transformType = Q Type -> [Q Type]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Type -> [Q Type]) -> (Q Type -> Q Type) -> Q Type -> [Q Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
requestBodyDefinitionRequired then Q Type -> Q Type
forall a. a -> a
id else Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type) -> Q Type -> Q Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT ''Maybe)
      Text
requestBodySuffix <- (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingRequestBodyTypeSuffix
      (Q Type -> [Q Type])
-> (Q Type, ModelContentWithDependencies)
-> ([Q Type], ModelContentWithDependencies)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first Q Type -> [Q Type]
transformType ((Q Type, ModelContentWithDependencies)
 -> ([Q Type], ModelContentWithDependencies))
-> Generator (Q Type, ModelContentWithDependencies)
-> Generator ([Q Type], ModelContentWithDependencies)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Schema -> Generator (Q Type, ModelContentWithDependencies)
Model.defineModelForSchemaNamed (Text -> Text
appendToOperationName Text
requestBodySuffix) Schema
requestBodyDefinitionSchema
    Maybe RequestBodyDefinition
_ -> ([Q Type], ModelContentWithDependencies)
-> Generator ([Q Type], ModelContentWithDependencies)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], (Q Doc
forall (f :: * -> *). Applicative f => f Doc
Doc.emptyDoc, Models
forall a. Set a
Set.empty))