Don't encode controls as block strings

Fixes #39.

String containing control sequences should be encoded as simple strings
even if they contain newlines, since the block strings can contain only
SourceCharacters.

4 files changed, 136 insertions, 28 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5a250a4..48cbd3c 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,8 @@ and this project adheres to
 ## [Unreleased]
 ### Fixed
 - Result of null encoding
+- Block strings encoding
+- Result of tab and newline encoding
 
 ### Added
 - AST for the GraphQL schema.
diff --git a/package.yaml b/package.yaml
index 13cad6c..a573935 100644
--- a/package.yaml
+++ b/package.yaml
@@ -54,4 +54,5 @@ tests:
     - hspec
     - hspec-expectations
     - hspec-megaparsec
+    - QuickCheck
     - raw-strings-qq
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index f5bfcc3..69f5599 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -53,7 +53,7 @@ document formatter defs
     executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc
     executableDefinition _ acc = acc
 
--- | Converts a 'Full.Definition' into a string.
+-- | Converts a t'Full.ExecutableDefinition' into a string.
 definition :: Formatter -> ExecutableDefinition -> Lazy.Text
 definition formatter x
     | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
@@ -64,6 +64,7 @@ definition formatter x
     encodeDefinition (Full.DefinitionFragment fragment)
         = fragmentDefinition formatter fragment
 
+-- | Converts a 'Full.OperationDefinition into a string.
 operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
 operationDefinition formatter (Full.SelectionSet sels)
     = selectionSet formatter sels
