Fix {json,yaml}-to-dhall marshaling into empty lists (#1284)

This is essentially the same fix as #1186, applied in more places
dhall-lang · Sep 6, 2019 · eee7524 · eee7524
1 parent 71bb569
commit eee7524
Show file tree

Hide file tree

Showing 11 changed files with 47 additions and 3 deletions.
diff --git a/dhall-json/src/Dhall/JSONToDhall.hs b/dhall-json/src/Dhall/JSONToDhall.hs
@@ -455,7 +455,7 @@ dhallFromJSON (Conversion {..}) expressionType =
 
           let records = (fmap f . Seq.fromList . HM.toList) keyExprMap
 
-          let typeAnn = if HM.null o then Just mapValue else Nothing
+          let typeAnn = if HM.null o then Just t else Nothing
 
           return (D.ListLit typeAnn records)
         | noKeyValMap
@@ -467,7 +467,7 @@ dhallFromJSON (Conversion {..}) expressionType =
     loop (App D.List t) (A.Array a)
         = let f :: [ExprX] -> ExprX
               f es = D.ListLit
-                       (if null es then Just t else Nothing)
+                       (if null es then Just (App D.List t) else Nothing)
                        (Seq.fromList es)
            in f <$> traverse (loop t) (toList a)
 
@@ -545,7 +545,7 @@ dhallFromJSON (Conversion {..}) expressionType =
                   let elements = Seq.fromList (fmap outer (Vector.toList a))
 
                       elementType
-                          | null elements = Just "JSON"
+                          | null elements = Just (D.App D.List "JSON")
                           | otherwise     = Nothing
 
                   in  D.App (D.Field "json" "array") (D.ListLit elementType elements)

diff --git a/dhall-json/tasty/Main.hs b/dhall-json/tasty/Main.hs
@@ -41,6 +41,9 @@ testTree =
             "./tasty/data/quoted"
         , testJSONToDhall "./tasty/data/emptyAlternative"
         , testJSONToDhall "./tasty/data/emptyObject"
+        , testJSONToDhall "./tasty/data/emptyList"
+        , testJSONToDhall "./tasty/data/emptyObjectStrongType"
+        , testJSONToDhall "./tasty/data/emptyListStrongType"
         , Test.Tasty.testGroup "Nesting"
             [ testDhallToJSON "./tasty/data/nesting0"
             , testDhallToJSON "./tasty/data/nesting1"

diff --git a/dhall-json/tasty/data/emptyList.dhall b/dhall-json/tasty/data/emptyList.dhall
@@ -0,0 +1,17 @@
+  λ(JSON : Type)
+→ λ ( json
+    : { array :
+          List JSON → JSON
+      , bool :
+          Bool → JSON
+      , null :
+          JSON
+      , number :
+          Double → JSON
+      , object :
+          List { mapKey : Text, mapValue : JSON } → JSON
+      , string :
+          Text → JSON
+      }
+    )
+→ json.array ([] : List JSON)
diff --git a/dhall-json/tasty/data/emptyList.json b/dhall-json/tasty/data/emptyList.json
@@ -0,0 +1 @@
+[]
diff --git a/dhall-json/tasty/data/emptyListSchema.dhall b/dhall-json/tasty/data/emptyListSchema.dhall
@@ -0,0 +1,17 @@
+  ∀(JSON : Type)
+→ ∀ ( json
+    : { array :
+          List JSON → JSON
+      , bool :
+          Bool → JSON
+      , null :
+          JSON
+      , number :
+          Double → JSON
+      , object :
+          List { mapKey : Text, mapValue : JSON } → JSON
+      , string :
+          Text → JSON
+      }
+    )
+→ JSON
diff --git a/dhall-json/tasty/data/emptyListStrongType.dhall b/dhall-json/tasty/data/emptyListStrongType.dhall
@@ -0,0 +1 @@
+[] : List Natural
diff --git a/dhall-json/tasty/data/emptyListStrongType.json b/dhall-json/tasty/data/emptyListStrongType.json
@@ -0,0 +1 @@
+[]
diff --git a/dhall-json/tasty/data/emptyListStrongTypeSchema.dhall b/dhall-json/tasty/data/emptyListStrongTypeSchema.dhall
@@ -0,0 +1 @@
+List Natural
diff --git a/dhall-json/tasty/data/emptyObjectStrongType.dhall b/dhall-json/tasty/data/emptyObjectStrongType.dhall
@@ -0,0 +1 @@
+[] : List { mapKey : Text, mapValue : Natural }
diff --git a/dhall-json/tasty/data/emptyObjectStrongType.json b/dhall-json/tasty/data/emptyObjectStrongType.json
@@ -0,0 +1 @@
+{}
diff --git a/dhall-json/tasty/data/emptyObjectStrongTypeSchema.dhall b/dhall-json/tasty/data/emptyObjectStrongTypeSchema.dhall
@@ -0,0 +1 @@
+List { mapKey : Text, mapValue : Natural }