OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Encode Unicode. Fix #34

Browse Source
This commit is contained in:
Eugen Wissner 2019-12-20 07:58:09 +01:00
parent 9a5d54c035
commit 1e55f17e7e
2 changed files with 93 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

176
src/Language/GraphQL/AST/Encoder.hs
View File

@ -13,14 +13,16 @@ module Language.GraphQL.AST.Encoder
, value , value
) where ) where
import Data.Char (ord)
import Data.Foldable (fold) import Data.Foldable (fold)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import qualified Data.List.NonEmpty as NonEmpty (toList) import qualified Data.List.NonEmpty as NonEmpty
import Data.Text.Lazy (Text) import Data.Text (Text)
import qualified Data.Text.Lazy as Text.Lazy import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy (Text)
import qualified Data.Text.Lazy as Lazy.Text
import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder as Builder
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat) import Data.Text.Lazy.Builder.RealFloat (realFloat)
import qualified Language.GraphQL.AST as Full import qualified Language.GraphQL.AST as Full
@ -41,17 +43,17 @@ minified :: Formatter
minified = Minified minified = Minified
-- | Converts a 'Full.Document' into a string. -- | Converts a 'Full.Document' into a string.
document :: Formatter -> Full.Document -> Text document :: Formatter -> Full.Document -> Lazy.Text
document formatter defs document formatter defs
| Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument | Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
| Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n' | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
where where
encodeDocument = NonEmpty.toList $ definition formatter <$> defs encodeDocument = NonEmpty.toList $ definition formatter <$> defs
-- | Converts a 'Full.Definition' into a string. -- | Converts a 'Full.Definition' into a string.
definition :: Formatter -> Full.Definition -> Text definition :: Formatter -> Full.Definition -> Lazy.Text
definition formatter x definition formatter x
| Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n' | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x | Minified <- formatter = encodeDefinition x
where where
encodeDefinition (Full.DefinitionOperation operation) encodeDefinition (Full.DefinitionOperation operation)
@ -59,7 +61,7 @@ definition formatter x
encodeDefinition (Full.DefinitionFragment fragment) encodeDefinition (Full.DefinitionFragment fragment)
= fragmentDefinition formatter fragment = fragmentDefinition formatter fragment
operationDefinition :: Formatter -> Full.OperationDefinition -> Text operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
operationDefinition formatter (Full.OperationSelectionSet sels) operationDefinition formatter (Full.OperationSelectionSet sels)
= selectionSet formatter sels = selectionSet formatter sels
operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels) operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
@ -67,48 +69,48 @@ operationDefinition formatter (Full.OperationDefinition Full.Query name vars dir
operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels) operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
= "mutation " <> node formatter name vars dirs sels = "mutation " <> node formatter name vars dirs sels
node :: Formatter node :: Formatter ->
-> Maybe Full.Name Maybe Full.Name ->
-> [Full.VariableDefinition] [Full.VariableDefinition] ->
-> [Full.Directive] [Full.Directive] ->
-> Full.SelectionSet Full.SelectionSet ->
-> Text Lazy.Text
node formatter name vars dirs sels node formatter name vars dirs sels
= Text.Lazy.fromStrict (fold name) = Lazy.Text.fromStrict (fold name)
<> optempty (variableDefinitions formatter) vars <> optempty (variableDefinitions formatter) vars
<> optempty (directives formatter) dirs <> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Text variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
variableDefinitions formatter variableDefinitions formatter
= parensCommas formatter $ variableDefinition formatter = parensCommas formatter $ variableDefinition formatter
variableDefinition :: Formatter -> Full.VariableDefinition -> Text variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
variableDefinition formatter (Full.VariableDefinition var ty dv) variableDefinition formatter (Full.VariableDefinition var ty dv)
= variable var = variable var
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> type' ty <> type' ty
<> maybe mempty (defaultValue formatter) dv <> maybe mempty (defaultValue formatter) dv
defaultValue :: Formatter -> Full.Value -> Text defaultValue :: Formatter -> Full.Value -> Lazy.Text
defaultValue formatter val defaultValue formatter val
= eitherFormat formatter " = " "=" = eitherFormat formatter " = " "="
<> value formatter val <> value formatter val
variable :: Full.Name -> Text variable :: Full.Name -> Lazy.Text
variable var = "$" <> Text.Lazy.fromStrict var variable var = "$" <> Lazy.Text.fromStrict var
selectionSet :: Formatter -> Full.SelectionSet -> Text selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
selectionSet formatter selectionSet formatter
= bracesList formatter (selection formatter) = bracesList formatter (selection formatter)
. NonEmpty.toList . NonEmpty.toList
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Text selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
selectionSetOpt formatter = bracesList formatter $ selection formatter selectionSetOpt formatter = bracesList formatter $ selection formatter
selection :: Formatter -> Full.Selection -> Text selection :: Formatter -> Full.Selection -> Lazy.Text
selection formatter = Text.Lazy.append indent . f selection formatter = Lazy.Text.append indent . f
where where
f (Full.SelectionField x) = field incrementIndent x f (Full.SelectionField x) = field incrementIndent x
f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x
@ -117,13 +119,13 @@ selection formatter = Text.Lazy.append indent . f
| Pretty n <- formatter = Pretty $ n + 1 | Pretty n <- formatter = Pretty $ n + 1
| otherwise = Minified | otherwise = Minified
indent indent
| Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " " | Pretty n <- formatter = Lazy.Text.replicate (fromIntegral $ n + 1) " "
| otherwise = mempty | otherwise = mempty
field :: Formatter -> Full.Field -> Text field :: Formatter -> Full.Field -> Lazy.Text
field formatter (Full.Field alias name args dirs selso) field formatter (Full.Field alias name args dirs selso)
= optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias) = optempty (`Lazy.Text.append` colon) (Lazy.Text.fromStrict $ fold alias)
<> Text.Lazy.fromStrict name <> Lazy.Text.fromStrict name
<> optempty (arguments formatter) args <> optempty (arguments formatter) args
<> optempty (directives formatter) dirs <> optempty (directives formatter) dirs
<> selectionSetOpt' <> selectionSetOpt'
@ -133,33 +135,33 @@ field formatter (Full.Field alias name args dirs selso)
| null selso = mempty | null selso = mempty
| otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
arguments :: Formatter -> [Full.Argument] -> Text arguments :: Formatter -> [Full.Argument] -> Lazy.Text
arguments formatter = parensCommas formatter $ argument formatter arguments formatter = parensCommas formatter $ argument formatter
argument :: Formatter -> Full.Argument -> Text argument :: Formatter -> Full.Argument -> Lazy.Text
argument formatter (Full.Argument name v) argument formatter (Full.Argument name v)
= Text.Lazy.fromStrict name = Lazy.Text.fromStrict name
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> value formatter v <> value formatter v
-- * Fragments -- * Fragments
fragmentSpread :: Formatter -> Full.FragmentSpread -> Text fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread formatter (Full.FragmentSpread name ds) fragmentSpread formatter (Full.FragmentSpread name ds)
= "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds = "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) ds
inlineFragment :: Formatter -> Full.InlineFragment -> Text inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
inlineFragment formatter (Full.InlineFragment tc dirs sels) inlineFragment formatter (Full.InlineFragment tc dirs sels)
= "... on " = "... on "
<> Text.Lazy.fromStrict (fold tc) <> Lazy.Text.fromStrict (fold tc)
<> directives formatter dirs <> directives formatter dirs
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Text fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels) fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
= "fragment " <> Text.Lazy.fromStrict name = "fragment " <> Lazy.Text.fromStrict name
<> " on " <> Text.Lazy.fromStrict tc <> " on " <> Lazy.Text.fromStrict tc
<> optempty (directives formatter) dirs <> optempty (directives formatter) dirs
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
@ -167,113 +169,117 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
-- * Miscellaneous -- * Miscellaneous
-- | Converts a 'Full.Directive' into a string. -- | Converts a 'Full.Directive' into a string.
directive :: Formatter -> Full.Directive -> Text directive :: Formatter -> Full.Directive -> Lazy.Text
directive formatter (Full.Directive name args) directive formatter (Full.Directive name args)
= "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args = "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
directives :: Formatter -> [Full.Directive] -> Text directives :: Formatter -> [Full.Directive] -> Lazy.Text
directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter) directives formatter@(Pretty _) = Lazy.Text.cons ' ' . spaces (directive formatter)
directives Minified = spaces (directive Minified) directives Minified = spaces (directive Minified)
-- | Converts a 'Full.Value' into a string. -- | Converts a 'Full.Value' into a string.
value :: Formatter -> Full.Value -> Text value :: Formatter -> Full.Value -> Lazy.Text
value _ (Full.Variable x) = variable x value _ (Full.Variable x) = variable x
value _ (Full.Int x) = toLazyText $ decimal x value _ (Full.Int x) = Builder.toLazyText $ decimal x
value _ (Full.Float x) = toLazyText $ realFloat x value _ (Full.Float x) = Builder.toLazyText $ realFloat x
value _ (Full.Boolean x) = booleanValue x value _ (Full.Boolean x) = booleanValue x
value _ Full.Null = mempty value _ Full.Null = mempty
value _ (Full.String x) = stringValue $ Text.Lazy.fromStrict x value _ (Full.String x) = stringValue x
value _ (Full.Enum x) = Text.Lazy.fromStrict x value _ (Full.Enum x) = Lazy.Text.fromStrict x
value formatter (Full.List x) = listValue formatter x value formatter (Full.List x) = listValue formatter x
value formatter (Full.Object x) = objectValue formatter x value formatter (Full.Object x) = objectValue formatter x
booleanValue :: Bool -> Text booleanValue :: Bool -> Lazy.Text
booleanValue True = "true" booleanValue True = "true"
booleanValue False = "false" booleanValue False = "false"
stringValue :: Text -> Text stringValue :: Text -> Lazy.Text
stringValue string = Builder.toLazyText stringValue string = Builder.toLazyText
$ quote $ quote
<> Text.Lazy.foldr replace quote string <> Text.foldr (mappend . replace) quote string
where where
replace '\\' = mappend $ Builder.fromLazyText "\\\\" replace char
replace '\"' = mappend $ Builder.fromLazyText "\\\"" | char == '\\' = Builder.fromString "\\\\"
replace '\b' = mappend $ Builder.fromLazyText "\\b" | char == '\"' = Builder.fromString "\\\""
replace '\f' = mappend $ Builder.fromLazyText "\\f" | char == '\b' = Builder.fromString "\\b"
replace '\n' = mappend $ Builder.fromLazyText "\\n" | char == '\f' = Builder.fromString "\\f"
replace '\r' = mappend $ Builder.fromLazyText "\\r" | char == '\n' = Builder.fromString "\\n"
replace char = mappend $ Builder.singleton char | char == '\r' = Builder.fromString "\\r"
| char < '\x0010' = unicode "\\u000" char
| char < '\x0020' = unicode "\\u00" char
| otherwise = Builder.singleton char
quote = Builder.singleton '\"' quote = Builder.singleton '\"'
unicode prefix char = Builder.fromString prefix <> hexadecimal (ord char)
listValue :: Formatter -> [Full.Value] -> Text listValue :: Formatter -> [Full.Value] -> Lazy.Text
listValue formatter = bracketsCommas formatter $ value formatter listValue formatter = bracketsCommas formatter $ value formatter
objectValue :: Formatter -> [Full.ObjectField] -> Text objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text
objectValue formatter = intercalate $ objectField formatter objectValue formatter = intercalate $ objectField formatter
where where
intercalate f intercalate f
= braces = braces
. Text.Lazy.intercalate (eitherFormat formatter ", " ",") . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
. fmap f . fmap f
objectField :: Formatter -> Full.ObjectField -> Text objectField :: Formatter -> Full.ObjectField -> Lazy.Text
objectField formatter (Full.ObjectField name v) objectField formatter (Full.ObjectField name v)
= Text.Lazy.fromStrict name <> colon <> value formatter v = Lazy.Text.fromStrict name <> colon <> value formatter v
where where
colon colon
| Pretty _ <- formatter = ": " | Pretty _ <- formatter = ": "
| Minified <- formatter = ":" | Minified <- formatter = ":"
-- | Converts a 'Full.Type' a type into a string. -- | Converts a 'Full.Type' a type into a string.
type' :: Full.Type -> Text type' :: Full.Type -> Lazy.Text
type' (Full.TypeNamed x) = Text.Lazy.fromStrict x type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
type' (Full.TypeList x) = listType x type' (Full.TypeList x) = listType x
type' (Full.TypeNonNull x) = nonNullType x type' (Full.TypeNonNull x) = nonNullType x
listType :: Full.Type -> Text listType :: Full.Type -> Lazy.Text
listType x = brackets (type' x) listType x = brackets (type' x)
nonNullType :: Full.NonNullType -> Text nonNullType :: Full.NonNullType -> Lazy.Text
nonNullType (Full.NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
nonNullType (Full.NonNullTypeList x) = listType x <> "!" nonNullType (Full.NonNullTypeList x) = listType x <> "!"
-- * Internal -- * Internal
between :: Char -> Char -> Text -> Text between :: Char -> Char -> Lazy.Text -> Lazy.Text
between open close = Text.Lazy.cons open . (`Text.Lazy.snoc` close) between open close = Lazy.Text.cons open . (`Lazy.Text.snoc` close)
parens :: Text -> Text parens :: Lazy.Text -> Lazy.Text
parens = between '(' ')' parens = between '(' ')'
brackets :: Text -> Text brackets :: Lazy.Text -> Lazy.Text
brackets = between '[' ']' brackets = between '[' ']'
braces :: Text -> Text braces :: Lazy.Text -> Lazy.Text
braces = between '{' '}' braces = between '{' '}'
spaces :: forall a. (a -> Text) -> [a] -> Text spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
spaces f = Text.Lazy.intercalate "\SP" . fmap f spaces f = Lazy.Text.intercalate "\SP" . fmap f
parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text parensCommas :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
parensCommas formatter f parensCommas formatter f
= parens = parens
. Text.Lazy.intercalate (eitherFormat formatter ", " ",") . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
. fmap f . fmap f
bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
bracketsCommas formatter f bracketsCommas formatter f
= brackets = brackets
. Text.Lazy.intercalate (eitherFormat formatter ", " ",") . Lazy.Text.intercalate (eitherFormat formatter ", " ",")
. fmap f . fmap f
bracesList :: forall a. Formatter -> (a -> Text) -> [a] -> Text bracesList :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
bracesList (Pretty intendation) f xs bracesList (Pretty intendation) f xs
= Text.Lazy.snoc (Text.Lazy.intercalate "\n" content) '\n' = Lazy.Text.snoc (Lazy.Text.intercalate "\n" content) '\n'
<> (Text.Lazy.snoc $ Text.Lazy.replicate (fromIntegral intendation) " ") '}' <> (Lazy.Text.snoc $ Lazy.Text.replicate (fromIntegral intendation) " ") '}'
where where
content = "{" : fmap f xs content = "{" : fmap f xs
bracesList Minified f xs = braces $ Text.Lazy.intercalate "," $ fmap f xs bracesList Minified f xs = braces $ Lazy.Text.intercalate "," $ fmap f xs
optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
optempty f xs = if xs == mempty then mempty else f xs optempty f xs = if xs == mempty then mempty else f xs

2
tests/Language/GraphQL/AST/EncoderSpec.hs
View File

@ -19,3 +19,5 @@ spec = describe "value" $ do
value minified (String "\"") `shouldBe` "\"\\\"\"" value minified (String "\"") `shouldBe` "\"\\\"\""
it "escapes backspace" $ it "escapes backspace" $
value minified (String "a\bc") `shouldBe` "\"a\\bc\"" value minified (String "a\bc") `shouldBe` "\"a\\bc\""
it "escapes Unicode" $
value minified (String "\0") `shouldBe` "\"\\u0000\""