diff --git a/dhall-json/src/Dhall/JSONToDhall.hs b/dhall-json/src/Dhall/JSONToDhall.hs index 1d58e7074..02f7d380b 100644 --- a/dhall-json/src/Dhall/JSONToDhall.hs +++ b/dhall-json/src/Dhall/JSONToDhall.hs @@ -255,6 +255,7 @@ parseConversion = Conversion <$> parseStrict <*> parseKVArr <*> parseKVMap <*> parseUnion + <*> parseOmissibleLists where parseStrict = O.flag' True @@ -275,6 +276,10 @@ parseConversion = Conversion <$> parseStrict ( O.long "no-keyval-maps" <> O.help "Disable conversion of homogeneous map objects to association lists" ) + parseOmissibleLists = O.switch + ( O.long "omissible-lists" + <> O.help "Tolerate missing list values, they are assumed empty" + ) -- | Parser for command options related to treating union types parseUnion :: Parser UnionConv @@ -303,21 +308,23 @@ parseUnion = -- | JSON-to-dhall translation options data Conversion = Conversion - { strictRecs :: Bool - , noKeyValArr :: Bool - , noKeyValMap :: Bool - , unions :: UnionConv + { strictRecs :: Bool + , noKeyValArr :: Bool + , noKeyValMap :: Bool + , unions :: UnionConv + , omissibleLists :: Bool } deriving Show data UnionConv = UFirst | UNone | UStrict deriving (Show, Read, Eq) -- | Default conversion options defaultConversion :: Conversion -defaultConversion = Conversion - { strictRecs = False - , noKeyValArr = False - , noKeyValMap = False - , unions = UFirst +defaultConversion = Conversion + { strictRecs = False + , noKeyValArr = False + , noKeyValMap = False + , unions = UFirst + , omissibleLists = False } -- | The 'Expr' type concretization used throughout this module @@ -416,6 +423,9 @@ dhallFromJSON (Conversion {..}) expressionType = = loop t value | App D.Optional t' <- t = Right (App D.None t') + | App D.List _ <- t + , omissibleLists + = Right (D.ListLit (Just t) []) | otherwise = Left (MissingKey k t v) in D.RecordLit <$> Map.traverseWithKey f r @@ -470,6 +480,12 @@ dhallFromJSON (Conversion {..}) expressionType = (Seq.fromList es) in f <$> traverse (loop t) (toList a) + -- null ~> List + loop t@(App D.List _) (A.Null) + = if omissibleLists + then Right (D.ListLit (Just t) []) + else Left (Mismatch t A.Null) + -- number ~> Integer loop D.Integer (A.Number x) | Right n <- floatingOrInteger x :: Either Double Integer diff --git a/dhall-json/tasty/Main.hs b/dhall-json/tasty/Main.hs index fc35998af..69e773bb2 100644 --- a/dhall-json/tasty/Main.hs +++ b/dhall-json/tasty/Main.hs @@ -44,6 +44,7 @@ testTree = , testJSONToDhall "./tasty/data/emptyList" , testJSONToDhall "./tasty/data/emptyObjectStrongType" , testJSONToDhall "./tasty/data/emptyListStrongType" + , testCustomConversionJSONToDhall omissibleLists "./tasty/data/missingList" , Test.Tasty.testGroup "Nesting" [ testDhallToJSON "./tasty/data/nesting0" , testDhallToJSON "./tasty/data/nesting1" @@ -57,6 +58,7 @@ testTree = , testDhallToJSON "./tasty/data/unionKeys" ] ] + where omissibleLists = JSONToDhall.defaultConversion{JSONToDhall.omissibleLists = True} testDhallToJSON :: String -> TestTree testDhallToJSON prefix = Test.Tasty.HUnit.testCase prefix $ do @@ -92,8 +94,9 @@ testDhallToJSON prefix = Test.Tasty.HUnit.testCase prefix $ do Test.Tasty.HUnit.assertEqual message expectedValue actualValue -testJSONToDhall :: String -> TestTree -testJSONToDhall prefix = Test.Tasty.HUnit.testCase prefix $ do +testCustomConversionJSONToDhall :: JSONToDhall.Conversion -> String -> TestTree +testCustomConversionJSONToDhall conv prefix = + Test.Tasty.HUnit.testCase prefix $ do let inputFile = prefix <> ".json" let schemaFile = prefix <> "Schema.dhall" let outputFile = prefix <> ".dhall" @@ -114,7 +117,7 @@ testJSONToDhall prefix = Test.Tasty.HUnit.testCase prefix $ do _ <- Core.throws (Dhall.TypeCheck.typeOf schema) actualExpression <- do - Core.throws (JSONToDhall.dhallFromJSON JSONToDhall.defaultConversion schema value) + Core.throws (JSONToDhall.dhallFromJSON conv schema value) outputText <- Data.Text.IO.readFile outputFile @@ -132,6 +135,9 @@ testJSONToDhall prefix = Test.Tasty.HUnit.testCase prefix $ do Test.Tasty.HUnit.assertEqual message expectedExpression actualExpression +testJSONToDhall :: String -> TestTree +testJSONToDhall = testCustomConversionJSONToDhall JSONToDhall.defaultConversion + testDhallToYaml :: Dhall.Yaml.Options -> String -> TestTree testDhallToYaml options prefix = Test.Tasty.HUnit.testCase prefix $ do let inputFile = prefix <> ".dhall" diff --git a/dhall-json/tasty/data/missingList.dhall b/dhall-json/tasty/data/missingList.dhall new file mode 100644 index 000000000..f92aef588 --- /dev/null +++ b/dhall-json/tasty/data/missingList.dhall @@ -0,0 +1 @@ +{present = ["some-stuff"], null = [] : List Text, missing = [] : List Text} diff --git a/dhall-json/tasty/data/missingList.json b/dhall-json/tasty/data/missingList.json new file mode 100644 index 000000000..e34a87264 --- /dev/null +++ b/dhall-json/tasty/data/missingList.json @@ -0,0 +1 @@ +{"present": ["some-stuff"], "null": null} diff --git a/dhall-json/tasty/data/missingListSchema.dhall b/dhall-json/tasty/data/missingListSchema.dhall new file mode 100644 index 000000000..a41427104 --- /dev/null +++ b/dhall-json/tasty/data/missingListSchema.dhall @@ -0,0 +1 @@ +{present : List Text, null : List Text, missing : List Text}