Single fielded oneof (#118)

* 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.

* Add a test

* Make it generate the same thing it was generating before

* Make it the default behavior

* Bump version

* Re-add property suffix

* Regenerate testing files

* Make shortening single-field objects configurable because it doesn't work 100% of the time.

* Use property type suffix the way it was before

Author: dfithian

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

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;

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 <https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator#readme>
 category:       Code-Generator

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

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

openapi3-code-generator/src/OpenAPI/Generate/Model.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

openapi3-code-generator/src/OpenAPI/Generate/Operation.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

openapi3-code-generator/src/OpenAPI/Generate/OptParse.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

openapi3-code-generator/src/OpenAPI/Generate/OptParse/Configuration.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

openapi3-code-generator/src/OpenAPI/Generate/OptParse/Flags.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

openapi3-code-generator/src/OpenAPI/Generate/Response.hs

@@ -1,16 +1,18 @@
+{-# 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
 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

openapi3-code-generator/test/OpenAPI/Generate/Internal/UtilSpec.hs

@@ -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'

specifications/z_complex_self_made_example.yml

@@ -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

testing/golden-output/src/OpenAPI/Common.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_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_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_catAnother_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.
 -- 
 -- 
@@ -166,19 +183,21 @@ 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;
            toJSON (MischlingAnother_relativePetByType a) = Data.Aeson.Types.ToJSON.toJSON a;
            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.

testing/golden-output/src/OpenAPI/Types/Mischling.hs

@@ -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