@@ -72,6 +73,7 @@ operationDefinition formatter (Full.OperationDefinition Full.Query name vars dir
 operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
     = "mutation " <> node formatter name vars dirs sels
 
+-- | Converts a Full.Query or Full.Mutation into a string.
 node :: Formatter ->
     Maybe Full.Name ->
     [Full.VariableDefinition] ->
@@ -112,8 +114,11 @@ selectionSet formatter
 selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
 selectionSetOpt formatter = bracesList formatter $ selection formatter
 
+indentSymbol :: Lazy.Text
+indentSymbol = "  "
+
 indent :: (Integral a) => a -> Lazy.Text
-indent indentation = Lazy.Text.replicate (fromIntegral indentation) "  "
+indent indentation = Lazy.Text.replicate (fromIntegral indentation) indentSymbol
 
 selection :: Formatter -> Full.Selection -> Lazy.Text
 selection formatter = Lazy.Text.append indent' . encodeSelection
@@ -134,6 +139,7 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
 colon :: Formatter -> Lazy.Text
 colon formatter = eitherFormat formatter ": " ":"
 
+-- | Converts Full.Field into a string
 field :: Formatter ->
     Maybe Full.Name ->
     Full.Name ->
@@ -215,26 +221,40 @@ booleanValue :: Bool -> Lazy.Text
 booleanValue True  = "true"
 booleanValue False = "false"
 
+quote :: Builder.Builder
+quote = Builder.singleton '\"'
+
+oneLine :: Text -> Builder
+oneLine string = quote <> Text.foldr (mappend . escape) quote string
+
 stringValue :: Formatter -> Text -> Lazy.Text
 stringValue Minified string = Builder.toLazyText
-    $ quote <> Text.foldr (mappend . escape') quote string
-  where
-    quote = Builder.singleton '\"'
-    escape' '\n' = Builder.fromString "\\n"
-    escape' char = escape char
-stringValue (Pretty indentation) string = byStringType $ Text.lines string
-  where
-    byStringType [] = "\"\""
-    byStringType [line] = Builder.toLazyText
-        $ quote <> Text.foldr (mappend . escape) quote line
-    byStringType lines' = "\"\"\"\n"
-        <> Lazy.Text.unlines (transformLine <$> lines')
-        <> indent indentation
-        <> "\"\"\""
-    transformLine = (indent (indentation + 1) <>)
-        . Lazy.Text.fromStrict
-        . Text.replace "\"\"\"" "\\\"\"\""
-    quote = Builder.singleton '\"'
+    $ quote <> Text.foldr (mappend . escape) quote string
+stringValue (Pretty indentation) string =
+  if hasEscaped string
+  then stringValue Minified string
+  else Builder.toLazyText $ encoded lines'
+    where
+      isWhiteSpace char = char == ' ' || char == '\t'
+      isNewline char = char == '\n' || char == '\r'
+      hasEscaped = Text.any (not . isAllowed)
+      isAllowed char =
+          char == '\t' || isNewline char || (char >= '\x0020' && char /= '\x007F')
+
+      tripleQuote = Builder.fromText "\"\"\""
+      start = tripleQuote <> Builder.singleton '\n'
+      end = Builder.fromLazyText (indent indentation) <> tripleQuote
+
+      strip = Text.dropWhile isWhiteSpace . Text.dropWhileEnd isWhiteSpace
+      lines' = map Builder.fromText $ Text.split isNewline (Text.replace "\r\n" "\n" $ strip string)
+      encoded [] = oneLine string
+      encoded [_] = oneLine string
+      encoded lines'' = start <> transformLines lines'' <> end
+      transformLines = foldr ((\line acc -> line <> Builder.singleton '\n' <> acc) . transformLine) mempty
+      transformLine line =
+        if Lazy.Text.null (Builder.toLazyText line)
+        then line
+        else Builder.fromLazyText (indent (indentation + 1)) <> line
 
 escape :: Char -> Builder
 escape char'
@@ -242,7 +262,9 @@ escape char'
     | char' == '\"' = Builder.fromString "\\\""
     | char' == '\b' = Builder.fromString "\\b"
     | char' == '\f' = Builder.fromString "\\f"
+    | char' == '\n' = Builder.fromString "\\n"
     | char' == '\r' = Builder.fromString "\\r"
+    | char' == '\t' = Builder.fromString "\\t"
     | char' < '\x0010' = unicode  "\\u000" char'
     | char' < '\x0020' = unicode "\\u00" char'
     | otherwise = Builder.singleton char'
diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs
index 6aa8192..71ee948 100644
--- a/tests/Language/GraphQL/AST/EncoderSpec.hs
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@@ -6,8 +6,10 @@ module Language.GraphQL.AST.EncoderSpec
 
 import Language.GraphQL.AST
 import Language.GraphQL.AST.Encoder
-import Test.Hspec (Spec, context, describe, it, shouldBe)
+import Test.Hspec (Spec, context, describe, it, shouldBe, shouldStartWith, shouldEndWith, shouldNotContain)
+import Test.QuickCheck (choose, oneof, forAll)
 import Text.RawString.QQ (r)
+import Data.Text.Lazy (cons, toStrict, unpack)
 
 spec :: Spec
 spec = do
@@ -20,21 +22,102 @@ spec = do
         context "minified" $ do
             it "escapes \\" $
                 value minified (String "\\") `shouldBe` "\"\\\\\""
-            it "escapes quotes" $
+            it "escapes double quotes" $
                 value minified (String "\"") `shouldBe` "\"\\\"\""
+            it "escapes \\f" $
+                value minified (String "\f") `shouldBe` "\"\\f\""
+            it "escapes \\n" $
+                value minified (String "\n") `shouldBe` "\"\\n\""
+            it "escapes \\r" $
+                value minified (String "\r") `shouldBe` "\"\\r\""
+            it "escapes \\t" $
+                value minified (String "\t") `shouldBe` "\"\\t\""
             it "escapes backspace" $
                 value minified (String "a\bc") `shouldBe` "\"a\\bc\""
-            it "escapes Unicode" $
-                value minified (String "\0") `shouldBe` "\"\\u0000\""
+            context "escapes Unicode for chars less than 0010" $ do
+                it "Null" $ value minified (String "\x0000") `shouldBe` "\"\\u0000\""
+                it "bell" $ value minified (String "\x0007") `shouldBe` "\"\\u0007\""
+            context "escapes Unicode for char less than 0020" $ do
+                it "DLE" $ value minified (String "\x0010") `shouldBe` "\"\\u0010\""
+                it "EM" $ value minified (String "\x0019") `shouldBe` "\"\\u0019\""
+            context "encodes without escape" $ do
+                it "space" $ value minified (String "\x0020") `shouldBe` "\" \""
+                it "~" $ value minified (String "\x007E") `shouldBe` "\"~\""
 
         context "pretty" $ do
             it "uses strings for short string values" $
                 value pretty (String "Short text") `shouldBe` "\"Short text\""
-            it "uses block strings for text with new lines" $
+            it "uses block strings for text with new lines, with newline symbol" $
                 value pretty (String "Line 1\nLine 2")
-                    `shouldBe` "\"\"\"\n  Line 1\n  Line 2\n\"\"\""
-            it "escapes \\ in short strings" $
-                value pretty (String "\\") `shouldBe` "\"\\\\\""
+                    `shouldBe` [r|"""
+  Line 1
+  Line 2
+"""|]
+            it "uses block strings for text with new lines, with CR symbol" $
+                value pretty (String "Line 1\rLine 2")
+                    `shouldBe` [r|"""
+  Line 1
+  Line 2
+"""|]
+            it "uses block strings for text with new lines, with CR symbol followed by newline" $
+                value pretty (String "Line 1\r\nLine 2")
+                    `shouldBe` [r|"""
+  Line 1
+  Line 2
+"""|]
+            it "encodes as one line string if has escaped symbols" $ do
+                let
+                  genNotAllowedSymbol = oneof
+                    [ choose ('\x0000', '\x0008')
+                    , choose ('\x000B', '\x000C')
+                    , choose ('\x000E', '\x001F')
+                    , pure '\x007F'
+                    ]
+
+                forAll genNotAllowedSymbol $ \x -> do
+                    let
+                      rawValue = "Short \n" <> cons x "text"
+                      encoded = value pretty (String $ toStrict rawValue)
+                    shouldStartWith (unpack encoded) "\""
+                    shouldEndWith (unpack encoded) "\""
+                    shouldNotContain (unpack encoded) "\"\"\""
+
+            it "Hello world" $ value pretty (String "Hello,\n  World!\n\nYours,\n  GraphQL.")
+              `shouldBe` [r|"""
+  Hello,
+    World!
+
+  Yours,
+    GraphQL.
+"""|]
+
+            it "has only newlines" $ value pretty (String "\n") `shouldBe` [r|"""
+
+
+"""|]
+            it "has newlines and one symbol at the begining" $
+              value pretty (String "a\n\n") `shouldBe` [r|"""
+  a
+
+
+"""|]
+            it "has newlines and one symbol at the end" $
+              value pretty (String "\n\na") `shouldBe` [r|"""
+
+
+  a
+"""|]
+            it "has newlines and one symbol in the middle" $
+              value pretty (String "\na\n") `shouldBe` [r|"""
+
+  a
+
+"""|]
+            it "skip trailing whitespaces" $ value pretty (String "  Short\ntext    ")
+              `shouldBe` [r|"""
+  Short
+  text
+"""|]
 
     describe "definition" $
         it "indents block strings in arguments" $