openapi3-code-generator 0.1.0.4 → 0.1.0.6

raw patch · 11 files changed

+177/−59 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +29/−4
• openapi3-code-generator.cabal +2/−2
• src/OpenAPI/Common.hs +4/−0
• src/OpenAPI/Generate.hs +1/−2
• src/OpenAPI/Generate/Doc.hs +13/−5
• src/OpenAPI/Generate/Internal/Operation.hs +29/−27
• src/OpenAPI/Generate/Internal/Util.hs +30/−11
• src/OpenAPI/Generate/Model.hs +4/−4
• src/OpenAPI/Generate/Operation.hs +2/−1
• test/OpenAPI/Generate/Internal/UtilSpec.hs +61/−1
• test/OpenAPI/Generate/OperationTHSpec.hs +2/−2

@@ -2,17 +2,18 @@ [![CircleCI](https://circleci.com/gh/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator.svg?style=svg)](https://circleci.com/gh/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)  ## How to use?-1. install [stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/)-1. `stack install openapi3-code-generator`+1. install [cabal](https://www.haskell.org/cabal/)+1. `cabal update`+1. `cabal install openapi3-code-generator` 1. `openapi3-code-generator-exe my_specification.yml`  An `out` directory is created with the generated code. Hint you can use `--output-dir` to specify another output directory. You can use `openapi3-code-generator --help` to list all CLI options. -If `openapi3-code-generator-exe` is not found, you may not have added the cabal bin to your `PATH`. Execute `~/bin/openapi3-code-generator-exe` instead.+If `openapi3-code-generator-exe` is not found, you may not have added the cabal bin to your `PATH`. Execute `~/.local/bin/openapi3-code-generator-exe` instead.  ## How to run from source-1. `stack build`+1. install [stack](https://docs.haskellstack.org/en/stable/install_and_upgrade/) 1. `stack run -- --help`  ## Example package@@ -38,6 +39,7 @@ ## Troubleshooting naming conflicts Naming conflicts can happen, sometimes a little manual adjustment is needed. With the following options naming conflicts can be resolved.+It can happen, that the names get so long, that they are longer than the file system supports.  - `property-type-suffix` - `response-type-suffix`@@ -46,3 +48,26 @@ - `use-numbered-variant-constructors` - `convert-to-camel-case` +## Limitations+The following features are not supported+- links+- callbacks+- Only references to `components` are supported+- Only JSON is supported for both sending and receiving data. `application/x-www-form-urlencoded` can only be used to send data.+- Some circular references in the schemas. For example if an `allOf` contains itself+- Parameters not in `path` or `query`+- `additionalProperties`+- `not` schemas+- `writeOnly` and `readOnly`+- `multipleOf`+- `maximum`+- `exclusiveMaximum`+- `minimum`+- `exclusiveMinimum`+- `minLength`+- `maxItems`+- `minItems`+- `uniqueItems`+- `maxProperties`+- `minProperties`+- `xml`

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2d7ec1c26136fb123a14fbba656b051e46a7bc9640fdb2fce0d110c00af662e2+-- hash: 5c9f55e3cb67b6324959a3a09c91ecb0c5172a5430099f91fc163132052c7a57  name:           openapi3-code-generator-version:        0.1.0.4+version:        0.1.0.6 license:        MIT license-file:   LICENSE copyright:      2020 Remo Dörig & Joel Fisch

@@ -263,6 +263,10 @@   -- stringifyModel :: String -> String   stringifyModel = id +instance StringifyModel Text where+  -- stringifyModel :: Text -> String+  stringifyModel = T.unpack+ instance {-# OVERLAPS #-} Show a => StringifyModel a where   -- stringifyModel :: Show a => a -> String   stringifyModel = show

@@ -48,7 +48,6 @@ defineConfigurationInformation moduleName spec =   let servers' = (OAT.servers :: OAT.OpenApiSpecification -> [OAT.ServerObject]) spec       defaultURL = getServerURL servers'-      defaultURLStr = T.unpack defaultURL       defaultURLName = mkName "defaultURL"       getServerURL = maybe "/" (OAT.url :: OAT.ServerObject -> Text) . Maybe.listToMaybe    in Doc.addConfigurationModuleHeader moduleName@@ -61,7 +60,7 @@                     "@" <> defaultURL <> "@"                   ],               ppr-                <$> [d|$(varP defaultURLName) = T.pack defaultURLStr|],+                <$> [d|$(varP defaultURLName) = T.pack $(litE $ stringL $ T.unpack defaultURL)|],               pure $ Doc.generateHaddockComment ["The default configuration containing the 'defaultURL' and no authorization"],               ppr <$> [d|$(varP $ mkName "defaultConfiguration") = OC.Configuration $(varE defaultURLName) OC.AnonymousSecurityScheme|]             ]

@@ -60,6 +60,9 @@ moduleDeclaration :: String -> String -> Doc -> Doc moduleDeclaration modulePrefix name = line ("module " <> modulePrefix <> "." <> name <> " where") +generatorNote :: Doc -> Doc+generatorNote = line "-- CHANGE WITH CAUTION: This is a generated code file generated by https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator." . emptyLine+ -- | Append a 'Doc' to another inside an 'Applicative' (typically 'Language.Haskell.TH.Q') appendDoc :: Applicative f => f Doc -> f Doc -> f Doc appendDoc = Applicative.liftA2 ($$)@@ -153,7 +156,8 @@ -- | Add the module header to a module of an operation addOperationsModuleHeader :: String -> String -> String -> Doc -> Doc addOperationsModuleHeader mainModuleName moduleName operationId =-  languageExtension "OverloadedStrings"+  generatorNote+    . languageExtension "OverloadedStrings"     . languageExtension "ExplicitForAll"     . languageExtension "MultiWayIf"     . languageExtension "DeriveGeneric"@@ -178,6 +182,7 @@     . importQualified "Data.Text.Internal"     . importQualified "Data.Time.Calendar as Data.Time.Calendar.Days"     . importQualified "Data.Time.LocalTime as Data.Time.LocalTime.Internal.ZonedTime"+    . importQualified "Data.Vector"     . importQualified "GHC.Base"     . importQualified "GHC.Classes"     . importQualified "GHC.Generics"@@ -198,7 +203,8 @@ -- | Add the module header to a module of a model addModelModuleHeader :: String -> String -> [String] -> String -> Doc -> Doc addModelModuleHeader mainModuleName moduleName modelModulesToImport description =-  languageExtension "OverloadedStrings"+  generatorNote+    . languageExtension "OverloadedStrings"     . languageExtension "DeriveGeneric"     . emptyLine     . moduleDescription description@@ -232,7 +238,8 @@ -- | Add the module header to the security scheme module addSecuritySchemesModuleHeader :: String -> Doc -> Doc addSecuritySchemesModuleHeader moduleName =-  languageExtension "OverloadedStrings"+  generatorNote+    . languageExtension "OverloadedStrings"     . emptyLine     . moduleDescription "Contains all supported security schemes defined in the specification"     . moduleDeclaration moduleName "SecuritySchemes"@@ -249,7 +256,8 @@ -- | Add the module header to the configuration module addConfigurationModuleHeader :: String -> Doc -> Doc addConfigurationModuleHeader moduleName =-  languageExtension "OverloadedStrings"+  generatorNote+    . languageExtension "OverloadedStrings"     . emptyLine     . moduleDescription "Contains the default configuration"     . moduleDeclaration moduleName "Configuration"@@ -263,7 +271,7 @@ createModuleHeaderWithReexports moduleName modulesToExport description =   let exports = vcat $ fmap (text . ("module " <>) . (<> ",")) modulesToExport       imports = vcat $ fmap (text . ("import " <>)) modulesToExport-   in moduleDescription description $+   in generatorNote $ moduleDescription description $         text ("module " <> moduleName <> " (")           $$ nest             2

@@ -38,7 +38,6 @@ import qualified Network.HTTP.Types as HT import qualified OpenAPI.Common as OC import qualified OpenAPI.Generate.Doc as Doc-import qualified OpenAPI.Generate.Flags as OAF import OpenAPI.Generate.Internal.Util import qualified OpenAPI.Generate.Model as Model import qualified OpenAPI.Generate.Monad as OAM@@ -58,10 +57,6 @@ getParametersFromOperationReference = OAT.parameters  -- | wrapper for ambigious usage-getSchemaFromParameterInner :: OAT.ParameterObject -> OAT.ParameterObjectSchema-getSchemaFromParameterInner = OAT.schema---- | wrapper for ambigious usage getRequiredFromParameter :: OAT.ParameterObject -> Bool getRequiredFromParameter = OAT.required @@ -90,17 +85,21 @@       )     . getParametersFromOperationReference --- | Reads the Schema from the ParameterObjectSchema---   Only application/json or simple Object Schema is read-getSchemaFromParameterOuter :: OAT.ParameterObjectSchema -> OAS.SchemaObject-getSchemaFromParameterOuter OAT.SimpleParameterObjectSchema {..} = case schema of-  OAT.Concrete e -> e-  _ -> error "not yet implemented"-getSchemaFromParameterOuter _ = error "not yet implemented"+getSchemaFromParameterObjectSchema :: OAT.ParameterObjectSchema -> OAM.Generator (Maybe OAS.SchemaObject)+getSchemaFromParameterObjectSchema OAT.SimpleParameterObjectSchema {..} = case schema of+  OAT.Concrete e -> pure $ Just e+  OAT.Reference ref -> do+    p <- OAM.getSchemaReferenceM ref+    when (Maybe.isNothing p) $ OAM.logWarning $+      "Reference " <> ref <> " to SchemaObject could not be found and therefore will be skipped."+    pure p+getSchemaFromParameterObjectSchema (OAT.ComplexParameterObjectSchema _) = do+  OAM.logWarning "Complex parameter schemas are not supported and therefore will be skipped."+  pure Nothing --- | Reads the Schema from the Parameter-getSchemaFromParameter :: OAT.ParameterObject -> OAS.SchemaObject-getSchemaFromParameter = getSchemaFromParameterOuter . getSchemaFromParameterInner+-- | Reads the schema from the parameter+getSchemaFromParameter :: OAT.ParameterObject -> OAM.Generator (Maybe OAS.SchemaObject)+getSchemaFromParameter OAT.ParameterObject {..} = OAM.nested name $ getSchemaFromParameterObjectSchema schema  getNameFromParameter :: OAT.ParameterObject -> Text getNameFromParameter = OAT.name@@ -139,13 +138,16 @@  -- | Get the type of a parameter depending on its schema type and the configuration options ('OAF.Flags'). -- If the parameter is not required, a 'Maybe' type is produced.-getParameterType :: OAF.Flags -> OAT.ParameterObject -> Q Type-getParameterType flags parameter =-  let paramType = varT $ Model.getSchemaType flags (getSchemaFromParameter parameter)-   in ( if getRequiredFromParameter parameter-          then paramType-          else [t|Maybe $(paramType)|]-      )+getParameterType :: OAT.ParameterObject -> OAM.Generator (Q Type)+getParameterType parameter = do+  flags <- OAM.getFlags+  schema <- getSchemaFromParameter parameter+  let paramType = varT $ maybe ''Text (Model.getSchemaType flags) schema+  pure+    ( if getRequiredFromParameter parameter+        then paramType+        else [t|Maybe $(paramType)|]+    )  -- | Get a description of a parameter object (the name and if available the description from the specification) getParameterDescription :: OAT.ParameterObject -> OAM.Generator Text@@ -188,7 +190,7 @@       namedQueryParameters = filter ((== OAT.QueryParameterObjectLocation) . getInFromParameterObject . snd) namedParameters       queryParameters = generateQueryParams namedQueryParameters       bodyName = mkName "body"-      strMethod = T.unpack method+      methodLit = litE $ stringL $ T.unpack method   pure $     ppr <$> case bodySchema of       Just RequestBodyDefinition {..} ->@@ -204,7 +206,7 @@                          then [|OC.doBodyCallWithConfiguration $(varE configArg)|]                          else [|OC.doBodyCallWithConfigurationM|]                      )-                    (T.toUpper $ T.pack strMethod)+                    (T.toUpper $ T.pack $methodLit)                     (T.pack $(request))                     $(queryParameters)                     $(if required then [|Just $(varE bodyName)|] else varE bodyName)@@ -219,7 +221,7 @@                      then [|OC.doCallWithConfiguration $(varE configArg)|]                      else [|OC.doCallWithConfigurationM|]                  )-                (T.toUpper $ T.pack strMethod)+                (T.toUpper $ T.pack $methodLit)                 (T.pack $(request))                 $(queryParameters)               )@@ -298,13 +300,13 @@ -- | Generates query params in the form of [(Text,ByteString)] generateQueryParams :: [(Name, OAT.ParameterObject)] -> Q Exp generateQueryParams ((name, param) : xs) =-  infixE (Just [|(T.pack queryName, $(expr))|]) (varE $ mkName ":") (Just $ generateQueryParams xs)+  infixE (Just [|(T.pack $(litE $ stringL queryName), $expr)|]) (varE $ mkName ":") (Just $ generateQueryParams xs)   where     queryName = T.unpack $ getNameFromParameter param     required = getRequiredFromParameter param     expr =       if required-        then [|$(varE $ mkName "GHC.Base.Just") $ OC.stringifyModel $(varE name)|]+        then [|Just $ OC.stringifyModel $(varE name)|]         else [|OC.stringifyModel <$> $(varE name)|] generateQueryParams _ = [|[]|] 

