diff options
Diffstat (limited to 'src/Data/GraphQL/Encoder.hs')
| -rw-r--r-- | src/Data/GraphQL/Encoder.hs | 179 |
1 files changed, 0 insertions, 179 deletions
diff --git a/src/Data/GraphQL/Encoder.hs b/src/Data/GraphQL/Encoder.hs deleted file mode 100644 index 924bdea..0000000 --- a/src/Data/GraphQL/Encoder.hs +++ /dev/null @@ -1,179 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | This module defines a printer for the @GraphQL@ language. -module Data.GraphQL.Encoder where - -import Data.Foldable (fold) -import Data.Monoid ((<>)) -import qualified Data.List.NonEmpty as NonEmpty (toList) - -import Data.Text (Text, cons, intercalate, pack, snoc) - -import Data.GraphQL.AST - --- * Document - -document :: Document -> Text -document defs = (`snoc` '\n') . mconcat . NonEmpty.toList $ definition <$> defs - -definition :: Definition -> Text -definition (DefinitionOperation x) = operationDefinition x -definition (DefinitionFragment x) = fragmentDefinition x - -operationDefinition :: OperationDefinition -> Text -operationDefinition (OperationSelectionSet sels) = selectionSet sels -operationDefinition (OperationDefinition Query name vars dirs sels) = - "query " <> node (fold name) vars dirs sels -operationDefinition (OperationDefinition Mutation name vars dirs sels) = - "mutation " <> node (fold name) vars dirs sels - -node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text -node name vars dirs sels = - name - <> optempty variableDefinitions vars - <> optempty directives dirs - <> selectionSet sels - -variableDefinitions :: [VariableDefinition] -> Text -variableDefinitions = parensCommas variableDefinition - -variableDefinition :: VariableDefinition -> Text -variableDefinition (VariableDefinition var ty dv) = - variable var <> ":" <> type_ ty <> maybe mempty defaultValue dv - -defaultValue :: DefaultValue -> Text -defaultValue val = "=" <> value val - -variable :: Variable -> Text -variable var = "$" <> var - -selectionSet :: SelectionSet -> Text -selectionSet = bracesCommas selection . NonEmpty.toList - -selectionSetOpt :: SelectionSetOpt -> Text -selectionSetOpt = bracesCommas selection - -selection :: Selection -> Text -selection (SelectionField x) = field x -selection (SelectionInlineFragment x) = inlineFragment x -selection (SelectionFragmentSpread x) = fragmentSpread x - -field :: Field -> Text -field (Field alias name args dirs selso) = - optempty (`snoc` ':') (fold alias) - <> name - <> optempty arguments args - <> optempty directives dirs - <> optempty selectionSetOpt selso - -arguments :: [Argument] -> Text -arguments = parensCommas argument - -argument :: Argument -> Text -argument (Argument name v) = name <> ":" <> value v - --- * Fragments - -fragmentSpread :: FragmentSpread -> Text -fragmentSpread (FragmentSpread name ds) = - "..." <> name <> optempty directives ds - -inlineFragment :: InlineFragment -> Text -inlineFragment (InlineFragment tc dirs sels) = - "... on " <> fold tc - <> directives dirs - <> selectionSet sels - -fragmentDefinition :: FragmentDefinition -> Text -fragmentDefinition (FragmentDefinition name tc dirs sels) = - "fragment " <> name <> " on " <> tc - <> optempty directives dirs - <> selectionSet sels - --- * Values - -value :: Value -> Text -value (ValueVariable x) = variable x --- TODO: This will be replaced with `decimal` Builder -value (ValueInt x) = pack $ show x --- TODO: This will be replaced with `decimal` Builder -value (ValueFloat x) = pack $ show x -value (ValueBoolean x) = booleanValue x -value ValueNull = mempty -value (ValueString x) = stringValue x -value (ValueEnum x) = x -value (ValueList x) = listValue x -value (ValueObject x) = objectValue x - -booleanValue :: Bool -> Text -booleanValue True = "true" -booleanValue False = "false" - --- TODO: Escape characters -stringValue :: Text -> Text -stringValue = quotes - -listValue :: ListValue -> Text -listValue = bracketsCommas value - -objectValue :: ObjectValue -> Text -objectValue = bracesCommas objectField - -objectField :: ObjectField -> Text -objectField (ObjectField name v) = name <> ":" <> value v - --- * Directives - -directives :: [Directive] -> Text -directives = spaces directive - -directive :: Directive -> Text -directive (Directive name args) = "@" <> name <> optempty arguments args - --- * Type Reference - -type_ :: Type -> Text -type_ (TypeNamed x) = x -type_ (TypeList x) = listType x -type_ (TypeNonNull x) = nonNullType x - -listType :: Type -> Text -listType x = brackets (type_ x) - -nonNullType :: NonNullType -> Text -nonNullType (NonNullTypeNamed x) = x <> "!" -nonNullType (NonNullTypeList x) = listType x <> "!" - --- * Internal - -spaced :: Text -> Text -spaced = cons '\SP' - -between :: Char -> Char -> Text -> Text -between open close = cons open . (`snoc` close) - -parens :: Text -> Text -parens = between '(' ')' - -brackets :: Text -> Text -brackets = between '[' ']' - -braces :: Text -> Text -braces = between '{' '}' - -quotes :: Text -> Text -quotes = between '"' '"' - -spaces :: (a -> Text) -> [a] -> Text -spaces f = intercalate "\SP" . fmap f - -parensCommas :: (a -> Text) -> [a] -> Text -parensCommas f = parens . intercalate "," . fmap f - -bracketsCommas :: (a -> Text) -> [a] -> Text -bracketsCommas f = brackets . intercalate "," . fmap f - -bracesCommas :: (a -> Text) -> [a] -> Text -bracesCommas f = braces . intercalate "," . fmap f - -optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b -optempty f xs = if xs == mempty then mempty else f xs |
