Fix dhall-to-yaml to quote special strings (#1474)

Fixes #1472 This also refactors the code to a form that was easier for me to understand
dhall-lang · Oct 25, 2019 · 8e7586b · 8e7586b
1 parent 90315e9
commit 8e7586b
Show file tree

Hide file tree

Showing 5 changed files with 14 additions and 28 deletions.
diff --git a/dhall-json/src/Dhall/Yaml.hs b/dhall-json/src/Dhall/Yaml.hs
@@ -98,35 +98,16 @@ jsonToYaml json documents quoted =
          $ fmap (Data.ByteString.Lazy.toStrict. (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8). (:[]))
          $ Data.Vector.toList elems
     _ -> Data.ByteString.Lazy.toStrict (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8 [json])
-
   where
-    defaultSchemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
-
-    defaultEncodeStr s = case () of
-      ()
-        | "\n" `Text.isInfixOf` s -> Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
-        | YS.isAmbiguous Y.coreSchemaResolver s -> Right (YE.untagged, YE.SingleQuoted, s)
-        | otherwise -> Right (YE.untagged, YE.Plain, s)
-
-    style s = case s of
-      Y.SNull         -> Right (YE.untagged, YE.Plain, "null")
-      Y.SBool  bool   -> Right (YE.untagged, YE.Plain, YS.encodeBool bool)
-      Y.SFloat double -> Right (YE.untagged, YE.Plain, YS.encodeDouble double)
-      Y.SInt   int    -> Right (YE.untagged, YE.Plain, YS.encodeInt int)
-      Y.SStr   text   -> defaultEncodeStr text
-      Y.SUnknown t v  -> Right (t, YE.SingleQuoted, v)
+    style (Y.SStr s)
+        | "\n" `Text.isInfixOf` s =
+            Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
+        | quoted =
+            Right (YE.untagged, YE.SingleQuoted, s)
+    style s =
+        YS.schemaEncoderScalar Y.coreSchemaEncoder s
 
-    customStyle (Y.SStr s) = case () of
-        ()
-            | "\n" `Text.isInfixOf` s -> Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
-            | otherwise -> Right (YE.untagged, YE.SingleQuoted, s)
-    customStyle scalar =  (YS.schemaEncoderScalar defaultSchemaEncoder) scalar
-
-    customSchemaEncoder = YS.setScalarStyle customStyle defaultSchemaEncoder
-
-    schemaEncoder = if quoted 
-        then customSchemaEncoder 
-        else defaultSchemaEncoder
+    schemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
 #else
   Data.ByteString.Lazy.toStrict $ case (documents, json) of
     (True, Data.Aeson.Array elems)

diff --git a/dhall-json/tasty/Main.hs b/dhall-json/tasty/Main.hs
@@ -36,6 +36,9 @@ testTree =
         , testDhallToYaml
             Dhall.Yaml.defaultOptions
             "./tasty/data/normal"
+        , testDhallToYaml
+            Dhall.Yaml.defaultOptions
+            "./tasty/data/special"
         , testDhallToYaml
             (Dhall.Yaml.defaultOptions { Dhall.Yaml.quoted = True })
             "./tasty/data/quoted"

diff --git a/dhall-json/tasty/data/normal.yaml b/dhall-json/tasty/data/normal.yaml
@@ -1,6 +1,6 @@
 bool_value: true
 int_value: 1
-string_value: 2000-01-01
+string_value: "2000-01-01"
 text: |
   Plain text
 yes: y
diff --git a/dhall-json/tasty/data/special.dhall b/dhall-json/tasty/data/special.dhall
@@ -0,0 +1 @@
+{ foo = "*" }
diff --git a/dhall-json/tasty/data/special.yaml b/dhall-json/tasty/data/special.yaml
@@ -0,0 +1 @@
+foo: "*"