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.
This commit is contained in:
Dmitrii Skurikhin 2020-03-29 16:56:07 +03:00 committed by Eugen Wissner
parent 30d6a0a58d
commit 2760bd8ee1
4 changed files with 136 additions and 28 deletions

View File

@ -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.

View File

@ -54,4 +54,5 @@ tests:
- hspec
- hspec-expectations
- hspec-megaparsec
- QuickCheck
- raw-strings-qq

View File

@ -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'

View File

@ -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" $