@@ -23,6 +23,22 @@ import qualified OpenAPI.Generate.Flags as OAF import qualified OpenAPI.Generate.Monad as OAM +-- | Checks if the casing of a character can be changed.+-- This is required to ensure the functions 'Char.toUpper' and 'Char.toLower' actually do something.+isCasableAlpha :: Char -> Bool+isCasableAlpha x = Char.isLower (Char.toLower x) && Char.isUpper (Char.toUpper x)++isValidCharaterInSuffixExceptUnderscore :: Char -> Bool+isValidCharaterInSuffixExceptUnderscore x = isCasableAlpha x || Char.isDigit x || x == '\''++removeIllegalLeadingCharacters :: String -> String+removeIllegalLeadingCharacters (x : xs) | not (isCasableAlpha x) = removeIllegalLeadingCharacters xs+removeIllegalLeadingCharacters x = x++generateNameForEmptyIdentifier :: Text -> String -> String+generateNameForEmptyIdentifier originalName "" = "identifier" <> show (T.foldr ((+) . Char.ord) 0 originalName)+generateNameForEmptyIdentifier _ name = name+ -- | Transform an identifier to ensure it is a valid Haskell identifier -- Additionally, this function applies style settings according to the need of the consumer. haskellifyText ::@@ -38,16 +54,17 @@   let casefn = if startWithUppercase then Char.toUpper else Char.toLower       replaceChar '.' = '\''       replaceChar '\'' = '\''-      replaceChar a = if Char.isAlphaNum a then a else '_'+      replaceChar a = if isValidCharaterInSuffixExceptUnderscore a then a else '_'       caseFirstCharCorrectly (x : xs) = casefn x : xs       caseFirstCharCorrectly x = x       nameWithoutSpecialChars a = replaceChar <$> a-      toCamelCase (x : y : xs) | not (Char.isAlphaNum x) && x /= '\'' && Char.isAlpha y = Char.toUpper y : toCamelCase xs+      toCamelCase (x : y : xs) | not (isValidCharaterInSuffixExceptUnderscore x) && isCasableAlpha y = Char.toUpper y : toCamelCase xs       toCamelCase (x : xs) = x : toCamelCase xs       toCamelCase xs = xs       replaceReservedWord "case" = "case'"       replaceReservedWord "class" = "class'"       replaceReservedWord "data" = "data'"+      replaceReservedWord "default" = "default'"       replaceReservedWord "deriving" = "deriving'"       replaceReservedWord "do" = "do'"       replaceReservedWord "else" = "else'"@@ -59,9 +76,9 @@       replaceReservedWord "infixr" = "infixr'"       replaceReservedWord "instance" = "instance'"       replaceReservedWord "let" = "let'"-      replaceReservedWord "of" = "of'"       replaceReservedWord "module" = "module'"       replaceReservedWord "newtype" = "newtype'"+      replaceReservedWord "of" = "of'"       replaceReservedWord "then" = "then'"       replaceReservedWord "type" = "type'"       replaceReservedWord "where" = "where'"@@ -73,13 +90,14 @@       replaceReservedWord "JsonByteString" = "JsonByteString'"       replaceReservedWord "JsonDateTime" = "JsonDateTime'"       replaceReservedWord "RequestBodyEncoding" = "RequestBodyEncoding'"-      replaceReservedWord ('_' : rest) = replaceReservedWord rest       replaceReservedWord a = a       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@@ -97,16 +115,17 @@  -- | Transform a module name to ensure it is valid for file names transformToModuleName :: Text -> Text-transformToModuleName =-  let toCamelCase (x : y : xs) | not (Char.isAlphaNum x) && Char.isAlpha y = Char.toUpper y : toCamelCase xs+transformToModuleName name =+  let toCamelCase (x : y : xs) | not (isValidCharaterInSuffixExceptUnderscore x) && isCasableAlpha y = Char.toUpper y : toCamelCase xs       toCamelCase (x : xs) = x : toCamelCase xs       toCamelCase xs = xs    in T.pack-        . toCamelCase-        . uppercaseFirst-        . T.unpack-        . T.dropWhile (== '_')-        . T.map (\c -> if Char.isAlphaNum c then c else '_')+        $ uppercaseFirst+        $ generateNameForEmptyIdentifier name+        $ removeIllegalLeadingCharacters+        $ toCamelCase+        $ T.unpack+        $ T.map (\c -> if isValidCharaterInSuffixExceptUnderscore c then c else '_') name  uppercaseFirst :: String -> String uppercaseFirst (x : xs) = Char.toUpper x : xs

