dhall-openapi 1.0.3 → 1.0.4

raw patch · 5 files changed

+128/−63 lines, 5 filesdep ~aesondep ~dhalldep ~vectorPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, dhall, vector

API changes (from Hackage documentation)

Files

• dhall-openapi.cabal +4/−4
• openapi-to-dhall/Main.hs +37/−9
• src/Dhall/Kubernetes/Convert.hs +51/−24
• src/Dhall/Kubernetes/Data.hs +8/−4
• src/Dhall/Kubernetes/Types.hs +28/−22

@@ -1,6 +1,6 @@ Cabal-Version:  >=1.11 Name:           dhall-openapi-Version:        1.0.3+Version:        1.0.4 Homepage:       https://github.com/dhall-lang/dhall-haskell/tree/master/dhall-openapi#dhall-openapi Author:         Fabrizio Ferrai Maintainer:     Gabriel439@gmail.com@@ -45,7 +45,7 @@     filepath                >= 1.4       && < 1.5  ,     -- megaparsec follows SemVer: https://github.com/mrkkrp/megaparsec/issues/469#issuecomment-927918469     megaparsec              >= 7.0       && < 10   ,-    optparse-applicative    >= 0.14.3.0  && < 0.17 ,+    optparse-applicative    >= 0.14.3.0  && < 0.18 ,     parser-combinators                             ,      prettyprinter                                  ,     sort                                           ,@@ -79,10 +79,10 @@     base                    >= 4.11.0.0  && < 5    ,     aeson                   >= 1.0.0.0   && < 2.1  ,     containers              >= 0.5.8.0   && < 0.7  ,-    dhall                   >= 1.38.0    && < 1.41 ,+    dhall                   >= 1.38.0    && < 1.42 ,     prettyprinter           >= 1.7.0     && < 1.8  ,     scientific              >= 0.3.0.0   && < 0.4  ,     sort                    >= 1.0       && < 1.1  ,-    text                    >= 0.11.1.0  && < 1.3  ,+    text                    >= 0.11.1.0  && < 2.1  ,     vector                  >= 0.11.0.0  && < 0.13   Default-Language: Haskell2010

