aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/AST
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/AST')
-rw-r--r--src/Language/GraphQL/AST/Core.hs10
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs243
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs4
-rw-r--r--src/Language/GraphQL/AST/Transform.hs150
4 files changed, 149 insertions, 258 deletions
diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs
index f7a008f..7ba4830 100644
--- a/src/Language/GraphQL/AST/Core.hs
+++ b/src/Language/GraphQL/AST/Core.hs
@@ -2,6 +2,8 @@
module Language.GraphQL.AST.Core
( Alias
, Argument(..)
+ , Arguments(..)
+ , Directive(..)
, Document
, Field(..)
, Fragment(..)
@@ -39,6 +41,14 @@ data Field
-- | Single argument.
data Argument = Argument Name Value deriving (Eq, Show)
+-- | Argument list.
+newtype Arguments = Arguments (HashMap Name Value)
+ deriving (Eq, Show)
+
+-- | Directive.
+data Directive = Directive Name Arguments
+ deriving (Eq, Show)
+
-- | Represents fragments and inline fragments.
data Fragment
= Fragment TypeCondition (Seq Selection)
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
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index e4d64ca..f95070c 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -134,7 +134,7 @@ braces = between (symbol "{") (symbol "}")
-- | Parser for strings.
string :: Parser T.Text
-string = between "\"" "\"" stringValue
+string = between "\"" "\"" stringValue <* spaceConsumer
where
stringValue = T.pack <$> many stringCharacter
stringCharacter = satisfy isStringCharacter1
@@ -143,7 +143,7 @@ string = between "\"" "\"" stringValue
-- | Parser for block strings.
blockString :: Parser T.Text
-blockString = between "\"\"\"" "\"\"\"" stringValue
+blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
where
stringValue = do
byLine <- sepBy (many blockStringCharacter) lineTerminator
diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs
deleted file mode 100644
index 95cdfbb..0000000
--- a/src/Language/GraphQL/AST/Transform.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE ExplicitForAll #-}
-
--- | After the document is parsed, before getting executed the AST is
--- transformed into a similar, simpler AST. This module is responsible for
--- this transformation.
-module Language.GraphQL.AST.Transform
- ( document
- ) where
-
-import Control.Arrow (first)
-import Control.Monad (foldM, unless)
-import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
-import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
-import Data.HashMap.Strict (HashMap)
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Sequence (Seq, (<|), (><))
-import qualified Language.GraphQL.AST as Full
-import qualified Language.GraphQL.AST.Core as Core
-import qualified Language.GraphQL.Schema as Schema
-
--- | Associates a fragment name with a list of 'Core.Field's.
-data Replacement = Replacement
- { fragments :: HashMap Core.Name (Seq Core.Selection)
- , fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
- }
-
-type TransformT a = StateT Replacement (ReaderT Schema.Subs Maybe) a
-
--- | Rewrites the original syntax tree into an intermediate representation used
--- for query execution.
-document :: Schema.Subs -> Full.Document -> Maybe Core.Document
-document subs document' =
- flip runReaderT subs
- $ evalStateT (collectFragments >> operations operationDefinitions)
- $ Replacement HashMap.empty fragmentTable
- where
- (fragmentTable, operationDefinitions) = foldr defragment mempty document'
- defragment (Full.DefinitionOperation definition) acc =
- (definition :) <$> acc
- defragment (Full.DefinitionFragment definition) acc =
- let (Full.FragmentDefinition name _ _ _) = definition
- in first (HashMap.insert name definition) acc
-
--- * Operation
-
--- TODO: Replace Maybe by MonadThrow CustomError
-operations :: [Full.OperationDefinition] -> TransformT Core.Document
-operations operations' = do
- coreOperations <- traverse operation operations'
- lift . lift $ NonEmpty.nonEmpty coreOperations
-
-operation :: Full.OperationDefinition -> TransformT Core.Operation
-operation (Full.OperationSelectionSet sels) =
- operation $ Full.OperationDefinition Full.Query mempty mempty mempty sels
--- TODO: Validate Variable definitions with substituter
-operation (Full.OperationDefinition Full.Query name _vars _dirs sels) =
- Core.Query name <$> appendSelection sels
-operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
- Core.Mutation name <$> appendSelection sels
-
-selection ::
- Full.Selection ->
- TransformT (Either (Seq Core.Selection) Core.Selection)
-selection (Full.SelectionField fld) = Right . Core.SelectionField <$> field fld
-selection (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) = do
- fragments' <- gets fragments
- Left <$> maybe lookupDefinition liftJust (HashMap.lookup name fragments')
- where
- lookupDefinition :: TransformT (Seq Core.Selection)
- lookupDefinition = do
- fragmentDefinitions' <- gets fragmentDefinitions
- found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
- fragmentDefinition found
-selection (Full.SelectionInlineFragment fragment)
- | (Full.InlineFragment (Just typeCondition) _ selectionSet) <- fragment
- = Right
- . Core.SelectionFragment
- . Core.Fragment typeCondition
- <$> appendSelection selectionSet
- | (Full.InlineFragment Nothing _ selectionSet) <- fragment
- = Left <$> appendSelection selectionSet
-
--- * Fragment replacement
-
--- | Extract fragment definitions into a single 'HashMap'.
-collectFragments :: TransformT ()
-collectFragments = do
- fragDefs <- gets fragmentDefinitions
- let nextValue = head $ HashMap.elems fragDefs
- unless (HashMap.null fragDefs) $ do
- _ <- fragmentDefinition nextValue
- collectFragments
-
-fragmentDefinition ::
- Full.FragmentDefinition ->
- TransformT (Seq Core.Selection)
-fragmentDefinition (Full.FragmentDefinition name _tc _dirs selections) = do
- modify deleteFragmentDefinition
- newValue <- appendSelection selections
- modify $ insertFragment newValue
- liftJust newValue
- where
- deleteFragmentDefinition (Replacement fragments' fragmentDefinitions') =
- Replacement fragments' $ HashMap.delete name fragmentDefinitions'
- insertFragment newValue (Replacement fragments' fragmentDefinitions') =
- let newFragments = HashMap.insert name newValue fragments'
- in Replacement newFragments fragmentDefinitions'
-
-field :: Full.Field -> TransformT Core.Field
-field (Full.Field a n args _dirs sels) = do
- arguments <- traverse argument args
- selection' <- appendSelection sels
- return $ Core.Field a n arguments selection'
-
-argument :: Full.Argument -> TransformT Core.Argument
-argument (Full.Argument n v) = Core.Argument n <$> value v
-
-value :: Full.Value -> TransformT Core.Value
-value (Full.Variable n) = do
- substitute' <- lift ask
- lift . lift $ substitute' n
-value (Full.Int i) = pure $ Core.Int i
-value (Full.Float f) = pure $ Core.Float f
-value (Full.String x) = pure $ Core.String x
-value (Full.Boolean b) = pure $ Core.Boolean b
-value Full.Null = pure Core.Null
-value (Full.Enum e) = pure $ Core.Enum e
-value (Full.List l) =
- Core.List <$> traverse value l
-value (Full.Object o) =
- Core.Object . HashMap.fromList <$> traverse objectField o
-
-objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
-objectField (Full.ObjectField n v) = (n,) <$> value v
-
-appendSelection ::
- Traversable t =>
- t Full.Selection ->
- TransformT (Seq Core.Selection)
-appendSelection = foldM go mempty
- where
- go acc sel = append acc <$> selection sel
- append acc (Left list) = list >< acc
- append acc (Right one) = one <| acc
-
-liftJust :: forall a. a -> TransformT a
-liftJust = lift . lift . Just
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:52:00 +0000