@@ -378,7 +378,7 @@   case newDefs of     Just (newSchema, newDependencies) ->       addDependencies newDependencies $ defineModelForSchemaConcrete DontCreateTypeAlias schemaName newSchema-    Nothing -> pure (varT ''String, (emptyDoc, Set.empty))+    Nothing -> pure (varT ''Text, (emptyDoc, Set.empty))  -- | defines a new Schema, which properties are fused defineNewSchemaForAllOf :: Text -> Text -> [OAS.Schema] -> OAM.Generator (Maybe (OAS.SchemaObject, Dep.Models))@@ -406,7 +406,7 @@       -- not allowed by the spec       Nothing -> do         OAM.logWarning $ T.pack "items is empty for an array (assume string) " <> schemaName-        pure (varT ''String, (emptyDoc, Set.empty))+        pure (varT ''Text, (emptyDoc, Set.empty))   let arrayType = appT (varT $ mkName "[]") type'   schemaName' <- haskellifyNameM True schemaName   pure@@ -666,6 +666,6 @@ getSchemaType _ OAS.SchemaObject {type' = OAS.SchemaTypeString, format = Just "binary", ..} = ''OC.JsonByteString getSchemaType OAF.Flags {optUseDateTypesAsString = True, ..} OAS.SchemaObject {type' = OAS.SchemaTypeString, format = Just "date", ..} = ''Day getSchemaType OAF.Flags {optUseDateTypesAsString = True, ..} OAS.SchemaObject {type' = OAS.SchemaTypeString, format = Just "date-time", ..} = ''OC.JsonDateTime-getSchemaType _ OAS.SchemaObject {type' = OAS.SchemaTypeString, ..} = ''String+getSchemaType _ OAS.SchemaObject {type' = OAS.SchemaTypeString, ..} = ''Text getSchemaType _ OAS.SchemaObject {type' = OAS.SchemaTypeBool, ..} = ''Bool-getSchemaType _ OAS.SchemaObject {..} = ''String+getSchemaType _ OAS.SchemaObject {..} = ''Text

