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 diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs index acf8075..47718d2 100644 --- a/tests/Language/GraphQL/AST/EncoderSpec.hs +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -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\""