Encode Unicode. Fix #34

1 files changed, 91 insertions, 85 deletions

diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 056ae2c..6de8861 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -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