From 355bbbf8ff71d38a3cdf082821626e9059667c9b Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 10 Oct 2019 17:19:02 +0100 Subject: [PATCH] WIP: need to respect `--omittable-lists` [#1410] --- dhall-json/src/Dhall/JSONToDhall.hs | 31 +++++++++++++------ dhall-json/tasty/Main.hs | 11 +++++-- dhall-json/tasty/data/missingList.dhall | 1 + dhall-json/tasty/data/missingList.json | 1 + dhall-json/tasty/data/missingListSchema.dhall | 1 + dhall-json/test.yml | 0 6 files changed, 33 insertions(+), 12 deletions(-) create mode 100644 dhall-json/tasty/data/missingList.dhall create mode 100644 dhall-json/tasty/data/missingList.json create mode 100644 dhall-json/tasty/data/missingListSchema.dhall create mode 100644 dhall-json/test.yml diff --git a/dhall-json/src/Dhall/JSONToDhall.hs b/dhall-json/src/Dhall/JSONToDhall.hs index 1d58e70744..c962a98667 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 + <*> parseOmittableLists 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" ) + parseOmittableLists = O.switch + ( O.long "omittable-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 + , ommitableLists :: 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 + , ommitableLists = False } -- | The 'Expr' type concretization used throughout this module @@ -416,6 +423,8 @@ dhallFromJSON (Conversion {..}) expressionType = = loop t value | App D.Optional t' <- t = Right (App D.None t') + | App D.List t' <- t + = Right (D.ListLit (Just $ D.App D.List t') []) | otherwise = Left (MissingKey k t v) in D.RecordLit <$> Map.traverseWithKey f r @@ -470,6 +479,10 @@ dhallFromJSON (Conversion {..}) expressionType = (Seq.fromList es) in f <$> traverse (loop t) (toList a) + -- null ~> List + loop (App D.List t) (A.Null) + = Right (D.ListLit (Just $ D.App D.List t) []) + -- 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 fc35998afb..7e1ac93045 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 undefined "./tasty/data/missingList" , Test.Tasty.testGroup "Nesting" [ testDhallToJSON "./tasty/data/nesting0" , testDhallToJSON "./tasty/data/nesting1" @@ -92,8 +93,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 :: Conversion -> String -> TestTree +testCustomConversionJSONToDhall conversion prefix = + Test.Tasty.HUnit.testCase prefix $ do let inputFile = prefix <> ".json" let schemaFile = prefix <> "Schema.dhall" let outputFile = prefix <> ".dhall" @@ -114,7 +116,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 conversion schema value) outputText <- Data.Text.IO.readFile outputFile @@ -132,6 +134,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 0000000000..f92aef588f --- /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 0000000000..e34a87264a --- /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 0000000000..a41427104e --- /dev/null +++ b/dhall-json/tasty/data/missingListSchema.dhall @@ -0,0 +1 @@ +{present : List Text, null : List Text, missing : List Text} diff --git a/dhall-json/test.yml b/dhall-json/test.yml new file mode 100644 index 0000000000..e69de29bb2