parent
4b8b8cd730
commit
194654c10c
|
@ -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
|
||||
|
@ -307,6 +312,7 @@ data Conversion = Conversion
|
|||
, noKeyValArr :: Bool
|
||||
, noKeyValMap :: Bool
|
||||
, unions :: UnionConv
|
||||
, omissibleLists :: Bool
|
||||
} deriving Show
|
||||
|
||||
data UnionConv = UFirst | UNone | UStrict deriving (Show, Read, Eq)
|
||||
|
@ -318,6 +324,7 @@ defaultConversion = Conversion
|
|||
, 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
|
||||
|
|
|
@ -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"
|
||||
|
|
1
dhall-json/tasty/data/missingList.dhall
Normal file
1
dhall-json/tasty/data/missingList.dhall
Normal file
|
@ -0,0 +1 @@
|
|||
{present = ["some-stuff"], null = [] : List Text, missing = [] : List Text}
|
1
dhall-json/tasty/data/missingList.json
Normal file
1
dhall-json/tasty/data/missingList.json
Normal file
|
@ -0,0 +1 @@
|
|||
{"present": ["some-stuff"], "null": null}
|
1
dhall-json/tasty/data/missingListSchema.dhall
Normal file
1
dhall-json/tasty/data/missingListSchema.dhall
Normal file
|
@ -0,0 +1 @@
|
|||
{present : List Text, null : List Text, missing : List Text}
|
Loading…
Reference in New Issue
Block a user