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