dhall-lang/dhall-kubernetes
1
1
Fork 0
mirror of https://github.com/dhall-lang/dhall-kubernetes.git synced 2024-09-17 10:27:08 +03:00
Code Issues Projects Releases Wiki Activity

Add prefixMap option for specifying external import roots (#2)

Browse Source
This commit is contained in:
Hunter Kelly 2019-11-20 13:36:11 +00:00 committed by GitHub
parent 23a53f8786
commit 99f4ecd3b9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 66 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
dhall-kubernetes-generator/dhall-kubernetes-generator.cabal
View File

@ -24,8 +24,10 @@ executable dhall-kubernetes-generator
aeson >= 1.0.0.0 && < 1.5 ,
containers >= 0.5.0.0 && < 0.7 ,
dhall >= 1.22.0 && < 1.25 ,
megaparsec >= 7.0 && < 7.1 ,
optparse-applicative >= 0.14.3.0 && < 0.15 ,
prettyprinter >= 1.2.0.1 && < 1.3 ,
sort >= 1.0 && < 1.1 ,
text >= 0.11.1.0 && < 1.3 ,
turtle >= 1.5.0 && < 1.6 ,
vector >= 0.11.0.0 && < 0.13

31
dhall-kubernetes-generator/src/Dhall/Kubernetes/Convert.hs
View File

@ -8,6 +8,7 @@ module Dhall.Kubernetes.Convert
import qualified Data.List as List
import qualified Data.Map.Strict as Data.Map
import qualified Data.Set as Set
import qualified Data.Sort as Sort
import qualified Data.Text as Text
import qualified Dhall.Core as Dhall
import qualified Dhall.Map
@ -63,14 +64,20 @@ pathFromRef (Ref r) = (Text.split (== '/') r) List.!! 2
-- | Build an import from path components (note: they need to be in reverse order)
-- and a filename
mkImport :: [Text] -> Text -> Dhall.Import
mkImport components file = Dhall.Import{..}
mkImport :: PrefixMap -> [Text] -> Text -> Dhall.Import
mkImport prefixMap components file =
case Data.Map.toList filteredPrefixMap of
[] -> localImport
[(_, imp)] -> imp <> localImport
xs -> (snd . head $ Sort.sortOn (Text.length . fst) xs) <> localImport
where
localImport = Dhall.Import{..}
importMode = Dhall.Code
importHashed = Dhall.ImportHashed{..}
hash = Nothing
importType = Dhall.Local Dhall.Here Dhall.File{..}
directory = Dhall.Directory{..}
filteredPrefixMap = Data.Map.filterWithKey (\k _ -> Text.isPrefixOf k file) prefixMap
-- | Get the namespaced object name if the Import points to it
namespacedObjectFromImport :: Dhall.Import -> Maybe Text
@ -91,8 +98,8 @@ toTextLit str = Dhall.TextLit (Dhall.Chunks [] str)
-- Note: we cannot do 1-to-1 conversion and we need the whole Map because
-- many types reference other types so we need to access them to decide things
-- like "should this key be optional"
toTypes :: Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr
toTypes definitions = memo
toTypes :: PrefixMap -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr
toTypes prefixMap definitions = memo
where
memo = Data.Map.mapWithKey (\k -> convertToType (Just k)) definitions
@ -139,7 +146,7 @@ toTypes definitions = memo
convertToType :: Maybe ModelName -> Definition -> Expr
convertToType maybeModelName Definition{..} = case (ref, typ, properties) of
-- If we point to a ref we just reference it via Import
(Just r, _, _) -> Dhall.Embed $ mkImport [] $ (pathFromRef r <> ".dhall")
(Just r, _, _) -> Dhall.Embed $ mkImport prefixMap [] (pathFromRef r <> ".dhall")
-- Otherwise - if we have 'properties' - it's an object
(_, _, Just props) ->
let (required', optional')
@ -169,12 +176,13 @@ toTypes definitions = memo
-- | Convert a Dhall Type to its default value
toDefault
:: Data.Map.Map ModelName Definition -- ^ All the Swagger definitions
:: PrefixMap -- ^ Mapping of prefixes to import roots
-> Data.Map.Map ModelName Definition -- ^ All the Swagger definitions
-> Data.Map.Map ModelName Expr -- ^ All the Dhall types generated from them
-> ModelName -- ^ The name of the object we're converting
-> Expr -- ^ The Dhall type of the object
-> Maybe Expr
toDefault definitions types modelName = go
toDefault prefixMap definitions types modelName = go
where
go = \case
-- If we have an import, we also import in the default
@ -228,24 +236,25 @@ toDefault definitions types modelName = go
-- but if we want to refer them from the defaults we need to adjust the path
adjustImport :: Expr -> Expr
adjustImport (Dhall.Embed imp) | Just file <- namespacedObjectFromImport imp
= Dhall.Embed $ mkImport ["types", ".."] (file <> ".dhall")
= Dhall.Embed $ mkImport prefixMap ["types", ".."] (file <> ".dhall")
adjustImport other = other
-- | Get a Dhall.Map filled with imports, for creating giant Records or Unions of types or defaults
getImportsMap
:: DuplicateHandler -- ^ Duplicate name handler
:: PrefixMap -- ^ Mapping of prefixes to import roots
-> DuplicateHandler -- ^ Duplicate name handler
-> [ModelName] -- ^ A list of all the object names
-> Text -- ^ The folder we should get imports from
-> [ModelName] -- ^ List of the object names we want to include in the Map
-> Dhall.Map.Map Text Expr
getImportsMap duplicateNameHandler objectNames folder toInclude
getImportsMap prefixMap duplicateNameHandler objectNames folder toInclude
= Dhall.Map.fromList
$ Data.Map.elems
-- This intersection is here to "pick" common elements between "all the objects"
-- and "objects we want to include", already associating keys to their import
$ Data.Map.intersectionWithKey
(\(ModelName name) key _ -> (key, Dhall.Embed $ mkImport [folder] (name <> ".dhall")))
(\(ModelName name) key _ -> (key, Dhall.Embed $ mkImport prefixMap [folder] (name <> ".dhall")))
namespacedToSimple
(Data.Map.fromList $ fmap (,()) toInclude)
where

2
dhall-kubernetes-generator/src/Dhall/Kubernetes/Types.hs
View File

@ -19,6 +19,8 @@ type Expr = Dhall.Expr Dhall.Src Dhall.Import
type DuplicateHandler = (Text, [ModelName]) -> Maybe ModelName
type PrefixMap = Data.Map.Map Text Dhall.Import
{-| Type for the Swagger specification.
There is such a type defined in the `swagger2` package, but Kubernetes' OpenAPI

56
dhall-kubernetes-generator/src/Main.hs
View File

@ -12,20 +12,23 @@ import qualified Dhall.Pretty
import qualified Turtle
import Data.Aeson (decodeFileStrict)
import Data.Bifunctor (bimap)
import Data.Foldable (for_)
import Data.Text (Text)
import System.Environment (getArgs)
import Options.Applicative (Parser, ParserInfo)
import Data.Text (Text, pack)
import qualified Options.Applicative
import Text.Megaparsec (some, optional, parse, (<|>), errorBundlePretty)
import Text.Megaparsec.Char (char, alphaNumChar)
import qualified Dhall.Kubernetes.Convert as Convert
import Dhall.Kubernetes.Data (patchCyclicImports)
import qualified Dhall.Parser
import Dhall.Kubernetes.Types
-- | Top-level program options
data Options = Options
{ skipDuplicates :: Bool
, prefixMap :: PrefixMap
, filename :: String
}
@ -55,21 +58,45 @@ errorOnDuplicateHandler (kind, names) = error $ "Got more than one key for "++ s
skipDuplicatesHandler :: DuplicateHandler
skipDuplicatesHandler = const Nothing
parseOptions :: Parser Options
parseOptions = Options <$> parseSkip <*> fileArg
parseImport :: String -> Expr -> Dhall.Parser.Parser Dhall.Import
parseImport _ (Dhall.Note _ (Dhall.Embed l)) = pure l
parseImport prefix e = fail $ "Expected a Dhall import for " <> prefix <> " not:\n" <> show e
parsePrefixMap :: Options.Applicative.ReadM PrefixMap
parsePrefixMap =
Options.Applicative.eitherReader $ \s ->
bimap errorBundlePretty Data.Map.fromList $ result (pack s)
where
parser = do
prefix <- some (alphaNumChar <|> char '.')
char '='
e <- Dhall.Parser.expr
imp <- parseImport prefix e
optional $ char ','
return (pack prefix, imp)
result = parse (some (Dhall.Parser.unParser parser)) "MAPPING"
parseOptions :: Options.Applicative.Parser Options
parseOptions = Options <$> parseSkip <*> parsePrefixMap' <*> fileArg
where
parseSkip =
Options.Applicative.switch
( Options.Applicative.long "skipDuplicates"
<> Options.Applicative.help "Skip types with the same name when aggregating types"
)
parsePrefixMap' =
Options.Applicative.option parsePrefixMap
( Options.Applicative.long "prefixMap"
<> Options.Applicative.help "Specify prefix mappings as 'prefix1=importBase1,prefix2=importBase2,...'"
<> Options.Applicative.metavar "MAPPING"
)
fileArg = Options.Applicative.strArgument
( Options.Applicative.help "The swagger file to read"
<> Options.Applicative.metavar "FILE"
)
-- | `ParserInfo` for the `Options` type
parserInfoOptions :: ParserInfo Options
parserInfoOptions :: Options.Applicative.ParserInfo Options
parserInfoOptions =
Options.Applicative.info
(Options.Applicative.helper <*> parseOptions)
@ -89,7 +116,7 @@ main = do
Just s -> pure s
-- Convert to Dhall types in a Map
let types = Convert.toTypes
let types = Convert.toTypes (prefixMap options)
-- TODO: find a better way to deal with this cyclic import
$ Data.Map.adjust patchCyclicImports
(ModelName "io.k8s.apiextensions-apiserver.pkg.apis.apiextensions.v1beta1.JSONSchemaProps")
@ -102,7 +129,7 @@ main = do
writeDhall path expr
-- Convert from Dhall types to defaults
let defaults = Data.Map.mapMaybeWithKey (Convert.toDefault definitions types) types
let defaults = Data.Map.mapMaybeWithKey (Convert.toDefault (prefixMap options) definitions types) types
-- Output to defaults
Turtle.mktree "defaults"
@ -112,8 +139,8 @@ main = do
let toSchema (ModelName key) _ _ =
Dhall.RecordLit
[ ("Type", Dhall.Embed (Convert.mkImport ["types", ".."] (key <> ".dhall")))
, ("default", Dhall.Embed (Convert.mkImport ["defaults", ".."] (key <> ".dhall")))
[ ("Type", Dhall.Embed (Convert.mkImport (prefixMap options) ["types", ".."] (key <> ".dhall")))
, ("default", Dhall.Embed (Convert.mkImport (prefixMap options) ["defaults", ".."] (key <> ".dhall")))
]
let schemas = Data.Map.intersectionWithKey toSchema types defaults
@ -125,10 +152,11 @@ main = do
writeDhall path expr
-- Output the types record, the defaults record, and the giant union type
let objectNames = Data.Map.keys types
typesMap = Convert.getImportsMap duplicateHandler objectNames "types" $ Data.Map.keys types
defaultsMap = Convert.getImportsMap duplicateHandler objectNames "defaults" $ Data.Map.keys defaults
schemasMap = Convert.getImportsMap duplicateHandler objectNames "schemas" $ Data.Map.keys schemas
let getImportsMap = Convert.getImportsMap (prefixMap options) duplicateHandler objectNames
objectNames = Data.Map.keys types
typesMap = getImportsMap "types" $ Data.Map.keys types
defaultsMap = getImportsMap "defaults" $ Data.Map.keys defaults
schemasMap = getImportsMap "schemas" $ Data.Map.keys schemas
typesRecordPath = "./types.dhall"
typesUnionPath = "./typesUnion.dhall"