@@ -60,6 +60,8 @@ -- | Top-level program options data Options = Options     { skipDuplicates :: Bool+    , preferNaturalInt :: Bool+    , natIntExceptions :: [(String,String)]     , prefixMap :: Data.Map.Map Prefix Dhall.Import     , splits :: Data.Map.Map ModelHierarchy (Maybe ModelName)     , filename :: String@@ -174,6 +176,18 @@ parseImport _ (Dhall.Note _ (Dhall.Embed l)) = pure l parseImport prefix e = fail $ "Expected a Dhall import for " <> prefix <> " not:\n" <> show e +parseNatIntExceptions :: Options.Applicative.ReadM [(String, String)]+parseNatIntExceptions =+  Options.Applicative.eitherReader $ \s ->+    bimap errorBundlePretty id $ result (pack s)+  where+    parser = do+      typ <- some alphaNumChar+      char '.'+      fld <- some alphaNumChar+      return (typ, fld)+    result = parse ((Dhall.Parser.unParser parser `sepBy1` char ',') <* eof) "EXCEPTIONS"+ parsePrefixMap :: Options.Applicative.ReadM (Data.Map.Map Prefix Dhall.Import) parsePrefixMap =   Options.Applicative.eitherReader $ \s ->@@ -201,17 +215,28 @@         mo <- parseModel         return mo       return (path, model)-    result = parse ((Dhall.Parser.unParser parser `sepBy1` char ',') <* eof) "MAPPING"+    result = parse ((Dhall.Parser.unParser parser `sepBy1` char ',') <* eof) "SPLITS"   parseOptions :: Options.Applicative.Parser Options-parseOptions = Options <$> parseSkip <*> parsePrefixMap' <*> parseSplits' <*> fileArg <*> crdArg+parseOptions = Options <$> parseSkip <*> parseNaturalInt <*> parseNatIntExceptions' <*> parsePrefixMap' <*> parseSplits' <*> fileArg <*> crdArg   where     parseSkip =       Options.Applicative.switch         (  Options.Applicative.long "skipDuplicates"         <> Options.Applicative.help "Skip types with the same name when aggregating types"         )+    parseNaturalInt =+      Options.Applicative.switch+        (  Options.Applicative.long "preferNaturalInt"+        <> Options.Applicative.help "Render Swagger Integer as Dhall Natural unless negative numbers included in range"+        )+    parseNatIntExceptions' =+      option [] $ Options.Applicative.option parseNatIntExceptions+       (  Options.Applicative.long "natIntExceptions"+        <> Options.Applicative.help "List of Type.field that should be treated the opposite way to preferNaturalInt; e.g.: ContainerStateTerminated.exitCode,ContainerStateTerminated.signal"+        <> Options.Applicative.metavar "EXCEPTIONS"+       )     parsePrefixMap' =       option Data.Map.empty $ Options.Applicative.option parsePrefixMap         (  Options.Applicative.long "prefixMap"@@ -223,7 +248,7 @@         (  Options.Applicative.long "splitPaths"         <> Options.Applicative.help           "Specifiy path and model name pairs with paths being delimited by '.' and pairs separated by '=' for which \-          \definitions should be aritifically split with a ref: \n\+          \definitions should be artificially split with a ref: \n\           \'(com.example.v1.Certificate).spec=com.example.v1.CertificateSpec'\n\           \When the model name is omitted, a guess will be made based on the first word of the definition's \           \description. Also note that top level model names in a path must use () when the name contains '.'"@@ -280,13 +305,16 @@    let fix m = Data.Map.adjust patchCyclicImports (ModelName m) -  -- Convert to Dhall types in a Map-  let types = Convert.toTypes prefixMap (Convert.pathSplitter splits)+  let fixedDefs =         -- TODO: find a better way to deal with this cyclic import-         $ fix "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1beta1.JSONSchemaProps"-         $ fix "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1.JSONSchemaProps"-            defs+        ( fix "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1beta1.JSONSchemaProps"+        . fix "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1.JSONSchemaProps"+        . fix "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1beta1.JSONSchemaProps.dhall"+        ) defs +  -- Convert to Dhall types in a Map+  let types = Convert.toTypes prefixMap (Convert.pathSplitter splits) preferNaturalInt natIntExceptions fixedDefs+   -- Output to types   Directory.createDirectoryIfMissing True "types"   for_ (Data.Map.toList types) $ \(ModelName name, expr) -> do@@ -294,7 +322,7 @@     writeDhall path expr    -- Convert from Dhall types to defaults-  let defaults = Data.Map.mapMaybeWithKey (Convert.toDefault prefixMap defs) types+  let defaults = Data.Map.mapMaybeWithKey (Convert.toDefault prefixMap fixedDefs) types    -- Output to defaults   Directory.createDirectoryIfMissing True "defaults"

@@ -162,13 +162,13 @@     many types reference other types so we need to access them to decide things     like "should this key be optional" -}-toTypes :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr-toTypes prefixMap typeSplitter definitions = toTypes' prefixMap typeSplitter definitions Data.Map.empty+toTypes :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Bool -> [(String,String)] -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr+toTypes prefixMap typeSplitter preferNaturalInt natIntExceptions definitions = toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions definitions Data.Map.empty -toTypes' :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr -> Data.Map.Map ModelName Expr-toTypes' prefixMap typeSplitter definitions toMerge+toTypes' :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Bool -> [(String,String)] -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr -> Data.Map.Map ModelName Expr+toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions definitions toMerge   | Data.Map.null definitions = toMerge-  | otherwise = mergeNoConflicts (==) (toTypes' prefixMap typeSplitter newDefs modelMap) toMerge+  | otherwise = mergeNoConflicts (==) (toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions newDefs modelMap) toMerge      where          -- some CRDs are equal all except for the top description. This is safe as the only usage of description@@ -176,10 +176,18 @@         equalsIgnoringDescription :: Definition -> Definition -> Bool         equalsIgnoringDescription a b = a { description = description b } == b +        getModelName :: ModelHierarchy -> String+        getModelName hierarchy =+          case hierarchy of+            [] -> ""+            [ModelName{..}] -> Text.unpack (last $ Text.splitOn "." unModelName)+            _ -> getModelName (tail hierarchy)+         convertAndAccumWithKey :: ModelHierarchy -> Data.Map.Map ModelName Definition -> ModelName -> Definition -> (Data.Map.Map ModelName Definition, Expr)         convertAndAccumWithKey modelHierarchy accDefs k v = (mergeNoConflicts equalsIgnoringDescription accDefs leftOverDefs, expr)           where-             (expr, leftOverDefs) = convertToType (modelHierarchy ++ [k]) v+             isException = ((getModelName modelHierarchy), (getModelName [k])) `elem` natIntExceptions+             (expr, leftOverDefs) = (convertToType (modelHierarchy ++ [k]) v (isException /= preferNaturalInt))          (newDefs, modelMap) = Data.Map.mapAccumWithKey (convertAndAccumWithKey []) Data.Map.empty definitions        @@ -190,8 +198,8 @@          -- | Convert a single Definition to a Dhall Type, yielding any definitions to be split         --   Note: model hierarchy contains the modelName of of the current definition as the last entry-        convertToType :: ModelHierarchy -> Definition -> (Expr, Data.Map.Map ModelName Definition)-        convertToType modelHierarchy definition+        convertToType :: ModelHierarchy -> Definition -> Bool -> (Expr, Data.Map.Map ModelName Definition)+        convertToType modelHierarchy definition prefNatInt           | Just splitModelName <- typeSplitter modelHierarchy definition =             ( Dhall.Embed $ mkImport prefixMap [] ((unModelName splitModelName) <> ".dhall"), Data.Map.singleton splitModelName definition)           -- If we point to a ref we just reference it via Import@@ -217,21 +225,31 @@                   adaptRecordList = Dhall.Map.mapMaybe (Just . Dhall.makeRecordField)                in (Dhall.Record $ adaptRecordList $ Dhall.Map.fromList $ fmap (first $ unModelName) allFields, newPropDefs)+          | Just props <- additionalProperties definition+          , let (mapValue, rest) = convertToType modelHierarchy props prefNatInt =+              (Dhall.App Dhall.List (Dhall.Record (Dhall.Map.fromList [ ("mapKey", Dhall.makeRecordField Dhall.Text), ("mapValue", Dhall.makeRecordField mapValue) ])), rest)             -- This is another way to declare an intOrString           | Maybe.isJust $ intOrString definition = (intOrStringType, Data.Map.empty)             -- Otherwise - if we have a 'type' - it's a basic type           | Just basic <- typ definition = case basic of               "object"  -> (kvList, Data.Map.empty)               "array"   | Just item <- items definition ->-                let (e, tm) = convertToType (modelHierarchy) item+                let (e, tm) = convertToType (modelHierarchy) item prefNatInt                 in (Dhall.App Dhall.List e, tm)               "string"  | format definition == Just "int-or-string" -> (intOrStringType, Data.Map.empty)               "string"  -> (Dhall.Text, Data.Map.empty)               "boolean" -> (Dhall.Bool, Data.Map.empty)-              "integer" -> case (minimum_ definition, exclusiveMinimum definition) of-                (Just min_, Just True) | min_ >= -1 -> (Dhall.Natural, Data.Map.empty)-                (Just min_, _)         | min_ >= 0 -> (Dhall.Natural, Data.Map.empty)-                _                      -> (Dhall.Integer, Data.Map.empty)+              "integer" -> if prefNatInt then case (minimum_ definition, exclusiveMinimum definition,+                          maximum_ definition, exclusiveMaximum definition) of+                  (Just min_, Just True, _, _) | min_ < -1 -> (Dhall.Integer, Data.Map.empty)+                  (Just min_, _, _, _)         | min_ < 0  -> (Dhall.Integer, Data.Map.empty)+                  (_, _, Just max_, Just True) | max_ < 1  -> (Dhall.Integer, Data.Map.empty)+                  (_, _, Just max_, _)         | max_ < 0  -> (Dhall.Integer, Data.Map.empty)+                  _                                        -> (Dhall.Natural, Data.Map.empty)+                else case (minimum_ definition, exclusiveMinimum definition) of+                  (Just min_, Just True) | min_ >= -1 -> (Dhall.Natural, Data.Map.empty)+                  (Just min_, _)         | min_ >= 0  -> (Dhall.Natural, Data.Map.empty)+                  _                                   -> (Dhall.Integer, Data.Map.empty)               "number"  -> (Dhall.Double, Data.Map.empty)               other     -> error $ "Found missing Swagger type: " <> Text.unpack other             -- There are empty schemas that only have a description, so we return empty record@@ -436,8 +454,11 @@         , v1JSONSchemaPropsFormat :: Maybe Text         , v1JSONSchemaPropsMinimum :: Maybe Scientific         , v1JSONSchemaPropsExclusiveMinimum :: Maybe Bool+        , v1JSONSchemaPropsMaximum :: Maybe Scientific+        , v1JSONSchemaPropsExclusiveMaximum :: Maybe Bool         , v1JSONSchemaPropsItems :: Maybe Value         , v1JSONSchemaPropsProperties :: Maybe (Data.Map.Map String V1JSONSchemaProps)+        , v1JSONSchemaPropsAdditionalProperties :: Maybe V1JSONSchemaProps         , v1JSONSchemaPropsRequired :: Maybe [Text]         , v1JSONSchemaPropsType :: Maybe Text         , v1JSONSchemaPropsIntOrString :: Maybe Bool@@ -454,8 +475,11 @@         , v1JSONSchemaPropsFormat = Nothing         , v1JSONSchemaPropsMinimum = Nothing         , v1JSONSchemaPropsExclusiveMinimum = Nothing+        , v1JSONSchemaPropsMaximum = Nothing+        , v1JSONSchemaPropsExclusiveMaximum = Nothing         , v1JSONSchemaPropsItems = Nothing         , v1JSONSchemaPropsProperties = Nothing+        , v1JSONSchemaPropsAdditionalProperties = Nothing         , v1JSONSchemaPropsRequired = Nothing         , v1JSONSchemaPropsType = Nothing         , v1JSONSchemaPropsIntOrString = Nothing@@ -519,17 +543,20 @@     propsToDefinition :: V1JSONSchemaProps -> Maybe BaseData -> Definition     propsToDefinition V1JSONSchemaProps{..} basedata =       Definition-        { typ              = v1JSONSchemaPropsType-        , ref              = Ref <$> v1JSONSchemaPropsRef-        , format           = v1JSONSchemaPropsFormat-        , minimum_         = v1JSONSchemaPropsMinimum-        , exclusiveMinimum = v1JSONSchemaPropsExclusiveMinimum-        , description      = v1JSONSchemaPropsDescription-        , items            = v1JSONSchemaPropsItems >>= parseMaybe parseJSON-        , properties       = fmap toProperties v1JSONSchemaPropsProperties-        , required         = fmap (Set.fromList . fmap FieldName) v1JSONSchemaPropsRequired-        , baseData         = basedata-        , intOrString      = v1JSONSchemaPropsIntOrString+        { typ                  = v1JSONSchemaPropsType+        , ref                  = Ref <$> v1JSONSchemaPropsRef+        , format               = v1JSONSchemaPropsFormat+        , minimum_             = v1JSONSchemaPropsMinimum+        , exclusiveMinimum     = v1JSONSchemaPropsExclusiveMinimum+        , maximum_         = v1JSONSchemaPropsMaximum+        , exclusiveMaximum = v1JSONSchemaPropsExclusiveMaximum+        , description          = v1JSONSchemaPropsDescription+        , items                = v1JSONSchemaPropsItems >>= parseMaybe parseJSON+        , properties           = fmap toProperties v1JSONSchemaPropsProperties+        , additionalProperties = fmap (\p -> propsToDefinition p Nothing) v1JSONSchemaPropsAdditionalProperties+        , required             = fmap (Set.fromList . fmap FieldName) v1JSONSchemaPropsRequired+        , baseData             = basedata+        , intOrString          = v1JSONSchemaPropsIntOrString         }      toProperties :: Data.Map.Map String V1JSONSchemaProps -> Data.Map.Map ModelName Definition

@@ -14,12 +14,16 @@     toRemove =       Set.fromList $         (   ModelName-        <$> [ "allOf"+        <$> [ "additionalItems"+            , "additionalProperties"+            , "allOf"             , "anyOf"+            , "definitions"+            , "dependencies"+            , "items"             , "not"             , "oneOf"-            , "additionalItems"-            , "additionalProperties"-            , "items"+            , "properties"+            , "patternProperties"             ]         )

@@ -39,32 +39,38 @@   data Definition = Definition-  { typ              :: Maybe Text-  , ref              :: Maybe Ref-  , format           :: Maybe Text-  , minimum_         :: Maybe Scientific -- Avoid shadowing with Prelude.minimum-  , exclusiveMinimum :: Maybe Bool-  , description      :: Maybe Text-  , items            :: Maybe Definition-  , properties       :: Maybe (Map ModelName Definition)-  , required         :: Maybe (Set FieldName)-  , baseData         :: Maybe BaseData-  , intOrString      :: Maybe Bool+  { typ                  :: Maybe Text+  , ref                  :: Maybe Ref+  , format               :: Maybe Text+  , minimum_             :: Maybe Scientific -- Avoid shadowing with Prelude.minimum+  , exclusiveMinimum     :: Maybe Bool+  , maximum_         :: Maybe Scientific -- Avoid shadowing with Prelude.maximum+  , exclusiveMaximum :: Maybe Bool+  , description          :: Maybe Text+  , items                :: Maybe Definition+  , properties           :: Maybe (Map ModelName Definition)+  , additionalProperties :: Maybe Definition+  , required             :: Maybe (Set FieldName)+  , baseData             :: Maybe BaseData+  , intOrString          :: Maybe Bool   } deriving (Generic, Show, Eq)  instance FromJSON Definition where   parseJSON = withObject "definition" $ \o -> do-    typ              <- o .:? "type"-    ref              <- o .:? "$ref"-    format           <- o .:? "format"-    minimum_         <- o .:? "minimum"-    exclusiveMinimum <- o .:? "exclusiveMinimum"-    properties       <- o .:? "properties"-    required         <- o .:? "required"-    items            <- o .:? "items"-    description      <- o .:? "description"-    baseData         <- fmap join $ optional (o .:? "x-kubernetes-group-version-kind")-    intOrString      <- o .:? "x-kubernetes-int-or-string"+    typ                  <- o .:? "type"+    ref                  <- o .:? "$ref"+    format               <- o .:? "format"+    minimum_             <- o .:? "minimum"+    exclusiveMinimum     <- o .:? "exclusiveMinimum"+    maximum_         <- o .:? "maximum"+    exclusiveMaximum <- o .:? "exclusiveMaximum"+    properties           <- o .:? "properties"+    additionalProperties <- o .:? "additionalProperties"+    required             <- o .:? "required"+    items                <- o .:? "items"+    description          <- o .:? "description"+    baseData             <- fmap join $ optional (o .:? "x-kubernetes-group-version-kind")+    intOrString          <- o .:? "x-kubernetes-int-or-string"     pure Definition{..}