From 309949f929d164837a1963f3f9ca4791158d8872 Mon Sep 17 00:00:00 2001
From: Gabriel Gonzalez <Gabriel439@gmail.com>
Date: Thu, 24 Oct 2019 20:17:02 -0700
Subject: [PATCH 1/2] Fix `dhall-to-yaml` to quote special strings

Fixes https://github.com/dhall-lang/dhall-haskell/issues/1472

This also refactors the code to a form that was easier for me to understand
---
 dhall-json/src/Dhall/Yaml.hs        | 41 +++++++++++------------------
 dhall-json/tasty/Main.hs            |  3 +++
 dhall-json/tasty/data/normal.yaml   |  2 +-
 dhall-json/tasty/data/special.dhall |  1 +
 dhall-json/tasty/data/special.yaml  |  1 +
 5 files changed, 21 insertions(+), 27 deletions(-)
 create mode 100644 dhall-json/tasty/data/special.dhall
 create mode 100644 dhall-json/tasty/data/special.yaml

diff --git a/dhall-json/src/Dhall/Yaml.hs b/dhall-json/src/Dhall/Yaml.hs
index 25f682057..2590851b8 100644
--- a/dhall-json/src/Dhall/Yaml.hs
+++ b/dhall-json/src/Dhall/Yaml.hs
@@ -98,35 +98,24 @@ 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)
+    unquotedStyle (Y.SStr s)
+        | "\n" `Text.isInfixOf` s =
+            Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
+    unquotedStyle 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
+    quotedStyle (Y.SStr s)
+        | "\n" `Text.isInfixOf` s =
+            Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
+        | otherwise =
+            Right (YE.untagged, YE.SingleQuoted, s)
+    quotedStyle s =
+        YS.schemaEncoderScalar Y.coreSchemaEncoder s
     
-    customSchemaEncoder = YS.setScalarStyle customStyle defaultSchemaEncoder
-    
-    schemaEncoder = if quoted 
-        then customSchemaEncoder 
-        else defaultSchemaEncoder
+    style = if quoted then quotedStyle else unquotedStyle
+
+    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
index 69e773bb2..cd8ebc702 100644
--- 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
index 95e25952d..909823e1e 100644
--- 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
new file mode 100644
index 000000000..704a91b80
--- /dev/null
+++ 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
new file mode 100644
index 000000000..d624c3b4c
--- /dev/null
+++ b/dhall-json/tasty/data/special.yaml
@@ -0,0 +1 @@
+foo: "*"

From 57c0f333d6a031abb254d3d046e4330011de2b1a Mon Sep 17 00:00:00 2001
From: Gabriel Gonzalez <Gabriel439@gmail.com>
Date: Thu, 24 Oct 2019 20:36:09 -0700
Subject: [PATCH 2/2] Simplify things further

---
 dhall-json/src/Dhall/Yaml.hs | 14 +++-----------
 1 file changed, 3 insertions(+), 11 deletions(-)

diff --git a/dhall-json/src/Dhall/Yaml.hs b/dhall-json/src/Dhall/Yaml.hs
index 2590851b8..6228be28c 100644
--- a/dhall-json/src/Dhall/Yaml.hs
+++ b/dhall-json/src/Dhall/Yaml.hs
@@ -99,21 +99,13 @@ jsonToYaml json documents quoted =
          $ Data.Vector.toList elems
     _ -> Data.ByteString.Lazy.toStrict (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8 [json])
   where
-    unquotedStyle (Y.SStr s)
+    style (Y.SStr s)
         | "\n" `Text.isInfixOf` s =
             Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
-    unquotedStyle s =
-        YS.schemaEncoderScalar Y.coreSchemaEncoder s
-
-    quotedStyle (Y.SStr s)
-        | "\n" `Text.isInfixOf` s =
-            Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
-        | otherwise =
+        | quoted =
             Right (YE.untagged, YE.SingleQuoted, s)
-    quotedStyle s =
+    style s =
         YS.schemaEncoderScalar Y.coreSchemaEncoder s
-    
-    style = if quoted then quotedStyle else unquotedStyle
 
     schemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
 #else