From d69ee2079f885be3c5589c8ee0bcdfe915ba7ffc Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 4 Nov 2024 11:12:51 -0500 Subject: [PATCH 1/9] Detect oneof branches with single fields. When specified, name oneof variants after those fields instead of with numbers. Fix up some utilities for consistency, and add a Field type instead of recomputing property names. --- .../src/OpenAPI/Generate/Internal/Util.hs | 21 +-- .../src/OpenAPI/Generate/Model.hs | 166 +++++++++++------- .../src/OpenAPI/Generate/Operation.hs | 2 +- .../src/OpenAPI/Generate/OptParse.hs | 6 +- .../Generate/OptParse/Configuration.hs | 4 +- .../src/OpenAPI/Generate/OptParse/Flags.hs | 8 +- .../src/OpenAPI/Generate/Response.hs | 2 +- .../OpenAPI/Generate/Internal/UtilSpec.hs | 19 +- 8 files changed, 140 insertions(+), 88 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs b/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs index f3b07c3..bc53c04 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Internal/Util.hs @@ -49,7 +49,7 @@ haskellifyText :: -- | The identifier to transform Text -> -- | The resulting identifier - String + Text haskellifyText convertToCamelCase startWithUppercase name = let casefn = if startWithUppercase then Char.toUpper else Char.toLower replaceChar '.' = '\'' @@ -94,18 +94,19 @@ haskellifyText convertToCamelCase startWithUppercase name = replacePlus ('+' : rest) = "Plus" <> replacePlus rest replacePlus (x : xs) = x : replacePlus xs replacePlus a = a - in replaceReservedWord $ - caseFirstCharCorrectly $ - generateNameForEmptyIdentifier name $ - removeIllegalLeadingCharacters $ - (if convertToCamelCase then toCamelCase else id) $ - nameWithoutSpecialChars $ - replacePlus $ - T.unpack name + in T.pack $ + replaceReservedWord $ + caseFirstCharCorrectly $ + generateNameForEmptyIdentifier name $ + removeIllegalLeadingCharacters $ + (if convertToCamelCase then toCamelCase else id) $ + nameWithoutSpecialChars $ + replacePlus $ + T.unpack name -- | The same as 'haskellifyText' but transform the result to a 'Name' haskellifyName :: Bool -> Bool -> Text -> Name -haskellifyName convertToCamelCase startWithUppercase name = mkName $ haskellifyText convertToCamelCase startWithUppercase name +haskellifyName convertToCamelCase startWithUppercase name = mkName . T.unpack $ haskellifyText convertToCamelCase startWithUppercase name -- | 'OAM.Generator' version of 'haskellifyName' haskellifyNameM :: Bool -> Text -> OAM.Generator Name diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index 233295e..253275b 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} @@ -371,19 +372,24 @@ defineOneOfSchema :: Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDecla defineOneOfSchema schemaName description schemas = do when (null schemas) $ OAM.logWarning "oneOf does not contain any sub-schemas and will therefore be defined as a void type" settings <- OAM.getSettings - let name = haskellifyName (OAO.settingConvertToCamelCase settings) True $ schemaName <> "Variants" + let haskellifyConstructor = haskellifyName (OAO.settingConvertToCamelCase settings) True + name = haskellifyConstructor $ schemaName <> "Variants" fixedValueStrategy = OAO.settingFixedValueStrategy settings - (schemas', schemasWithFixedValues) = extractSchemasWithFixedValues fixedValueStrategy schemas - indexedSchemas = zip schemas' ([1 ..] :: [Integer]) + useSingleFieldNames = OAO.settingUseSingleFieldNames settings + (schemas', fixedValueSchemas) = extractSchemasWithFixedValues fixedValueStrategy schemas + (schemas'', singleFieldedSchemas) = if useSingleFieldNames then extractSchemasWithSingleField schemas' else (schemas', []) + defineSingleFielded field = defineModelForSchemaNamed (schemaName <> haskellifyText (OAO.settingConvertToCamelCase settings) True field) + indexedSchemas = zip schemas'' ([1 ..] :: [Integer]) defineIndexed schema index = defineModelForSchemaNamed (schemaName <> "OneOf" <> T.pack (show index)) schema OAM.logInfo $ "Define as oneOf named '" <> T.pack (nameBase name) <> "'" - variants <- mapM (uncurry defineIndexed) indexedSchemas + singleFieldedVariants <- mapM (uncurry defineSingleFielded) singleFieldedSchemas + indexedVariants <- mapM (uncurry defineIndexed) indexedSchemas path <- getCurrentPathEscaped - let variantDefinitions = vcat <$> mapM (fst . snd) variants + let variants = indexedVariants <> singleFieldedVariants + variantDefinitions = vcat <$> mapM (fst . snd) variants dependencies = Set.unions $ fmap (snd . snd) variants types = fmap fst variants indexedTypes = zip types ([1 ..] :: [Integer]) - haskellifyConstructor = haskellifyName (OAO.settingConvertToCamelCase settings) True getConstructorName (typ, n) = do t <- typ let suffix = if OAO.settingUseNumberedVariantConstructors settings then "Variant" <> T.pack (show n) else typeToSuffix t @@ -401,7 +407,7 @@ defineOneOfSchema schemaName description schemas = do createConstructorForSchemaWithFixedValue = (`normalC` []) . createConstructorNameForSchemaWithFixedValue - fixedValueComments = fmap (("Represents the JSON value @" <>) . (<> "@") . showAesonValue) schemasWithFixedValues + fixedValueComments = fmap (("Represents the JSON value @" <>) . (<> "@") . showAesonValue) fixedValueSchemas emptyCtx = pure [] patternName = mkName "a" p = varP patternName @@ -423,7 +429,7 @@ defineOneOfSchema schemaName description schemas = do Aeson.Success $p -> pure $e Aeson.Error $p -> fail $e |] - case schemasWithFixedValues of + case fixedValueSchemas of [] -> parserExpr _ -> multiIfE $ @@ -432,7 +438,7 @@ defineOneOfSchema schemaName description schemas = do let constructorName = createConstructorNameForSchemaWithFixedValue value in normalGE [|$(varE paramName) == $(liftAesonValue value)|] [|pure $(varE constructorName)|] ) - schemasWithFixedValues + fixedValueSchemas <> [normalGE [|otherwise|] parserExpr] in funD (mkName "parseJSON") @@ -461,7 +467,7 @@ defineOneOfSchema schemaName description schemas = do ] toJsonFns = fmap toJsonFnConstructor constructorNames - <> fmap toJsonFnFixedValues schemasWithFixedValues + <> fmap toJsonFnFixedValues fixedValueSchemas dataDefinition = ( Doc.generateHaddockComment [ "Defines the oneOf schema located at @" <> path <> "@ in the specification.", @@ -478,7 +484,7 @@ defineOneOfSchema schemaName description schemas = do name [] Nothing - (fmap createConstructorForSchemaWithFixedValue schemasWithFixedValues <> fmap createTypeConstruct indexedTypes) + (fmap createConstructorForSchemaWithFixedValue fixedValueSchemas <> fmap createTypeConstruct indexedTypes) [ derivClause Nothing [ conT ''Show, @@ -587,6 +593,22 @@ defineArrayModelForSchema strategy schemaName schema = do ) ) +data Field = Field + { fieldName :: Text, + fieldSchema :: OAS.Schema, + fieldRequired :: Bool, + fieldHaskellName :: Name + } + +toField :: Bool -> Text -> Text -> OAS.Schema -> Set.Set Text -> Field +toField convertToCamelCase propName fieldName fieldSchema required = + Field + { fieldName, + fieldSchema, + fieldRequired = propName `Set.member` required, + fieldHaskellName = haskellifyName convertToCamelCase False fieldName + } + -- | Defines a record defineObjectModelForSchema :: TypeAliasStrategy -> Text -> OAS.SchemaObject -> OAM.Generator TypeWithDeclaration defineObjectModelForSchema strategy schemaName schema = @@ -599,12 +621,16 @@ defineObjectModelForSchema strategy schemaName schema = name = haskellifyName convertToCamelCase True schemaName required = OAS.schemaObjectRequired schema fixedValueStrategy = OAO.settingFixedValueStrategy settings + useSingleFieldNames = OAO.settingUseSingleFieldNames settings (props, propsWithFixedValues) = extractPropertiesWithFixedValues fixedValueStrategy required $ Map.toList $ OAS.schemaObjectProperties schema - propsWithNames = zip (fmap fst props) $ fmap (haskellifyName convertToCamelCase False . (schemaName <>) . uppercaseFirstText . fst) props + propFields = case props of + [(propName, subschema)] | useSingleFieldNames -> [(propName, toField convertToCamelCase propName schemaName subschema required)] + _ -> flip fmap props $ \(propName, subschema) -> + (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName) subschema required) emptyCtx = pure [] OAM.logInfo $ "Define as record named '" <> T.pack (nameBase name) <> "'" - (bangTypes, propertyContent, propertyDependencies) <- propertiesToBangTypes schemaName props required - propertyDescriptions <- getDescriptionOfProperties props + (bangTypes, propertyContent, propertyDependencies) <- propertiesToBangTypes propFields + propertyDescriptions <- getDescriptionOfProperties propFields let dataDefinition = do bangs <- bangTypes let record = recC name (pure <$> bangs) @@ -615,9 +641,9 @@ defineObjectModelForSchema strategy schemaName schema = . Doc.reformatRecord . ppr <$> dataD emptyCtx name [] Nothing [record] objectDeriveClause - toJsonInstance = createToJSONImplementation name propsWithNames propsWithFixedValues required - fromJsonInstance = createFromJSONImplementation name propsWithNames required - mkFunction = createMkFunction name propsWithNames required bangTypes + toJsonInstance = createToJSONImplementation name propFields propsWithFixedValues + fromJsonInstance = createFromJSONImplementation name propFields + mkFunction = createMkFunction name propFields bangTypes pure ( varT name, ( pure @@ -657,21 +683,31 @@ extractSchemaWithFixedValue FixedValueStrategyExclude schema@(OAT.Concrete OAS.S _ -> Left schema extractSchemaWithFixedValue _ schema = Left schema -createMkFunction :: Name -> [(Text, Name)] -> Set.Set Text -> Q [VarBangType] -> Q Doc -createMkFunction name propsWithNames required bangTypes = do +extractSchemasWithSingleField :: [OAS.Schema] -> ([OAS.Schema], [(Text, OAS.Schema)]) +extractSchemasWithSingleField = E.partitionEithers . fmap extractSchemaWithSingleField + +extractSchemaWithSingleField :: OAS.Schema -> Either OAS.Schema (Text, OAS.Schema) +extractSchemaWithSingleField schema@(OAT.Concrete OAS.SchemaObject {..}) = case Map.toList schemaObjectProperties of + [(field, _)] -> Right (field, schema) + _ -> Left schema +extractSchemaWithSingleField schema = Left schema + +createMkFunction :: Name -> [(Text, Field)] -> Q [VarBangType] -> Q Doc +createMkFunction name propFields bangTypes = do bangs <- bangTypes let fnName = mkName $ "mk" <> nameBase name - propsWithTypes = - ( \((originalName, propertyName), (_, _, propertyType)) -> - (propertyName, propertyType, originalName `Set.member` required) + fieldsWithBangs = + ( \((_, record), (_, _, propType)) -> + (record, propType) ) - <$> zip propsWithNames bangs - requiredPropsWithTypes = filter (\(_, _, isRequired) -> isRequired) propsWithTypes - parameterPatterns = (\(propertyName, _, _) -> varP propertyName) <$> requiredPropsWithTypes - parameterDescriptions = (\(propertyName, _, _) -> "'" <> T.pack (nameBase propertyName) <> "'") <$> requiredPropsWithTypes - recordExpr = (\(propertyName, _, isRequired) -> fieldExp propertyName (if isRequired then varE propertyName else [|Nothing|])) <$> propsWithTypes + <$> zip propFields bangs + requiredFieldsWithBangs = filter (\(Field {..}, _) -> fieldRequired) fieldsWithBangs + parameterPatterns = (\(Field {..}, _) -> varP fieldHaskellName) <$> requiredFieldsWithBangs + parameterDescriptions = (\(Field {..}, _) -> "'" <> T.pack (nameBase fieldHaskellName) <> "'") <$> requiredFieldsWithBangs + recordExpr = (\(Field {..}, _) -> fieldExp fieldHaskellName (if fieldRequired then varE fieldHaskellName else [|Nothing|])) <$> fieldsWithBangs expr = recConE name recordExpr - fnType = foldr (\(_, propertyType, _) t -> [t|$(pure propertyType) -> $t|]) (conT name) requiredPropsWithTypes + fnType = foldr (\(_, propertyType) t -> [t|$(pure propertyType) -> $t|]) (conT name) requiredFieldsWithBangs + pure ( Doc.generateHaddockComment [ "Create a new '" <> T.pack (nameBase name) <> "' with all required fields." @@ -688,17 +724,17 @@ createMkFunction name propsWithNames required bangTypes = do `appendDoc` fmap ppr (funD fnName [clause parameterPatterns (normalB expr) []]) -- | create toJSON implementation for an object -createToJSONImplementation :: Name -> [(Text, Name)] -> [(Text, Aeson.Value)] -> Set.Set Text -> Q Doc -createToJSONImplementation objectName recordNames propsWithFixedValues required = +createToJSONImplementation :: Name -> [(Text, Field)] -> [(Text, Aeson.Value)] -> Q Doc +createToJSONImplementation objectName fieldProps propsWithFixedValues = let emptyDefs = pure [] fnArgName = mkName "obj" - toAssertion (jsonName, hsName) = - if jsonName `Set.member` required - then [|[$(stringE $ T.unpack jsonName) Aeson..= $(varE hsName) $(varE fnArgName)]|] - else [|(maybe mempty (pure . ($(stringE $ T.unpack jsonName) Aeson..=)) ($(varE hsName) $(varE fnArgName)))|] - toFixedAssertion (jsonName, value) = - [|[$(stringE $ T.unpack jsonName) Aeson..= $(liftAesonValueWithOverloadedStrings False value)]|] - assertions = fmap toAssertion recordNames <> fmap toFixedAssertion propsWithFixedValues + toAssertion (propName, Field {..}) = + if fieldRequired + then [|[$(stringE $ T.unpack propName) Aeson..= $(varE fieldHaskellName) $(varE fnArgName)]|] + else [|(maybe mempty (pure . ($(stringE $ T.unpack propName) Aeson..=)) ($(varE fieldHaskellName) $(varE fnArgName)))|] + toFixedAssertion (propName, value) = + [|[$(stringE $ T.unpack propName) Aeson..= $(liftAesonValueWithOverloadedStrings False value)]|] + assertions = fmap toAssertion fieldProps <> fmap toFixedAssertion propsWithFixedValues assertionsList = [|(List.concat $(toExprList assertions))|] toExprList = foldr (\x expr -> uInfixE x (varE $ mkName ":") expr) [|mempty|] defaultJsonImplementation = @@ -724,22 +760,22 @@ createToJSONImplementation objectName recordNames propsWithFixedValues required in ppr <$> instanceD emptyDefs [t|Aeson.ToJSON $(varT objectName)|] defaultJsonImplementation -- | create FromJSON implementation for an object -createFromJSONImplementation :: Name -> [(Text, Name)] -> Set.Set Text -> Q Doc -createFromJSONImplementation objectName recordNames required = +createFromJSONImplementation :: Name -> [(Text, Field)] -> Q Doc +createFromJSONImplementation objectName fieldProps = let fnArgName = mkName "obj" withObjectLamda = foldl - ( \prev (propName, _) -> - let propName' = stringE $ T.unpack propName + ( \prev (_, Field {..}) -> + let fieldName' = stringE $ T.unpack fieldName arg = varE fnArgName readPropE = - if propName `Set.member` required - then [|$arg Aeson..: $propName'|] - else [|$arg Aeson..:! $propName'|] + if fieldRequired + then [|$arg Aeson..: $fieldName'|] + else [|$arg Aeson..:! $fieldName'|] in [|$prev <*> $readPropE|] ) [|pure $(varE objectName)|] - recordNames + fieldProps in ppr <$> instanceD (cxt []) @@ -756,47 +792,45 @@ createFromJSONImplementation objectName recordNames required = ] -- | create "bangs" record fields for properties -propertiesToBangTypes :: Text -> [(Text, OAS.Schema)] -> Set.Set Text -> OAM.Generator BangTypesSelfDefined -propertiesToBangTypes _ [] _ = pure (pure [], emptyDoc, Set.empty) -propertiesToBangTypes schemaName props required = OAM.nested "properties" $ do - propertySuffix <- OAM.getSetting OAO.settingPropertyTypeSuffix +propertiesToBangTypes :: [(Text, Field)] -> OAM.Generator BangTypesSelfDefined +propertiesToBangTypes [] = pure (pure [], emptyDoc, Set.empty) +propertiesToBangTypes fieldProps = OAM.nested "properties" $ do convertToCamelCase <- OAM.getSetting OAO.settingConvertToCamelCase - let createBang :: Text -> Text -> Q Type -> Q VarBangType - createBang recordName propName myType = do + let createBang :: Field -> Q Type -> Q VarBangType + createBang Field {..} myType = do bang' <- bang noSourceUnpackedness noSourceStrictness type' <- - if recordName `Set.member` required + if fieldRequired then myType else appT (varT ''Maybe) myType - pure (haskellifyName convertToCamelCase False propName, bang', type') - propToBangType :: (Text, OAS.Schema) -> OAM.Generator (Q VarBangType, Q Doc, Dep.Models) - propToBangType (recordName, schema) = do - let propName = schemaName <> uppercaseFirstText recordName - (myType, (content, depenencies)) <- OAM.nested recordName $ defineModelForSchemaNamed (propName <> propertySuffix) schema - let myBang = createBang recordName propName myType - pure (myBang, content, depenencies) - foldFn :: OAM.Generator BangTypesSelfDefined -> (Text, OAS.Schema) -> OAM.Generator BangTypesSelfDefined + pure (haskellifyName convertToCamelCase False fieldName, bang', type') + propToBangType :: Field -> OAM.Generator (Q VarBangType, Q Doc, Dep.Models) + propToBangType field@Field {..} = do + (myType, (content, dependencies)) <- OAM.nested fieldName $ defineModelForSchemaNamed fieldName fieldSchema + let myBang = createBang field myType + pure (myBang, content, dependencies) + foldFn :: OAM.Generator BangTypesSelfDefined -> (Text, Field) -> OAM.Generator BangTypesSelfDefined foldFn accHolder next = do (varBang, content, dependencies) <- accHolder - (nextVarBang, nextContent, nextDependencies) <- propToBangType next + (nextVarBang, nextContent, nextDependencies) <- propToBangType $ snd next pure ( varBang `liftedAppend` fmap pure nextVarBang, content `appendDoc` nextContent, Set.union dependencies nextDependencies ) - foldl foldFn (pure (pure [], emptyDoc, Set.empty)) props + foldl foldFn (pure (pure [], emptyDoc, Set.empty)) fieldProps getDescriptionOfSchema :: OAS.SchemaObject -> Text getDescriptionOfSchema schema = Doc.escapeText $ Maybe.fromMaybe "" $ OAS.schemaObjectDescription schema -getDescriptionOfProperties :: [(Text, OAS.Schema)] -> OAM.Generator [Text] +getDescriptionOfProperties :: [(Text, Field)] -> OAM.Generator [Text] getDescriptionOfProperties = mapM - ( \(name, schema) -> do - schema' <- resolveSchemaReferenceWithoutWarning schema + ( \(propName, Field {..}) -> do + schema' <- resolveSchemaReferenceWithoutWarning fieldSchema let description = maybe "" (": " <>) $ schema' >>= OAS.schemaObjectDescription constraints = T.unlines $ ("* " <>) <$> getConstraintDescriptionsOfSchema schema' - pure $ Doc.escapeText $ name <> description <> (if T.null constraints then "" else "\n\nConstraints:\n\n" <> constraints) + pure $ Doc.escapeText $ propName <> description <> (if T.null constraints then "" else "\n\nConstraints:\n\n" <> constraints) ) -- | Extracts the constraints of a 'OAS.SchemaObject' as human readable text diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Operation.hs b/openapi3-code-generator/src/OpenAPI/Generate/Operation.hs index 313a949..ef319b7 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Operation.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Operation.hs @@ -87,7 +87,7 @@ defineModuleForOperation mainModuleName requestPath method operation = OAM.neste convertToCamelCase <- OAM.getSetting OAO.settingConvertToCamelCase let operationIdAsText = T.pack $ show operationIdName appendToOperationName = ((T.pack $ nameBase operationIdName) <>) - moduleName = haskellifyText convertToCamelCase True operationIdAsText + moduleName = T.unpack $ haskellifyText convertToCamelCase True operationIdAsText OAM.logInfo $ "Generating operation with name '" <> operationIdAsText <> "'" (bodySchema, bodyPath) <- getBodySchemaFromOperation operation (responseTypeName, responseTransformerExp, responseBodyDefinitions, responseBodyDependencies) <- OAR.getResponseDefinitions operation appendToOperationName diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs index eae6103..14ff093 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs @@ -110,7 +110,10 @@ data Settings = Settings -- in the 'FromJSON' instance. -- This setting allows to change this behavior by including all fixed value -- fields instead ("include" strategy), i.e. just not trying to do anything smart. - settingFixedValueStrategy :: !FixedValueStrategy + settingFixedValueStrategy :: !FixedValueStrategy, + -- | Instead of numbering oneof branches as OneOfN, name oneof branches after a single field + -- where possible. + settingUseSingleFieldNames :: !Bool } deriving (Show, Eq) @@ -157,6 +160,7 @@ combineToSettings Flags {..} mConf configurationFilePath = do settingWhiteListedSchemas = fromMaybe [] $ flagWhiteListedSchemas <|> mc configWhiteListedSchemas settingOutputAllSchemas = fromMaybe False $ flagOutputAllSchemas <|> mc configOutputAllSchemas settingFixedValueStrategy = fromMaybe FixedValueStrategyExclude $ flagFixedValueStrategy <|> mc configFixedValueStrategy + settingUseSingleFieldNames = fromMaybe False $ flagUseSingleFieldNames <|> mc configUseSingleFieldNames pure Settings {..} where diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs index c202cfb..66ae185 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs @@ -49,7 +49,8 @@ data Configuration = Configuration configOpaqueSchemas :: !(Maybe [Text]), configWhiteListedSchemas :: !(Maybe [Text]), configOutputAllSchemas :: !(Maybe Bool), - configFixedValueStrategy :: !(Maybe FixedValueStrategy) + configFixedValueStrategy :: !(Maybe FixedValueStrategy), + configUseSingleFieldNames :: !(Maybe Bool) } deriving stock (Show, Eq) deriving (FromJSON, ToJSON) via (Autodocodec Configuration) @@ -91,6 +92,7 @@ instance HasCodec Configuration where <*> optionalField "whiteListedSchemas" "A list of schema names (exactly as they are named in the components.schemas section of the corresponding OpenAPI 3 specification) which need to be generated. For all other schemas only a type alias to 'Aeson.Value' is created." .= configWhiteListedSchemas <*> optionalField "outputAllSchemas" "Output all component schemas" .= configOutputAllSchemas <*> optionalField "fixedValueStrategy" "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart." .= configFixedValueStrategy + <*> optionalField "useSingleFieldNames" "Instead of numbering oneof branches as OneOfN, name oneof branches after a single field where possible" .= configUseSingleFieldNames getConfiguration :: Text -> IO (Maybe Configuration) getConfiguration path = resolveFile' (T.unpack path) >>= readYamlConfigFile diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs index 5ceeda3..3068659 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs @@ -46,7 +46,8 @@ data Flags = Flags flagOpaqueSchemas :: !(Maybe [Text]), flagWhiteListedSchemas :: !(Maybe [Text]), flagOutputAllSchemas :: !(Maybe Bool), - flagFixedValueStrategy :: !(Maybe FixedValueStrategy) + flagFixedValueStrategy :: !(Maybe FixedValueStrategy), + flagUseSingleFieldNames :: !(Maybe Bool) } deriving (Show, Eq) @@ -87,6 +88,7 @@ parseFlags = <*> parseFlagWhiteListedSchemas <*> parseFlagOutputAllSchemas <*> parseFlagFixedValueStrategy + <*> parseFlagUseSingleFieldNames parseFlagConfiguration :: Parser (Maybe Text) parseFlagConfiguration = @@ -382,3 +384,7 @@ parseFlagFixedValueStrategy = help "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart (default: 'exclude').", long "fixed-value-strategy" ] + +parseFlagUseSingleFieldNames :: Parser (Maybe Bool) +parseFlagUseSingleFieldNames = + booleanFlag "Instead of numbering oneof branches as OneOfN, name oneof branches after a single field where possible" "use-single-field-names" Nothing diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Response.hs b/openapi3-code-generator/src/OpenAPI/Generate/Response.hs index 1c8ff2b..9ca240f 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Response.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Response.hs @@ -114,7 +114,7 @@ errorSuffix = "Error" -- | Create the name as 'Text' of the response type / data constructor based on a suffix createResponseNameAsText :: Bool -> (Text -> Text) -> Text -> Text -createResponseNameAsText convertToCamelCase appendToOperationName = T.pack . haskellifyText convertToCamelCase True . appendToOperationName +createResponseNameAsText convertToCamelCase appendToOperationName = haskellifyText convertToCamelCase True . appendToOperationName -- | Create the name as 'Name' of the response type / data constructor based on a suffix createResponseName :: Bool -> (Text -> Text) -> Text -> Name diff --git a/openapi3-code-generator/test/OpenAPI/Generate/Internal/UtilSpec.hs b/openapi3-code-generator/test/OpenAPI/Generate/Internal/UtilSpec.hs index 6c4be3c..00be0cf 100644 --- a/openapi3-code-generator/test/OpenAPI/Generate/Internal/UtilSpec.hs +++ b/openapi3-code-generator/test/OpenAPI/Generate/Internal/UtilSpec.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} + module OpenAPI.Generate.Internal.UtilSpec where import qualified Data.Char as Char import Data.GenValidity.Text () +import Data.Text (Text) import qualified Data.Text as T import Data.Validity.Text () import OpenAPI.Generate.Internal.Util @@ -9,8 +12,7 @@ import Test.Hspec import Test.Validity -- See https://www.haskell.org/onlinereport/lexemes.html § 2.4 -isValidVarId :: String -> Bool -isValidVarId "" = False +isValidVarId :: Text -> Bool isValidVarId "case" = False isValidVarId "class" = False isValidVarId "data" = False @@ -32,11 +34,14 @@ isValidVarId "of" = False isValidVarId "then" = False isValidVarId "type" = False isValidVarId "where" = False -isValidVarId (x : xs) = isValidSmall x && isValidSuffix xs +isValidVarId other = case T.unpack other of + [] -> False + (x : xs) -> isValidSmall x && isValidSuffix xs -isValidConId :: String -> Bool -isValidConId "" = False -isValidConId (x : xs) = isValidLarge x && isValidSuffix xs +isValidConId :: Text -> Bool +isValidConId other = case T.unpack other of + [] -> False + (x : xs) -> isValidLarge x && isValidSuffix xs isValidSmall :: Char -> Bool isValidSmall x = x == '_' || Char.isLower x @@ -65,4 +70,4 @@ spec = do describe "transformToModuleName" $ it "should be valid module name" $ forAllValid $ - isValidConId . T.unpack . transformToModuleName + isValidConId . transformToModuleName From a30559029fc9cb1b3e04ed835fad43c045ebff0c Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Sat, 9 Nov 2024 14:03:31 -0500 Subject: [PATCH 2/9] Add a test --- nix/tests.nix | 2 +- specifications/z_complex_self_made_example.yml | 6 ++++++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/nix/tests.nix b/nix/tests.nix index c199702..c7461e2 100644 --- a/nix/tests.nix +++ b/nix/tests.nix @@ -25,7 +25,7 @@ let (generateCode { fileName = "selenium.yaml"; extraFlags = [ "--response-type-suffix=\"Response'\"" ]; }) (generateCode { fileName = "spot_api.yml"; extraFlags = [ "--opaque-schema=\"aggTrade\"" ]; }) (generateCode { fileName = "uber.json"; }) - (generateCode { fileName = "z_complex_self_made_example.yml"; }) + (generateCode { fileName = "z_complex_self_made_example.yml"; extraFlags = [ "--use-single-field-names" ]; }) (generateCode { fileName = "petstore.yaml"; extraFlags = [ "--module-name=\"Petstore.API\"" ]; }) ]; codeForSpecsLevelTwo = [ diff --git a/specifications/z_complex_self_made_example.yml b/specifications/z_complex_self_made_example.yml index ce7cf16..dfeeb93 100644 --- a/specifications/z_complex_self_made_example.yml +++ b/specifications/z_complex_self_made_example.yml @@ -202,6 +202,12 @@ components: type: string hunts: type: boolean + - type: object + required: + - another_cat + properties: + another_cat: + $ref: '#/components/schemas/Cat' relative: anyOf: - $ref: '#/components/schemas/Cat' From 057be7ee4a6f91586a70a03b2a4803ee395a3e96 Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 13:32:14 -0500 Subject: [PATCH 3/9] Make it generate the same thing it was generating before --- .../src/OpenAPI/Generate/Model.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index 253275b..b6542d3 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -594,16 +594,19 @@ defineArrayModelForSchema strategy schemaName schema = do ) data Field = Field - { fieldName :: Text, + { fieldProp :: Text, + fieldName :: Text, fieldSchema :: OAS.Schema, fieldRequired :: Bool, fieldHaskellName :: Name } +-- FIXME add property type suffix toField :: Bool -> Text -> Text -> OAS.Schema -> Set.Set Text -> Field toField convertToCamelCase propName fieldName fieldSchema required = Field - { fieldName, + { fieldProp = propName, + fieldName, fieldSchema, fieldRequired = propName `Set.member` required, fieldHaskellName = haskellifyName convertToCamelCase False fieldName @@ -766,12 +769,12 @@ createFromJSONImplementation objectName fieldProps = withObjectLamda = foldl ( \prev (_, Field {..}) -> - let fieldName' = stringE $ T.unpack fieldName + let fieldProp' = stringE $ T.unpack fieldProp arg = varE fnArgName readPropE = if fieldRequired - then [|$arg Aeson..: $fieldName'|] - else [|$arg Aeson..:! $fieldName'|] + then [|$arg Aeson..: $fieldProp'|] + else [|$arg Aeson..:! $fieldProp'|] in [|$prev <*> $readPropE|] ) [|pure $(varE objectName)|] @@ -806,7 +809,7 @@ propertiesToBangTypes fieldProps = OAM.nested "properties" $ do pure (haskellifyName convertToCamelCase False fieldName, bang', type') propToBangType :: Field -> OAM.Generator (Q VarBangType, Q Doc, Dep.Models) propToBangType field@Field {..} = do - (myType, (content, dependencies)) <- OAM.nested fieldName $ defineModelForSchemaNamed fieldName fieldSchema + (myType, (content, dependencies)) <- OAM.nested fieldProp $ defineModelForSchemaNamed fieldName fieldSchema let myBang = createBang field myType pure (myBang, content, dependencies) foldFn :: OAM.Generator BangTypesSelfDefined -> (Text, Field) -> OAM.Generator BangTypesSelfDefined From 2c302d164111992fb9b263485a74cbb3b6bcb4f9 Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 13:40:44 -0500 Subject: [PATCH 4/9] Make it the default behavior --- nix/tests.nix | 2 +- .../src/OpenAPI/Generate/Model.hs | 16 ++++++++-------- .../src/OpenAPI/Generate/OptParse.hs | 6 +----- .../OpenAPI/Generate/OptParse/Configuration.hs | 4 +--- .../src/OpenAPI/Generate/OptParse/Flags.hs | 8 +------- 5 files changed, 12 insertions(+), 24 deletions(-) diff --git a/nix/tests.nix b/nix/tests.nix index c7461e2..c199702 100644 --- a/nix/tests.nix +++ b/nix/tests.nix @@ -25,7 +25,7 @@ let (generateCode { fileName = "selenium.yaml"; extraFlags = [ "--response-type-suffix=\"Response'\"" ]; }) (generateCode { fileName = "spot_api.yml"; extraFlags = [ "--opaque-schema=\"aggTrade\"" ]; }) (generateCode { fileName = "uber.json"; }) - (generateCode { fileName = "z_complex_self_made_example.yml"; extraFlags = [ "--use-single-field-names" ]; }) + (generateCode { fileName = "z_complex_self_made_example.yml"; }) (generateCode { fileName = "petstore.yaml"; extraFlags = [ "--module-name=\"Petstore.API\"" ]; }) ]; codeForSpecsLevelTwo = [ diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index b6542d3..adfbf3b 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -369,17 +369,18 @@ defineAnyOfSchema strategy schemaName description schemas = do -- creates types for all the subschemas and then creates an adt with constructors for the different -- subschemas. Constructors are numbered defineOneOfSchema :: Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDeclaration -defineOneOfSchema schemaName description schemas = do - when (null schemas) $ OAM.logWarning "oneOf does not contain any sub-schemas and will therefore be defined as a void type" +defineOneOfSchema schemaName description allSchemas = do + when (null allSchemas) $ OAM.logWarning "oneOf does not contain any sub-schemas and will therefore be defined as a void type" settings <- OAM.getSettings let haskellifyConstructor = haskellifyName (OAO.settingConvertToCamelCase settings) True name = haskellifyConstructor $ schemaName <> "Variants" fixedValueStrategy = OAO.settingFixedValueStrategy settings - useSingleFieldNames = OAO.settingUseSingleFieldNames settings - (schemas', fixedValueSchemas) = extractSchemasWithFixedValues fixedValueStrategy schemas - (schemas'', singleFieldedSchemas) = if useSingleFieldNames then extractSchemasWithSingleField schemas' else (schemas', []) + (otherSchemas, fixedValueSchemas, singleFieldedSchemas) = + let (s', fixedValue) = extractSchemasWithFixedValues fixedValueStrategy allSchemas + (s'', singleFielded) = extractSchemasWithSingleField s' + in (s'', fixedValue, singleFielded) defineSingleFielded field = defineModelForSchemaNamed (schemaName <> haskellifyText (OAO.settingConvertToCamelCase settings) True field) - indexedSchemas = zip schemas'' ([1 ..] :: [Integer]) + indexedSchemas = zip otherSchemas ([1 ..] :: [Integer]) defineIndexed schema index = defineModelForSchemaNamed (schemaName <> "OneOf" <> T.pack (show index)) schema OAM.logInfo $ "Define as oneOf named '" <> T.pack (nameBase name) <> "'" singleFieldedVariants <- mapM (uncurry defineSingleFielded) singleFieldedSchemas @@ -624,10 +625,9 @@ defineObjectModelForSchema strategy schemaName schema = name = haskellifyName convertToCamelCase True schemaName required = OAS.schemaObjectRequired schema fixedValueStrategy = OAO.settingFixedValueStrategy settings - useSingleFieldNames = OAO.settingUseSingleFieldNames settings (props, propsWithFixedValues) = extractPropertiesWithFixedValues fixedValueStrategy required $ Map.toList $ OAS.schemaObjectProperties schema propFields = case props of - [(propName, subschema)] | useSingleFieldNames -> [(propName, toField convertToCamelCase propName schemaName subschema required)] + [(propName, subschema)] -> [(propName, toField convertToCamelCase propName schemaName subschema required)] _ -> flip fmap props $ \(propName, subschema) -> (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName) subschema required) emptyCtx = pure [] diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs index 14ff093..eae6103 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs @@ -110,10 +110,7 @@ data Settings = Settings -- in the 'FromJSON' instance. -- This setting allows to change this behavior by including all fixed value -- fields instead ("include" strategy), i.e. just not trying to do anything smart. - settingFixedValueStrategy :: !FixedValueStrategy, - -- | Instead of numbering oneof branches as OneOfN, name oneof branches after a single field - -- where possible. - settingUseSingleFieldNames :: !Bool + settingFixedValueStrategy :: !FixedValueStrategy } deriving (Show, Eq) @@ -160,7 +157,6 @@ combineToSettings Flags {..} mConf configurationFilePath = do settingWhiteListedSchemas = fromMaybe [] $ flagWhiteListedSchemas <|> mc configWhiteListedSchemas settingOutputAllSchemas = fromMaybe False $ flagOutputAllSchemas <|> mc configOutputAllSchemas settingFixedValueStrategy = fromMaybe FixedValueStrategyExclude $ flagFixedValueStrategy <|> mc configFixedValueStrategy - settingUseSingleFieldNames = fromMaybe False $ flagUseSingleFieldNames <|> mc configUseSingleFieldNames pure Settings {..} where diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs index 66ae185..c202cfb 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs @@ -49,8 +49,7 @@ data Configuration = Configuration configOpaqueSchemas :: !(Maybe [Text]), configWhiteListedSchemas :: !(Maybe [Text]), configOutputAllSchemas :: !(Maybe Bool), - configFixedValueStrategy :: !(Maybe FixedValueStrategy), - configUseSingleFieldNames :: !(Maybe Bool) + configFixedValueStrategy :: !(Maybe FixedValueStrategy) } deriving stock (Show, Eq) deriving (FromJSON, ToJSON) via (Autodocodec Configuration) @@ -92,7 +91,6 @@ instance HasCodec Configuration where <*> optionalField "whiteListedSchemas" "A list of schema names (exactly as they are named in the components.schemas section of the corresponding OpenAPI 3 specification) which need to be generated. For all other schemas only a type alias to 'Aeson.Value' is created." .= configWhiteListedSchemas <*> optionalField "outputAllSchemas" "Output all component schemas" .= configOutputAllSchemas <*> optionalField "fixedValueStrategy" "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart." .= configFixedValueStrategy - <*> optionalField "useSingleFieldNames" "Instead of numbering oneof branches as OneOfN, name oneof branches after a single field where possible" .= configUseSingleFieldNames getConfiguration :: Text -> IO (Maybe Configuration) getConfiguration path = resolveFile' (T.unpack path) >>= readYamlConfigFile diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs index 3068659..5ceeda3 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs @@ -46,8 +46,7 @@ data Flags = Flags flagOpaqueSchemas :: !(Maybe [Text]), flagWhiteListedSchemas :: !(Maybe [Text]), flagOutputAllSchemas :: !(Maybe Bool), - flagFixedValueStrategy :: !(Maybe FixedValueStrategy), - flagUseSingleFieldNames :: !(Maybe Bool) + flagFixedValueStrategy :: !(Maybe FixedValueStrategy) } deriving (Show, Eq) @@ -88,7 +87,6 @@ parseFlags = <*> parseFlagWhiteListedSchemas <*> parseFlagOutputAllSchemas <*> parseFlagFixedValueStrategy - <*> parseFlagUseSingleFieldNames parseFlagConfiguration :: Parser (Maybe Text) parseFlagConfiguration = @@ -384,7 +382,3 @@ parseFlagFixedValueStrategy = help "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart (default: 'exclude').", long "fixed-value-strategy" ] - -parseFlagUseSingleFieldNames :: Parser (Maybe Bool) -parseFlagUseSingleFieldNames = - booleanFlag "Instead of numbering oneof branches as OneOfN, name oneof branches after a single field where possible" "use-single-field-names" Nothing From cf96b429925f9bbfad6abfee1dddbfc99df35831 Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 13:49:06 -0500 Subject: [PATCH 5/9] Bump version --- example/generatedCode/src/OpenAPI/Common.hs | 2 +- openapi3-code-generator/default.nix | 2 +- openapi3-code-generator/openapi3-code-generator.cabal | 2 +- openapi3-code-generator/package.yaml | 2 +- testing/golden-output/src/OpenAPI/Common.hs | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/example/generatedCode/src/OpenAPI/Common.hs b/example/generatedCode/src/OpenAPI/Common.hs index 9d98534..7563694 100755 --- a/example/generatedCode/src/OpenAPI/Common.hs +++ b/example/generatedCode/src/OpenAPI/Common.hs @@ -255,7 +255,7 @@ createBaseRequest config method path queryParams = else basePath -- filters all maybe query = BF.second pure <$> serializeQueryParams queryParams - userAgent = configApplicationName config <> " openapi3-code-generator/0.1.0.7 (https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)" + userAgent = configApplicationName config <> " openapi3-code-generator/0.2.0.0 (https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)" addUserAgent = if configIncludeUserAgent config then HS.addRequestHeader HT.hUserAgent $ textToByte userAgent diff --git a/openapi3-code-generator/default.nix b/openapi3-code-generator/default.nix index 08ba7f0..5d77e86 100644 --- a/openapi3-code-generator/default.nix +++ b/openapi3-code-generator/default.nix @@ -8,7 +8,7 @@ }: mkDerivation { pname = "openapi3-code-generator"; - version = "0.1.0.7"; + version = "0.2.0.0"; src = ./.; isLibrary = true; isExecutable = true; diff --git a/openapi3-code-generator/openapi3-code-generator.cabal b/openapi3-code-generator/openapi3-code-generator.cabal index 721e4d3..8b3c752 100644 --- a/openapi3-code-generator/openapi3-code-generator.cabal +++ b/openapi3-code-generator/openapi3-code-generator.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: openapi3-code-generator -version: 0.1.0.7 +version: 0.2.0.0 synopsis: OpenAPI3 Haskell Client Code Generator description: Please see the README on GitHub at category: Code-Generator diff --git a/openapi3-code-generator/package.yaml b/openapi3-code-generator/package.yaml index 1f7d79c..9d3bd6a 100644 --- a/openapi3-code-generator/package.yaml +++ b/openapi3-code-generator/package.yaml @@ -1,5 +1,5 @@ name: openapi3-code-generator -version: 0.1.0.7 +version: 0.2.0.0 github: "Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator" author: "Remo Dörig & Joel Fisch" synopsis: OpenAPI3 Haskell Client Code Generator diff --git a/testing/golden-output/src/OpenAPI/Common.hs b/testing/golden-output/src/OpenAPI/Common.hs index 9d98534..7563694 100755 --- a/testing/golden-output/src/OpenAPI/Common.hs +++ b/testing/golden-output/src/OpenAPI/Common.hs @@ -255,7 +255,7 @@ createBaseRequest config method path queryParams = else basePath -- filters all maybe query = BF.second pure <$> serializeQueryParams queryParams - userAgent = configApplicationName config <> " openapi3-code-generator/0.1.0.7 (https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)" + userAgent = configApplicationName config <> " openapi3-code-generator/0.2.0.0 (https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)" addUserAgent = if configIncludeUserAgent config then HS.addRequestHeader HT.hUserAgent $ textToByte userAgent From eb938d7337dd50582b9e7810f5c22e7575ea67c6 Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 13:54:14 -0500 Subject: [PATCH 6/9] Re-add property suffix --- openapi3-code-generator/src/OpenAPI/Generate/Model.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index adfbf3b..f7fc6bb 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -602,7 +602,6 @@ data Field = Field fieldHaskellName :: Name } --- FIXME add property type suffix toField :: Bool -> Text -> Text -> OAS.Schema -> Set.Set Text -> Field toField convertToCamelCase propName fieldName fieldSchema required = Field @@ -626,10 +625,11 @@ defineObjectModelForSchema strategy schemaName schema = required = OAS.schemaObjectRequired schema fixedValueStrategy = OAO.settingFixedValueStrategy settings (props, propsWithFixedValues) = extractPropertiesWithFixedValues fixedValueStrategy required $ Map.toList $ OAS.schemaObjectProperties schema + propSuffix = OAO.settingPropertyTypeSuffix settings propFields = case props of - [(propName, subschema)] -> [(propName, toField convertToCamelCase propName schemaName subschema required)] + [(propName, subschema)] -> [(propName, toField convertToCamelCase propName (schemaName <> propSuffix) subschema required)] _ -> flip fmap props $ \(propName, subschema) -> - (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName) subschema required) + (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName <> propSuffix) subschema required) emptyCtx = pure [] OAM.logInfo $ "Define as record named '" <> T.pack (nameBase name) <> "'" (bangTypes, propertyContent, propertyDependencies) <- propertiesToBangTypes propFields From f115133418e18d31265ceae3c5c891307b70522c Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 13:54:27 -0500 Subject: [PATCH 7/9] Regenerate testing files --- .../src/OpenAPI/Types/CoverType.hs | 68 +++++++++---------- .../src/OpenAPI/Types/CoverType.hs-boot | 10 +-- .../src/OpenAPI/Types/Mischling.hs | 21 +++++- .../src/OpenAPI/Types/Mischling.hs-boot | 5 ++ .../src/OpenAPI/Types/PetByAge.hs | 21 +++++- .../src/OpenAPI/Types/PetByAge.hs-boot | 5 ++ 6 files changed, 89 insertions(+), 41 deletions(-) diff --git a/testing/golden-output/src/OpenAPI/Types/CoverType.hs b/testing/golden-output/src/OpenAPI/Types/CoverType.hs index 5eb3353..eabe90d 100755 --- a/testing/golden-output/src/OpenAPI/Types/CoverType.hs +++ b/testing/golden-output/src/OpenAPI/Types/CoverType.hs @@ -45,50 +45,50 @@ import {-# SOURCE #-} OpenAPI.Types.Value -- data CoverType = CoverType { -- | cover - coverTypeCover :: (GHC.Maybe.Maybe CoverTypeCoverVariants) + coverType :: (GHC.Maybe.Maybe CoverTypeVariants) } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON CoverType - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverTypeCover obj) : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverTypeCover obj) : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverType obj) : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverType obj) : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON CoverType where {parseJSON = Data.Aeson.Types.FromJSON.withObject "CoverType" (\obj -> GHC.Base.pure CoverType GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "cover"))} -- | Create a new 'CoverType' with all required fields. mkCoverType :: CoverType -mkCoverType = CoverType{coverTypeCover = GHC.Maybe.Nothing} +mkCoverType = CoverType{coverType = GHC.Maybe.Nothing} -- | Defines the oneOf schema located at @components.schemas.CoverType.properties.cover.oneOf@ in the specification. -- -- -data CoverTypeCoverVariants = - CoverTypeCoverPetByAge PetByAge - | CoverTypeCoverMischling Mischling - | CoverTypeCoverTest Test - | CoverTypeCoverTest2 Test2 - | CoverTypeCoverTest3 Test3 - | CoverTypeCoverTest4 Test4 - | CoverTypeCoverTest5 Test5 - | CoverTypeCoverTest6 Test6 - | CoverTypeCoverTest7 Test7 - | CoverTypeCoverTest8 Test8 - | CoverTypeCoverTest9 Test9 - | CoverTypeCoverTest10 Test10 - | CoverTypeCoverValue Value +data CoverTypeVariants = + CoverTypePetByAge PetByAge + | CoverTypeMischling Mischling + | CoverTypeTest Test + | CoverTypeTest2 Test2 + | CoverTypeTest3 Test3 + | CoverTypeTest4 Test4 + | CoverTypeTest5 Test5 + | CoverTypeTest6 Test6 + | CoverTypeTest7 Test7 + | CoverTypeTest8 Test8 + | CoverTypeTest9 Test9 + | CoverTypeTest10 Test10 + | CoverTypeValue Value deriving (GHC.Show.Show, GHC.Classes.Eq) -instance Data.Aeson.Types.ToJSON.ToJSON CoverTypeCoverVariants - where {toJSON (CoverTypeCoverPetByAge a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverMischling a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest2 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest3 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest4 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest5 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest6 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest7 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest8 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest9 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverTest10 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeCoverValue a) = Data.Aeson.Types.ToJSON.toJSON a} -instance Data.Aeson.Types.FromJSON.FromJSON CoverTypeCoverVariants - where {parseJSON val = case (CoverTypeCoverPetByAge Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverMischling Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest2 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest3 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest4 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest6 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest7 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest8 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest9 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest10 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverValue Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))))))))))) of +instance Data.Aeson.Types.ToJSON.ToJSON CoverTypeVariants + where {toJSON (CoverTypePetByAge a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeMischling a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest2 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest3 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest4 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest5 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest6 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest7 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest8 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest9 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeTest10 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeValue a) = Data.Aeson.Types.ToJSON.toJSON a} +instance Data.Aeson.Types.FromJSON.FromJSON CoverTypeVariants + where {parseJSON val = case (CoverTypePetByAge Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeMischling Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest2 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest3 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest4 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest6 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest7 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest8 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest9 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest10 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeValue Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))))))))))) of {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} diff --git a/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot b/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot index d601b95..d4046ff 100755 --- a/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot +++ b/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot @@ -6,8 +6,8 @@ instance Show CoverType instance Eq CoverType instance Data.Aeson.FromJSON CoverType instance Data.Aeson.ToJSON CoverType -data CoverTypeCoverVariants -instance Show CoverTypeCoverVariants -instance Eq CoverTypeCoverVariants -instance Data.Aeson.FromJSON CoverTypeCoverVariants -instance Data.Aeson.ToJSON CoverTypeCoverVariants +data CoverTypeVariants +instance Show CoverTypeVariants +instance Eq CoverTypeVariants +instance Data.Aeson.FromJSON CoverTypeVariants +instance Data.Aeson.ToJSON CoverTypeVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Mischling.hs b/testing/golden-output/src/OpenAPI/Types/Mischling.hs index 37f634e..ffba046 100755 --- a/testing/golden-output/src/OpenAPI/Types/Mischling.hs +++ b/testing/golden-output/src/OpenAPI/Types/Mischling.hs @@ -155,6 +155,23 @@ instance Data.Aeson.Types.FromJSON.FromJSON MischlingAnother_relativeOneOf5 mkMischlingAnother_relativeOneOf5 :: MischlingAnother_relativeOneOf5 mkMischlingAnother_relativeOneOf5 = MischlingAnother_relativeOneOf5{mischlingAnother_relativeOneOf5Hunts = GHC.Maybe.Nothing, mischlingAnother_relativeOneOf5Pet_type = GHC.Maybe.Nothing} +-- | Defines the object schema located at @components.schemas.Mischling.allOf.properties.another_relative.oneOf@ in the specification. +-- +-- +data MischlingAnother_relativeAnother_cat = MischlingAnother_relativeAnother_cat { + -- | another_cat + mischlingAnother_relativeAnother_cat :: Cat + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON MischlingAnother_relativeAnother_cat + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_cat obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_cat obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON MischlingAnother_relativeAnother_cat + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "MischlingAnother_relativeAnother_cat" (\obj -> GHC.Base.pure MischlingAnother_relativeAnother_cat GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "another_cat"))} +-- | Create a new 'MischlingAnother_relativeAnother_cat' with all required fields. +mkMischlingAnother_relativeAnother_cat :: Cat -- ^ 'mischlingAnother_relativeAnother_cat' + -> MischlingAnother_relativeAnother_cat +mkMischlingAnother_relativeAnother_cat mischlingAnother_relativeAnother_cat = MischlingAnother_relativeAnother_cat{mischlingAnother_relativeAnother_cat = mischlingAnother_relativeAnother_cat} -- | Defines the oneOf schema located at @components.schemas.Mischling.allOf.properties.another_relative.oneOf@ in the specification. -- -- @@ -166,6 +183,7 @@ data MischlingAnother_relativeVariants = | MischlingAnother_relativeText Data.Text.Internal.Text | MischlingAnother_relativeListTText [Data.Text.Internal.Text] | MischlingAnother_relativeMischlingAnother_relativeOneOf5 MischlingAnother_relativeOneOf5 + | MischlingAnother_relativeMischlingAnother_relativeAnother_cat MischlingAnother_relativeAnother_cat deriving (GHC.Show.Show, GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON MischlingAnother_relativeVariants where {toJSON (MischlingAnother_relativeCat a) = Data.Aeson.Types.ToJSON.toJSON a; @@ -173,12 +191,13 @@ instance Data.Aeson.Types.ToJSON.ToJSON MischlingAnother_relativeVariants toJSON (MischlingAnother_relativeText a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (MischlingAnother_relativeListTText a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (MischlingAnother_relativeMischlingAnother_relativeOneOf5 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (MischlingAnother_relativeMischlingAnother_relativeAnother_cat a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (MischlingAnother_relativeEmptyString) = ""; toJSON (MischlingAnother_relativeTest) = "test"} instance Data.Aeson.Types.FromJSON.FromJSON MischlingAnother_relativeVariants where {parseJSON val = if | val GHC.Classes.== "" -> GHC.Base.pure MischlingAnother_relativeEmptyString | val GHC.Classes.== "test" -> GHC.Base.pure MischlingAnother_relativeTest - | GHC.Base.otherwise -> case (MischlingAnother_relativeCat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativePetByType Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeListTText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeMischlingAnother_relativeOneOf5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))) of + | GHC.Base.otherwise -> case (MischlingAnother_relativeCat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativePetByType Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeListTText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeMischlingAnother_relativeOneOf5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((MischlingAnother_relativeMischlingAnother_relativeAnother_cat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched"))))) of {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} -- | Defines the enum schema located at @components.schemas.Mischling.allOf.properties.breed@ in the specification. diff --git a/testing/golden-output/src/OpenAPI/Types/Mischling.hs-boot b/testing/golden-output/src/OpenAPI/Types/Mischling.hs-boot index 11c4a03..cebca66 100755 --- a/testing/golden-output/src/OpenAPI/Types/Mischling.hs-boot +++ b/testing/golden-output/src/OpenAPI/Types/Mischling.hs-boot @@ -11,6 +11,11 @@ instance Show MischlingAnother_relativeOneOf5 instance Eq MischlingAnother_relativeOneOf5 instance Data.Aeson.FromJSON MischlingAnother_relativeOneOf5 instance Data.Aeson.ToJSON MischlingAnother_relativeOneOf5 +data MischlingAnother_relativeAnother_cat +instance Show MischlingAnother_relativeAnother_cat +instance Eq MischlingAnother_relativeAnother_cat +instance Data.Aeson.FromJSON MischlingAnother_relativeAnother_cat +instance Data.Aeson.ToJSON MischlingAnother_relativeAnother_cat data MischlingAnother_relativeVariants instance Show MischlingAnother_relativeVariants instance Eq MischlingAnother_relativeVariants diff --git a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs index d1d77b6..298c2a1 100755 --- a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs +++ b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs @@ -83,6 +83,23 @@ instance Data.Aeson.Types.FromJSON.FromJSON PetByAgeAnother_relativeOneOf5 mkPetByAgeAnother_relativeOneOf5 :: PetByAgeAnother_relativeOneOf5 mkPetByAgeAnother_relativeOneOf5 = PetByAgeAnother_relativeOneOf5{petByAgeAnother_relativeOneOf5Hunts = GHC.Maybe.Nothing, petByAgeAnother_relativeOneOf5Pet_type = GHC.Maybe.Nothing} +-- | Defines the object schema located at @components.schemas.PetByAge.properties.another_relative.oneOf@ in the specification. +-- +-- +data PetByAgeAnother_relativeAnother_cat = PetByAgeAnother_relativeAnother_cat { + -- | another_cat + petByAgeAnother_relativeAnother_cat :: Cat + } deriving (GHC.Show.Show + , GHC.Classes.Eq) +instance Data.Aeson.Types.ToJSON.ToJSON PetByAgeAnother_relativeAnother_cat + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_cat obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_cat obj] : GHC.Base.mempty)))} +instance Data.Aeson.Types.FromJSON.FromJSON PetByAgeAnother_relativeAnother_cat + where {parseJSON = Data.Aeson.Types.FromJSON.withObject "PetByAgeAnother_relativeAnother_cat" (\obj -> GHC.Base.pure PetByAgeAnother_relativeAnother_cat GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "another_cat"))} +-- | Create a new 'PetByAgeAnother_relativeAnother_cat' with all required fields. +mkPetByAgeAnother_relativeAnother_cat :: Cat -- ^ 'petByAgeAnother_relativeAnother_cat' + -> PetByAgeAnother_relativeAnother_cat +mkPetByAgeAnother_relativeAnother_cat petByAgeAnother_relativeAnother_cat = PetByAgeAnother_relativeAnother_cat{petByAgeAnother_relativeAnother_cat = petByAgeAnother_relativeAnother_cat} -- | Defines the oneOf schema located at @components.schemas.PetByAge.properties.another_relative.oneOf@ in the specification. -- -- @@ -94,6 +111,7 @@ data PetByAgeAnother_relativeVariants = | PetByAgeAnother_relativeText Data.Text.Internal.Text | PetByAgeAnother_relativeListTText [Data.Text.Internal.Text] | PetByAgeAnother_relativePetByAgeAnother_relativeOneOf5 PetByAgeAnother_relativeOneOf5 + | PetByAgeAnother_relativePetByAgeAnother_relativeAnother_cat PetByAgeAnother_relativeAnother_cat deriving (GHC.Show.Show, GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON PetByAgeAnother_relativeVariants where {toJSON (PetByAgeAnother_relativeCat a) = Data.Aeson.Types.ToJSON.toJSON a; @@ -101,12 +119,13 @@ instance Data.Aeson.Types.ToJSON.ToJSON PetByAgeAnother_relativeVariants toJSON (PetByAgeAnother_relativeText a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (PetByAgeAnother_relativeListTText a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (PetByAgeAnother_relativePetByAgeAnother_relativeOneOf5 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (PetByAgeAnother_relativePetByAgeAnother_relativeAnother_cat a) = Data.Aeson.Types.ToJSON.toJSON a; toJSON (PetByAgeAnother_relativeEmptyString) = ""; toJSON (PetByAgeAnother_relativeTest) = "test"} instance Data.Aeson.Types.FromJSON.FromJSON PetByAgeAnother_relativeVariants where {parseJSON val = if | val GHC.Classes.== "" -> GHC.Base.pure PetByAgeAnother_relativeEmptyString | val GHC.Classes.== "test" -> GHC.Base.pure PetByAgeAnother_relativeTest - | GHC.Base.otherwise -> case (PetByAgeAnother_relativeCat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativePetByType Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativeText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativeListTText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativePetByAgeAnother_relativeOneOf5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))) of + | GHC.Base.otherwise -> case (PetByAgeAnother_relativeCat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativePetByType Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativeText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativeListTText Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativePetByAgeAnother_relativeOneOf5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((PetByAgeAnother_relativePetByAgeAnother_relativeAnother_cat Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched"))))) of {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} -- | Defines the object schema located at @components.schemas.PetByAge.properties.first_relative.allOf@ in the specification. diff --git a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs-boot b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs-boot index 6365ca8..069aad9 100755 --- a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs-boot +++ b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs-boot @@ -11,6 +11,11 @@ instance Show PetByAgeAnother_relativeOneOf5 instance Eq PetByAgeAnother_relativeOneOf5 instance Data.Aeson.FromJSON PetByAgeAnother_relativeOneOf5 instance Data.Aeson.ToJSON PetByAgeAnother_relativeOneOf5 +data PetByAgeAnother_relativeAnother_cat +instance Show PetByAgeAnother_relativeAnother_cat +instance Eq PetByAgeAnother_relativeAnother_cat +instance Data.Aeson.FromJSON PetByAgeAnother_relativeAnother_cat +instance Data.Aeson.ToJSON PetByAgeAnother_relativeAnother_cat data PetByAgeAnother_relativeVariants instance Show PetByAgeAnother_relativeVariants instance Eq PetByAgeAnother_relativeVariants From 1dfdeb36a9d384a70582c6ae95679943e1b7c6c3 Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 21:57:21 -0500 Subject: [PATCH 8/9] Make shortening single-field objects configurable because it doesn't work 100% of the time. --- .../src/OpenAPI/Generate/Model.hs | 5 +- .../src/OpenAPI/Generate/OptParse.hs | 6 +- .../Generate/OptParse/Configuration.hs | 4 +- .../src/OpenAPI/Generate/OptParse/Flags.hs | 8 ++- .../src/OpenAPI/Types/CoverType.hs | 68 +++++++++---------- .../src/OpenAPI/Types/CoverType.hs-boot | 10 +-- .../src/OpenAPI/Types/Mischling.hs | 10 +-- .../src/OpenAPI/Types/PetByAge.hs | 10 +-- 8 files changed, 68 insertions(+), 53 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index f7fc6bb..406d451 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -624,10 +624,13 @@ defineObjectModelForSchema strategy schemaName schema = name = haskellifyName convertToCamelCase True schemaName required = OAS.schemaObjectRequired schema fixedValueStrategy = OAO.settingFixedValueStrategy settings + shortenSingleFieldObjects = OAO.settingShortenSingleFieldObjects settings (props, propsWithFixedValues) = extractPropertiesWithFixedValues fixedValueStrategy required $ Map.toList $ OAS.schemaObjectProperties schema propSuffix = OAO.settingPropertyTypeSuffix settings propFields = case props of - [(propName, subschema)] -> [(propName, toField convertToCamelCase propName (schemaName <> propSuffix) subschema required)] + [(propName, subschema)] + | shortenSingleFieldObjects -> + [(propName, toField convertToCamelCase propName (schemaName <> propSuffix) subschema required)] _ -> flip fmap props $ \(propName, subschema) -> (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName <> propSuffix) subschema required) emptyCtx = pure [] diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs index eae6103..625bf70 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse.hs @@ -110,7 +110,10 @@ data Settings = Settings -- in the 'FromJSON' instance. -- This setting allows to change this behavior by including all fixed value -- fields instead ("include" strategy), i.e. just not trying to do anything smart. - settingFixedValueStrategy :: !FixedValueStrategy + settingFixedValueStrategy :: !FixedValueStrategy, + -- | When encountering an object with a single field, shorten the field of that object to be the + -- schema name. Respects property type suffix. + settingShortenSingleFieldObjects :: !Bool } deriving (Show, Eq) @@ -157,6 +160,7 @@ combineToSettings Flags {..} mConf configurationFilePath = do settingWhiteListedSchemas = fromMaybe [] $ flagWhiteListedSchemas <|> mc configWhiteListedSchemas settingOutputAllSchemas = fromMaybe False $ flagOutputAllSchemas <|> mc configOutputAllSchemas settingFixedValueStrategy = fromMaybe FixedValueStrategyExclude $ flagFixedValueStrategy <|> mc configFixedValueStrategy + settingShortenSingleFieldObjects = fromMaybe False $ flagShortenSingleFieldObjects <|> mc configShortenSingleFieldObjects pure Settings {..} where diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs index c202cfb..f450b9d 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.hs @@ -49,7 +49,8 @@ data Configuration = Configuration configOpaqueSchemas :: !(Maybe [Text]), configWhiteListedSchemas :: !(Maybe [Text]), configOutputAllSchemas :: !(Maybe Bool), - configFixedValueStrategy :: !(Maybe FixedValueStrategy) + configFixedValueStrategy :: !(Maybe FixedValueStrategy), + configShortenSingleFieldObjects :: !(Maybe Bool) } deriving stock (Show, Eq) deriving (FromJSON, ToJSON) via (Autodocodec Configuration) @@ -91,6 +92,7 @@ instance HasCodec Configuration where <*> optionalField "whiteListedSchemas" "A list of schema names (exactly as they are named in the components.schemas section of the corresponding OpenAPI 3 specification) which need to be generated. For all other schemas only a type alias to 'Aeson.Value' is created." .= configWhiteListedSchemas <*> optionalField "outputAllSchemas" "Output all component schemas" .= configOutputAllSchemas <*> optionalField "fixedValueStrategy" "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart." .= configFixedValueStrategy + <*> optionalField "shortenSingleFieldObjects" "When encountering an object with a single field, shorten the field of that object to be the schema name. Respects property type suffix." .= configShortenSingleFieldObjects getConfiguration :: Text -> IO (Maybe Configuration) getConfiguration path = resolveFile' (T.unpack path) >>= readYamlConfigFile diff --git a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs index 5ceeda3..07b46f2 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.hs @@ -46,7 +46,8 @@ data Flags = Flags flagOpaqueSchemas :: !(Maybe [Text]), flagWhiteListedSchemas :: !(Maybe [Text]), flagOutputAllSchemas :: !(Maybe Bool), - flagFixedValueStrategy :: !(Maybe FixedValueStrategy) + flagFixedValueStrategy :: !(Maybe FixedValueStrategy), + flagShortenSingleFieldObjects :: !(Maybe Bool) } deriving (Show, Eq) @@ -87,6 +88,7 @@ parseFlags = <*> parseFlagWhiteListedSchemas <*> parseFlagOutputAllSchemas <*> parseFlagFixedValueStrategy + <*> parseFlagShortenSingleFieldObjects parseFlagConfiguration :: Parser (Maybe Text) parseFlagConfiguration = @@ -382,3 +384,7 @@ parseFlagFixedValueStrategy = help "In OpenAPI 3, fixed values can be defined as an enum with only one allowed value. If such a constant value is encountered as a required property of an object, the generator excludes this property by default ('exclude' strategy) and adds the value in the 'ToJSON' instance and expects the value to be there in the 'FromJSON' instance. This setting allows to change this behavior by including all fixed value fields instead ('include' strategy), i.e. just not trying to do anything smart (default: 'exclude').", long "fixed-value-strategy" ] + +parseFlagShortenSingleFieldObjects :: Parser (Maybe Bool) +parseFlagShortenSingleFieldObjects = + booleanFlag "When encountering an object with a single field, shorten the field of that object to be the schema name. Respects property type suffix." "shorten-single-field-objects" Nothing diff --git a/testing/golden-output/src/OpenAPI/Types/CoverType.hs b/testing/golden-output/src/OpenAPI/Types/CoverType.hs index eabe90d..5eb3353 100755 --- a/testing/golden-output/src/OpenAPI/Types/CoverType.hs +++ b/testing/golden-output/src/OpenAPI/Types/CoverType.hs @@ -45,50 +45,50 @@ import {-# SOURCE #-} OpenAPI.Types.Value -- data CoverType = CoverType { -- | cover - coverType :: (GHC.Maybe.Maybe CoverTypeVariants) + coverTypeCover :: (GHC.Maybe.Maybe CoverTypeCoverVariants) } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON CoverType - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverType obj) : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverType obj) : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverTypeCover obj) : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (Data.Maybe.maybe GHC.Base.mempty (GHC.Base.pure GHC.Base.. ("cover" Data.Aeson.Types.ToJSON..=)) (coverTypeCover obj) : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON CoverType where {parseJSON = Data.Aeson.Types.FromJSON.withObject "CoverType" (\obj -> GHC.Base.pure CoverType GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..:! "cover"))} -- | Create a new 'CoverType' with all required fields. mkCoverType :: CoverType -mkCoverType = CoverType{coverType = GHC.Maybe.Nothing} +mkCoverType = CoverType{coverTypeCover = GHC.Maybe.Nothing} -- | Defines the oneOf schema located at @components.schemas.CoverType.properties.cover.oneOf@ in the specification. -- -- -data CoverTypeVariants = - CoverTypePetByAge PetByAge - | CoverTypeMischling Mischling - | CoverTypeTest Test - | CoverTypeTest2 Test2 - | CoverTypeTest3 Test3 - | CoverTypeTest4 Test4 - | CoverTypeTest5 Test5 - | CoverTypeTest6 Test6 - | CoverTypeTest7 Test7 - | CoverTypeTest8 Test8 - | CoverTypeTest9 Test9 - | CoverTypeTest10 Test10 - | CoverTypeValue Value +data CoverTypeCoverVariants = + CoverTypeCoverPetByAge PetByAge + | CoverTypeCoverMischling Mischling + | CoverTypeCoverTest Test + | CoverTypeCoverTest2 Test2 + | CoverTypeCoverTest3 Test3 + | CoverTypeCoverTest4 Test4 + | CoverTypeCoverTest5 Test5 + | CoverTypeCoverTest6 Test6 + | CoverTypeCoverTest7 Test7 + | CoverTypeCoverTest8 Test8 + | CoverTypeCoverTest9 Test9 + | CoverTypeCoverTest10 Test10 + | CoverTypeCoverValue Value deriving (GHC.Show.Show, GHC.Classes.Eq) -instance Data.Aeson.Types.ToJSON.ToJSON CoverTypeVariants - where {toJSON (CoverTypePetByAge a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeMischling a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest2 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest3 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest4 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest5 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest6 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest7 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest8 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest9 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeTest10 a) = Data.Aeson.Types.ToJSON.toJSON a; - toJSON (CoverTypeValue a) = Data.Aeson.Types.ToJSON.toJSON a} -instance Data.Aeson.Types.FromJSON.FromJSON CoverTypeVariants - where {parseJSON val = case (CoverTypePetByAge Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeMischling Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest2 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest3 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest4 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest6 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest7 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest8 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest9 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeTest10 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeValue Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))))))))))) of +instance Data.Aeson.Types.ToJSON.ToJSON CoverTypeCoverVariants + where {toJSON (CoverTypeCoverPetByAge a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverMischling a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest2 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest3 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest4 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest5 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest6 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest7 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest8 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest9 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverTest10 a) = Data.Aeson.Types.ToJSON.toJSON a; + toJSON (CoverTypeCoverValue a) = Data.Aeson.Types.ToJSON.toJSON a} +instance Data.Aeson.Types.FromJSON.FromJSON CoverTypeCoverVariants + where {parseJSON val = case (CoverTypeCoverPetByAge Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverMischling Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest2 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest3 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest4 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest5 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest6 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest7 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest8 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest9 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverTest10 Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> ((CoverTypeCoverValue Data.Functor.<$> Data.Aeson.Types.FromJSON.fromJSON val) GHC.Base.<|> Data.Aeson.Types.Internal.Error "No variant matched")))))))))))) of {Data.Aeson.Types.Internal.Success a -> GHC.Base.pure a; Data.Aeson.Types.Internal.Error a -> Control.Monad.Fail.fail a}} diff --git a/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot b/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot index d4046ff..d601b95 100755 --- a/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot +++ b/testing/golden-output/src/OpenAPI/Types/CoverType.hs-boot @@ -6,8 +6,8 @@ instance Show CoverType instance Eq CoverType instance Data.Aeson.FromJSON CoverType instance Data.Aeson.ToJSON CoverType -data CoverTypeVariants -instance Show CoverTypeVariants -instance Eq CoverTypeVariants -instance Data.Aeson.FromJSON CoverTypeVariants -instance Data.Aeson.ToJSON CoverTypeVariants +data CoverTypeCoverVariants +instance Show CoverTypeCoverVariants +instance Eq CoverTypeCoverVariants +instance Data.Aeson.FromJSON CoverTypeCoverVariants +instance Data.Aeson.ToJSON CoverTypeCoverVariants diff --git a/testing/golden-output/src/OpenAPI/Types/Mischling.hs b/testing/golden-output/src/OpenAPI/Types/Mischling.hs index ffba046..fb58715 100755 --- a/testing/golden-output/src/OpenAPI/Types/Mischling.hs +++ b/testing/golden-output/src/OpenAPI/Types/Mischling.hs @@ -160,18 +160,18 @@ mkMischlingAnother_relativeOneOf5 = MischlingAnother_relativeOneOf5{mischlingAno -- data MischlingAnother_relativeAnother_cat = MischlingAnother_relativeAnother_cat { -- | another_cat - mischlingAnother_relativeAnother_cat :: Cat + mischlingAnother_relativeAnother_catAnother_cat :: Cat } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON MischlingAnother_relativeAnother_cat - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_cat obj] : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_cat obj] : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_catAnother_cat obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= mischlingAnother_relativeAnother_catAnother_cat obj] : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON MischlingAnother_relativeAnother_cat where {parseJSON = Data.Aeson.Types.FromJSON.withObject "MischlingAnother_relativeAnother_cat" (\obj -> GHC.Base.pure MischlingAnother_relativeAnother_cat GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "another_cat"))} -- | Create a new 'MischlingAnother_relativeAnother_cat' with all required fields. -mkMischlingAnother_relativeAnother_cat :: Cat -- ^ 'mischlingAnother_relativeAnother_cat' +mkMischlingAnother_relativeAnother_cat :: Cat -- ^ 'mischlingAnother_relativeAnother_catAnother_cat' -> MischlingAnother_relativeAnother_cat -mkMischlingAnother_relativeAnother_cat mischlingAnother_relativeAnother_cat = MischlingAnother_relativeAnother_cat{mischlingAnother_relativeAnother_cat = mischlingAnother_relativeAnother_cat} +mkMischlingAnother_relativeAnother_cat mischlingAnother_relativeAnother_catAnother_cat = MischlingAnother_relativeAnother_cat{mischlingAnother_relativeAnother_catAnother_cat = mischlingAnother_relativeAnother_catAnother_cat} -- | Defines the oneOf schema located at @components.schemas.Mischling.allOf.properties.another_relative.oneOf@ in the specification. -- -- diff --git a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs index 298c2a1..80da2da 100755 --- a/testing/golden-output/src/OpenAPI/Types/PetByAge.hs +++ b/testing/golden-output/src/OpenAPI/Types/PetByAge.hs @@ -88,18 +88,18 @@ mkPetByAgeAnother_relativeOneOf5 = PetByAgeAnother_relativeOneOf5{petByAgeAnothe -- data PetByAgeAnother_relativeAnother_cat = PetByAgeAnother_relativeAnother_cat { -- | another_cat - petByAgeAnother_relativeAnother_cat :: Cat + petByAgeAnother_relativeAnother_catAnother_cat :: Cat } deriving (GHC.Show.Show , GHC.Classes.Eq) instance Data.Aeson.Types.ToJSON.ToJSON PetByAgeAnother_relativeAnother_cat - where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_cat obj] : GHC.Base.mempty)); - toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_cat obj] : GHC.Base.mempty)))} + where {toJSON obj = Data.Aeson.Types.Internal.object (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_catAnother_cat obj] : GHC.Base.mempty)); + toEncoding obj = Data.Aeson.Encoding.Internal.pairs (GHC.Base.mconcat (Data.Foldable.concat (["another_cat" Data.Aeson.Types.ToJSON..= petByAgeAnother_relativeAnother_catAnother_cat obj] : GHC.Base.mempty)))} instance Data.Aeson.Types.FromJSON.FromJSON PetByAgeAnother_relativeAnother_cat where {parseJSON = Data.Aeson.Types.FromJSON.withObject "PetByAgeAnother_relativeAnother_cat" (\obj -> GHC.Base.pure PetByAgeAnother_relativeAnother_cat GHC.Base.<*> (obj Data.Aeson.Types.FromJSON..: "another_cat"))} -- | Create a new 'PetByAgeAnother_relativeAnother_cat' with all required fields. -mkPetByAgeAnother_relativeAnother_cat :: Cat -- ^ 'petByAgeAnother_relativeAnother_cat' +mkPetByAgeAnother_relativeAnother_cat :: Cat -- ^ 'petByAgeAnother_relativeAnother_catAnother_cat' -> PetByAgeAnother_relativeAnother_cat -mkPetByAgeAnother_relativeAnother_cat petByAgeAnother_relativeAnother_cat = PetByAgeAnother_relativeAnother_cat{petByAgeAnother_relativeAnother_cat = petByAgeAnother_relativeAnother_cat} +mkPetByAgeAnother_relativeAnother_cat petByAgeAnother_relativeAnother_catAnother_cat = PetByAgeAnother_relativeAnother_cat{petByAgeAnother_relativeAnother_catAnother_cat = petByAgeAnother_relativeAnother_catAnother_cat} -- | Defines the oneOf schema located at @components.schemas.PetByAge.properties.another_relative.oneOf@ in the specification. -- -- From 6821b4b84df66d7dcac96161143237617a7c05ab Mon Sep 17 00:00:00 2001 From: Dan Fithian Date: Mon, 11 Nov 2024 22:53:19 -0500 Subject: [PATCH 9/9] Use property type suffix the way it was before --- openapi3-code-generator/src/OpenAPI/Generate/Model.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs index 406d451..28ae7ca 100644 --- a/openapi3-code-generator/src/OpenAPI/Generate/Model.hs +++ b/openapi3-code-generator/src/OpenAPI/Generate/Model.hs @@ -626,13 +626,12 @@ defineObjectModelForSchema strategy schemaName schema = fixedValueStrategy = OAO.settingFixedValueStrategy settings shortenSingleFieldObjects = OAO.settingShortenSingleFieldObjects settings (props, propsWithFixedValues) = extractPropertiesWithFixedValues fixedValueStrategy required $ Map.toList $ OAS.schemaObjectProperties schema - propSuffix = OAO.settingPropertyTypeSuffix settings propFields = case props of [(propName, subschema)] | shortenSingleFieldObjects -> - [(propName, toField convertToCamelCase propName (schemaName <> propSuffix) subschema required)] + [(propName, toField convertToCamelCase propName schemaName subschema required)] _ -> flip fmap props $ \(propName, subschema) -> - (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName <> propSuffix) subschema required) + (propName, toField convertToCamelCase propName (schemaName <> uppercaseFirstText propName) subschema required) emptyCtx = pure [] OAM.logInfo $ "Define as record named '" <> T.pack (nameBase name) <> "'" (bangTypes, propertyContent, propertyDependencies) <- propertiesToBangTypes propFields @@ -802,6 +801,7 @@ propertiesToBangTypes :: [(Text, Field)] -> OAM.Generator BangTypesSelfDefined propertiesToBangTypes [] = pure (pure [], emptyDoc, Set.empty) propertiesToBangTypes fieldProps = OAM.nested "properties" $ do convertToCamelCase <- OAM.getSetting OAO.settingConvertToCamelCase + propTypeSuffix <- OAM.getSetting OAO.settingPropertyTypeSuffix let createBang :: Field -> Q Type -> Q VarBangType createBang Field {..} myType = do bang' <- bang noSourceUnpackedness noSourceStrictness @@ -812,7 +812,7 @@ propertiesToBangTypes fieldProps = OAM.nested "properties" $ do pure (haskellifyName convertToCamelCase False fieldName, bang', type') propToBangType :: Field -> OAM.Generator (Q VarBangType, Q Doc, Dep.Models) propToBangType field@Field {..} = do - (myType, (content, dependencies)) <- OAM.nested fieldProp $ defineModelForSchemaNamed fieldName fieldSchema + (myType, (content, dependencies)) <- OAM.nested fieldProp $ defineModelForSchemaNamed (fieldName <> propTypeSuffix) fieldSchema let myBang = createBang field myType pure (myBang, content, dependencies) foldFn :: OAM.Generator BangTypesSelfDefined -> (Text, Field) -> OAM.Generator BangTypesSelfDefined