diff options
Diffstat (limited to 'src/Language/GraphQL/AST/Encoder.hs')
| -rw-r--r-- | src/Language/GraphQL/AST/Encoder.hs | 243 |
1 files changed, 137 insertions, 106 deletions
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index afc425f..508212a 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -13,13 +13,17 @@ 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 Data.Text.Lazy.Builder (toLazyText) -import Data.Text.Lazy.Builder.Int (decimal) +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 Data.Text.Lazy.Builder (Builder) +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 @@ -40,17 +44,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) @@ -58,7 +62,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) @@ -66,99 +70,106 @@ 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 +indent :: (Integral a) => a -> Lazy.Text +indent indentation = Lazy.Text.replicate (fromIntegral indentation) " " + +selection :: Formatter -> Full.Selection -> Lazy.Text +selection formatter = Lazy.Text.append indent' . encodeSelection where - f (Full.SelectionField x) = field incrementIndent x - f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x - f (Full.SelectionFragmentSpread x) = fragmentSpread incrementIndent x + encodeSelection (Full.SelectionField field') = field incrementIndent field' + encodeSelection (Full.SelectionInlineFragment fragment) = + inlineFragment incrementIndent fragment + encodeSelection (Full.SelectionFragmentSpread spread) = + fragmentSpread incrementIndent spread incrementIndent - | Pretty n <- formatter = Pretty $ n + 1 + | Pretty indentation <- formatter = Pretty $ indentation + 1 | otherwise = Minified - indent - | Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " " - | otherwise = mempty - -field :: Formatter -> Full.Field -> Text -field formatter (Full.Field alias name args dirs selso) - = optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias) - <> Text.Lazy.fromStrict name + indent' + | Pretty indentation <- formatter = indent $ indentation + 1 + | otherwise = "" + +colon :: Formatter -> Lazy.Text +colon formatter = eitherFormat formatter ": " ":" + +field :: Formatter -> Full.Field -> Lazy.Text +field formatter (Full.Field alias name args dirs set) + = optempty prependAlias (fold alias) + <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args <> optempty (directives formatter) dirs - <> selectionSetOpt' + <> optempty selectionSetOpt' set where - colon = eitherFormat formatter ": " ":" - selectionSetOpt' - | null selso = mempty - | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso + prependAlias aliasName = Lazy.Text.fromStrict aliasName <> colon formatter + selectionSetOpt' = (eitherFormat formatter " " "" <>) + . selectionSetOpt formatter -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 name v) - = Text.Lazy.fromStrict name - <> eitherFormat formatter ": " ":" - <> value formatter v +argument :: Formatter -> Full.Argument -> Lazy.Text +argument formatter (Full.Argument name value') + = Lazy.Text.fromStrict name + <> colon formatter + <> value formatter value' -- * 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 @@ -166,108 +177,128 @@ 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 Minified = spaces (directive Minified) +directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter) -- | 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 formatter (Full.String string) = stringValue formatter string +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 - = quotes - . Text.Lazy.replace "\"" "\\\"" - . Text.Lazy.replace "\\" "\\\\" +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 '\"' + +escape :: Char -> Builder +escape char' + | char' == '\\' = Builder.fromString "\\\\" + | char' == '\"' = Builder.fromString "\\\"" + | char' == '\b' = Builder.fromString "\\b" + | char' == '\f' = Builder.fromString "\\f" + | char' == '\r' = Builder.fromString "\\r" + | char' < '\x0010' = unicode "\\u000" char' + | char' < '\x0020' = unicode "\\u00" char' + | otherwise = Builder.singleton char' + where + unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord) -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 name v) - = Text.Lazy.fromStrict name <> colon <> value formatter v - where - colon - | Pretty _ <- formatter = ": " - | Minified <- formatter = ":" +objectField :: Formatter -> Full.ObjectField -> Lazy.Text +objectField formatter (Full.ObjectField name value') = + Lazy.Text.fromStrict name <> colon formatter <> value formatter value' -- | 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 '{' '}' -quotes :: Text -> Text -quotes = 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 |