diff options
Diffstat (limited to 'src/Language/GraphQL/AST/Encoder.hs')
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 116 |
1 files changed, 76 insertions, 40 deletions
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index 508212a..69f5599 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -15,7 +15,6 @@ module Language.GraphQL.AST.Encoder import Data.Char (ord) import Data.Foldable (fold) -import Data.Monoid ((<>)) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text as Text @@ -26,6 +25,7 @@ import qualified Data.Text.Lazy.Builder as Builder import Data.Text.Lazy.Builder.Int (decimal, hexadecimal) import Data.Text.Lazy.Builder.RealFloat (realFloat) import qualified Language.GraphQL.AST as Full +import Language.GraphQL.AST.Document -- | Instructs the encoder whether the GraphQL document should be minified or -- pretty printed. @@ -43,16 +43,18 @@ pretty = Pretty 0 minified :: Formatter minified = Minified --- | Converts a 'Full.Document' into a string. -document :: Formatter -> Full.Document -> Lazy.Text +-- | Converts a Document' into a string. +document :: Formatter -> Document -> Lazy.Text document formatter defs | Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument | Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n' where - encodeDocument = NonEmpty.toList $ definition formatter <$> defs + encodeDocument = foldr executableDefinition [] defs + executableDefinition (ExecutableDefinition x) acc = definition formatter x : acc + executableDefinition _ acc = acc --- | Converts a 'Full.Definition' into a string. -definition :: Formatter -> Full.Definition -> Lazy.Text +-- | Converts a t'Full.ExecutableDefinition' into a string. +definition :: Formatter -> ExecutableDefinition -> Lazy.Text definition formatter x | Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n' | Minified <- formatter = encodeDefinition x @@ -62,14 +64,16 @@ 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.OperationSelectionSet sels) +operationDefinition formatter (Full.SelectionSet sels) = selectionSet formatter sels operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels) = "query " <> node formatter name vars dirs sels 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] -> @@ -110,17 +114,21 @@ 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 where - encodeSelection (Full.SelectionField field') = field incrementIndent field' - encodeSelection (Full.SelectionInlineFragment fragment) = - inlineFragment incrementIndent fragment - encodeSelection (Full.SelectionFragmentSpread spread) = - fragmentSpread incrementIndent spread + encodeSelection (Full.Field alias name args directives' selections) = + field incrementIndent alias name args directives' selections + encodeSelection (Full.InlineFragment typeCondition directives' selections) = + inlineFragment incrementIndent typeCondition directives' selections + encodeSelection (Full.FragmentSpread name directives') = + fragmentSpread incrementIndent name directives' incrementIndent | Pretty indentation <- formatter = Pretty $ indentation + 1 | otherwise = Minified @@ -131,8 +139,15 @@ selection formatter = Lazy.Text.append indent' . encodeSelection colon :: Formatter -> Lazy.Text colon formatter = eitherFormat formatter ": " ":" -field :: Formatter -> Full.Field -> Lazy.Text -field formatter (Full.Field alias name args dirs set) +-- | Converts Full.Field into a string +field :: Formatter -> + Maybe Full.Name -> + Full.Name -> + [Full.Argument] -> + [Full.Directive] -> + [Full.Selection] -> + Lazy.Text +field formatter alias name args dirs set = optempty prependAlias (fold alias) <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args @@ -154,13 +169,18 @@ argument formatter (Full.Argument name value') -- * Fragments -fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text -fragmentSpread formatter (Full.FragmentSpread name ds) - = "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) ds +fragmentSpread :: Formatter -> Full.Name -> [Full.Directive] -> Lazy.Text +fragmentSpread formatter name directives' + = "..." <> Lazy.Text.fromStrict name + <> optempty (directives formatter) directives' -inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text -inlineFragment formatter (Full.InlineFragment tc dirs sels) - = "... on " +inlineFragment :: + Formatter -> + Maybe Full.TypeCondition -> + [Full.Directive] -> + Full.SelectionSet -> + Lazy.Text +inlineFragment formatter tc dirs sels = "... on " <> Lazy.Text.fromStrict (fold tc) <> directives formatter dirs <> eitherFormat formatter " " mempty @@ -191,7 +211,7 @@ value _ (Full.Variable x) = variable 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.Null = "null" value formatter (Full.String string) = stringValue formatter string value _ (Full.Enum x) = Lazy.Text.fromStrict x value formatter (Full.List x) = listValue formatter x @@ -201,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' @@ -228,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' |