@@ -91,7 +91,8 @@   functionBodyRawWithMonadTransformer <- defineOperationFunction False operationIdNameRawWithMonadTransformer params requestPath method bodySchema rawTransformation   (bodyType, bodyDefinition) <- getBodyType bodySchema appendToOperationName   paramDescriptions <- (<> ["The request body to send" | not $ null bodyType]) <$> mapM getParameterDescription params-  let types = (getParameterType flags <$> params) <> bodyType+  paramTypes <- mapM getParameterType params+  let types = paramTypes <> bodyType       fnType = getParametersTypeForSignature types responseTypeName monadName securitySchemeName       fnTypeRaw = getParametersTypeForSignature types ''B8.ByteString monadName securitySchemeName       fnTypeWithMonadTransformer = getParametersTypeForSignatureWithMonadTransformer types responseTypeName monadName securitySchemeName

@@ -1,11 +1,54 @@ module OpenAPI.Generate.Internal.UtilSpec where +import qualified Data.Char as Char+import Data.GenValidity.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 "case" = False+isValidVarId "class" = False+isValidVarId "data" = False+isValidVarId "default" = False+isValidVarId "deriving" = False+isValidVarId "do" = False+isValidVarId "else" = False+isValidVarId "if" = False+isValidVarId "import" = False+isValidVarId "in" = False+isValidVarId "infix" = False+isValidVarId "infixl" = False+isValidVarId "infixr" = False+isValidVarId "instance" = False+isValidVarId "let" = False+isValidVarId "module" = False+isValidVarId "newtype" = False+isValidVarId "of" = False+isValidVarId "then" = False+isValidVarId "type" = False+isValidVarId "where" = False+isValidVarId (x : xs) = isValidSmall x && isValidSuffix xs++isValidConId :: String -> Bool+isValidConId "" = False+isValidConId (x : xs) = isValidLarge x && isValidSuffix xs++isValidSmall :: Char -> Bool+isValidSmall x = x == '_' || Char.isLower x++isValidLarge :: Char -> Bool+isValidLarge = Char.isUpper++isValidSuffix :: String -> Bool+isValidSuffix = all (\x -> isValidSmall x || isValidLarge x || Char.isDigit x || x == '\'')+ spec :: Spec-spec =+spec = do   describe "splitOn" $ do     it "should split string into pieces" $       splitOn 'a' "abcabca" `shouldBe` ["", "bc", "bc", ""]@@ -14,3 +57,20 @@       $ \(x, list) ->         length (splitOn (x :: Char) list)           == length (filter (== x) list) + 1+  describe "haskellifyText" $ do+    it "uppercase without CamelCase"+      $ forAllValid+      $ isValidConId . haskellifyText False True+    it "uppercase with CamelCase"+      $ forAllValid+      $ isValidConId . haskellifyText True True+    it "lowercase without CamelCase"+      $ forAllValid+      $ isValidVarId . haskellifyText False False+    it "lowercase with CamelCase"+      $ forAllValid+      $ isValidVarId . haskellifyText True False+  describe "transformToModuleName"+    $ it "should be valid module name"+    $ forAllValid+    $ isValidConId . T.unpack . transformToModuleName

@@ -108,5 +108,5 @@             [t|OC.Configuration $(varT securitySchemeName) -> Maybe Int -> $(responseType)|]           singleTestTH             "Two parameters"-            (getParametersTypeForSignature [conT ''Int, conT ''String] responseTypeName monadName securitySchemeName)-            [t|OC.Configuration $(varT securitySchemeName) -> Int -> String -> $(responseType)|]+            (getParametersTypeForSignature [conT ''Int, conT ''T.Text] responseTypeName monadName securitySchemeName)+            [t|OC.Configuration $(varT securitySchemeName) -> Int -> T.Text -> $(responseType)|]