From 5390c4ca1e7e6bcf36dbe5e773c1355dd4b65939 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sat, 28 Jan 2017 14:15:14 -0300 Subject: Split AST in 2 One AST is meant to be a target parser and tries to adhere as much as possible to the spec. The other is a simplified version of that AST meant for execution. Also newtypes have been replaced by type synonyms and NonEmpty lists are being used where it makes sense. --- Data/GraphQL/AST/Core.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Core.hs b/Data/GraphQL/AST/Core.hs index 2ca3928..b5698c6 100644 --- a/Data/GraphQL/AST/Core.hs +++ b/Data/GraphQL/AST/Core.hs @@ -6,15 +6,17 @@ import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) -newtype Name = Name Text deriving (Eq,Show) +type Name = Text -newtype Document = Document (NonEmpty Operation) deriving (Eq,Show) +type Document = NonEmpty Operation -data Operation = Query (NonEmpty Field) +data Operation = Query (NonEmpty Field) | Mutation (NonEmpty Field) deriving (Eq,Show) -data Field = Field Name [Argument] [Field] deriving (Eq,Show) +data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show) + +type Alias = Name data Argument = Argument Name Value deriving (Eq,Show) -- cgit v1.2.3 From 693b7d18dcd48525b10ce297f89b3b33fd020784 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 29 Jan 2017 18:44:03 -0300 Subject: Introduce Tranform module In the Transform module the Full AST will converted to Core AST. This commit also includes a partial implementation of Fragment replacement. --- Data/GraphQL/AST/Core.hs | 3 +- Data/GraphQL/AST/Transform.hs | 86 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 Data/GraphQL/AST/Transform.hs (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Core.hs b/Data/GraphQL/AST/Core.hs index b5698c6..3424d20 100644 --- a/Data/GraphQL/AST/Core.hs +++ b/Data/GraphQL/AST/Core.hs @@ -23,8 +23,9 @@ data Argument = Argument Name Value deriving (Eq,Show) data Value = ValueInt Int32 -- GraphQL Float is double precision | ValueFloat Double - | ValueBoolean Bool | ValueString Text + | ValueBoolean Bool + | ValueNull | ValueEnum Name | ValueList [Value] | ValueObject [ObjectField] diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs new file mode 100644 index 0000000..89a79e6 --- /dev/null +++ b/Data/GraphQL/AST/Transform.hs @@ -0,0 +1,86 @@ +module Data.GraphQL.AST.Transform where + +import Control.Applicative (empty) +import Data.Bifunctor (first) +import Data.Either (partitionEithers) +import qualified Data.List.NonEmpty as NonEmpty +-- import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Monoid (Alt(Alt,getAlt)) +import Data.Foldable (foldMap) + +import Data.Text (Text) + +import qualified Data.GraphQL.AST as Full +import qualified Data.GraphQL.AST.Core as Core +import qualified Data.GraphQL.Schema as Schema + +type Name = Text + +-- | Replaces a fragment name by a list of 'Field'. If the name doesn't match an +-- empty list is returned. +type Fragmenter = Name -> [Core.Field] + +document :: Schema.Subs -> Full.Document -> Core.Document +document subs defs = operations subs fr ops + where + (fr, ops) = first foldFrags . partitionEithers . NonEmpty.toList $ defrag <$> defs + + foldFrags :: [Fragmenter] -> Fragmenter + foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs + +-- * Fragment replacement + +-- | Extract Fragments into a single Fragmenter function and a Operation +-- Definition. +defrag :: Full.Definition -> Either Fragmenter Full.OperationDefinition +defrag (Full.DefinitionOperation op) = Right op +defrag (Full.DefinitionFragment fragDef) = Left $ fragmentDefinition fragDef + +fragmentDefinition :: Full.FragmentDefinition -> Fragmenter +fragmentDefinition (Full.FragmentDefinition name _tc _dirs sels) name' = + if name == name' then NonEmpty.toList (selection <$> sels) else empty + +selection :: Full.Selection -> Core.Field +selection (Full.SelectionField _fld) = field _fld +selection (Full.SelectionFragmentSpread _) = error "Nested fragments not supported yet" +selection (Full.SelectionInlineFragment _) = + error "Inline fragments within fragments not supported yet" + +field :: Full.Field -> Core.Field +field (Full.Field a n args _ sels) = + Core.Field a n (argument <$> args) (selection <$> sels) + +argument :: Full.Argument -> Core.Argument +argument (Full.Argument n v) = Core.Argument n (value v) + +value :: Full.Value -> Core.Value +value (Full.ValueVariable _) = error "Variables within fragments not supported yet" +value (Full.ValueInt i) = Core.ValueInt i +value (Full.ValueFloat f) = Core.ValueFloat f +value (Full.ValueString x) = Core.ValueString x +value (Full.ValueBoolean b) = Core.ValueBoolean b +value Full.ValueNull = Core.ValueNull +value (Full.ValueEnum e) = Core.ValueEnum e +value (Full.ValueList l) = Core.ValueList (value <$> l) +value (Full.ValueObject o) = Core.ValueObject (objectField <$> o) + +objectField :: Full.ObjectField -> Core.ObjectField +objectField (Full.ObjectField n v) = Core.ObjectField n (value v) + +-- * Operation + +operations + :: Schema.Subs + -> Fragmenter + -> [Full.OperationDefinition] + -> Core.Document +-- XXX: Replace `fromList` by proper error: at least a Query or Mutation +-- operation must be present +operations subs fr = NonEmpty.fromList . fmap (operation subs fr) + +operation + :: Schema.Subs + -> Fragmenter + -> Full.OperationDefinition + -> Core.Operation +operation _subs _fr _op = undefined -- cgit v1.2.3 From 4ab4660d364cc62c9e23d2cdc85abc3f7dc6dc8d Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Fri, 3 Feb 2017 21:48:26 -0300 Subject: Initial implementation of AST.Full -> AST.Core This focused mainly on fragments. --- Data/GraphQL/AST/Transform.hs | 70 +++++++++++++++++++++++++------------------ 1 file changed, 41 insertions(+), 29 deletions(-) (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs index 89a79e6..3dac757 100644 --- a/Data/GraphQL/AST/Transform.hs +++ b/Data/GraphQL/AST/Transform.hs @@ -1,10 +1,11 @@ module Data.GraphQL.AST.Transform where import Control.Applicative (empty) +import Control.Monad ((<=<)) import Data.Bifunctor (first) import Data.Either (partitionEithers) import qualified Data.List.NonEmpty as NonEmpty --- import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Maybe (maybeToList) import Data.Monoid (Alt(Alt,getAlt)) import Data.Foldable (foldMap) @@ -20,7 +21,8 @@ type Name = Text -- empty list is returned. type Fragmenter = Name -> [Core.Field] -document :: Schema.Subs -> Full.Document -> Core.Document +-- TODO: Replace Maybe by Either CustomError +document :: Schema.Subs -> Full.Document -> Maybe Core.Document document subs defs = operations subs fr ops where (fr, ops) = first foldFrags . partitionEithers . NonEmpty.toList $ defrag <$> defs @@ -28,6 +30,34 @@ document subs defs = operations subs fr ops foldFrags :: [Fragmenter] -> Fragmenter foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs +-- * Operation + +operations + :: Schema.Subs + -> Fragmenter + -> [Full.OperationDefinition] + -> Maybe Core.Document +operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr) + +operation + :: Schema.Subs + -> Fragmenter + -> Full.OperationDefinition + -> Maybe Core.Operation +operation subs fr (Full.OperationSelectionSet sels) = + operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels +operation _subs fr (Full.OperationDefinition ot _n _vars _dirs sels) = + case ot of + Full.Query -> Core.Query <$> node + Full.Mutation -> Core.Mutation <$> node + where + node = traverse (hush <=< selection fr) sels + +selection :: Fragmenter -> Full.Selection -> Maybe (Either [Core.Field] Core.Field) +selection fr (Full.SelectionField _fld) = Right <$> field fr _fld +selection fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) = Just . Left $ fr n +selection _ (Full.SelectionInlineFragment _) = error "Inline fragments not supported yet" + -- * Fragment replacement -- | Extract Fragments into a single Fragmenter function and a Operation @@ -38,17 +68,14 @@ defrag (Full.DefinitionFragment fragDef) = Left $ fragmentDefinition fragDef fragmentDefinition :: Full.FragmentDefinition -> Fragmenter fragmentDefinition (Full.FragmentDefinition name _tc _dirs sels) name' = - if name == name' then NonEmpty.toList (selection <$> sels) else empty - -selection :: Full.Selection -> Core.Field -selection (Full.SelectionField _fld) = field _fld -selection (Full.SelectionFragmentSpread _) = error "Nested fragments not supported yet" -selection (Full.SelectionInlineFragment _) = - error "Inline fragments within fragments not supported yet" + -- TODO: Support fragments within fragments. Fold instead of map. + if name == name' + then either id pure =<< maybeToList =<< NonEmpty.toList (selection mempty <$> sels) + else empty -field :: Full.Field -> Core.Field -field (Full.Field a n args _ sels) = - Core.Field a n (argument <$> args) (selection <$> sels) +field :: Fragmenter -> Full.Field -> Maybe Core.Field +field fr (Full.Field a n args _ sels) = + Core.Field a n (argument <$> args) <$> traverse (hush <=< selection fr) sels argument :: Full.Argument -> Core.Argument argument (Full.Argument n v) = Core.Argument n (value v) @@ -67,20 +94,5 @@ value (Full.ValueObject o) = Core.ValueObject (objectField <$> o) objectField :: Full.ObjectField -> Core.ObjectField objectField (Full.ObjectField n v) = Core.ObjectField n (value v) --- * Operation - -operations - :: Schema.Subs - -> Fragmenter - -> [Full.OperationDefinition] - -> Core.Document --- XXX: Replace `fromList` by proper error: at least a Query or Mutation --- operation must be present -operations subs fr = NonEmpty.fromList . fmap (operation subs fr) - -operation - :: Schema.Subs - -> Fragmenter - -> Full.OperationDefinition - -> Core.Operation -operation _subs _fr _op = undefined +hush :: Either a b -> Maybe b +hush = either (const Nothing) Just -- cgit v1.2.3 From b7a72591fd08df9df678e5e7db3304b5a2e75ae9 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 12 Feb 2017 15:19:13 -0300 Subject: Support variables in AST transformation --- Data/GraphQL/AST/Core.hs | 4 ++ Data/GraphQL/AST/Transform.hs | 91 ++++++++++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 35 deletions(-) (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Core.hs b/Data/GraphQL/AST/Core.hs index 3424d20..f0c617c 100644 --- a/Data/GraphQL/AST/Core.hs +++ b/Data/GraphQL/AST/Core.hs @@ -3,6 +3,7 @@ module Data.GraphQL.AST.Core where import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty) +import Data.String import Data.Text (Text) @@ -31,4 +32,7 @@ data Value = ValueInt Int32 | ValueObject [ObjectField] deriving (Eq,Show) +instance IsString Value where + fromString = ValueString . fromString + data ObjectField = ObjectField Name Value deriving (Eq,Show) diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs index 3dac757..d4b1150 100644 --- a/Data/GraphQL/AST/Transform.hs +++ b/Data/GraphQL/AST/Transform.hs @@ -4,10 +4,10 @@ import Control.Applicative (empty) import Control.Monad ((<=<)) import Data.Bifunctor (first) import Data.Either (partitionEithers) +import Data.Foldable (fold, foldMap) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (maybeToList) import Data.Monoid (Alt(Alt,getAlt)) -import Data.Foldable (foldMap) import Data.Text (Text) @@ -25,7 +25,11 @@ type Fragmenter = Name -> [Core.Field] document :: Schema.Subs -> Full.Document -> Maybe Core.Document document subs defs = operations subs fr ops where - (fr, ops) = first foldFrags . partitionEithers . NonEmpty.toList $ defrag <$> defs + (fr, ops) = first foldFrags + . partitionEithers + . NonEmpty.toList + $ defrag subs + <$> defs foldFrags :: [Fragmenter] -> Fragmenter foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs @@ -46,53 +50,70 @@ operation -> Maybe Core.Operation operation subs fr (Full.OperationSelectionSet sels) = operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels -operation _subs fr (Full.OperationDefinition ot _n _vars _dirs sels) = +-- TODO: Validate Variable definitions with substituter +operation subs fr (Full.OperationDefinition ot _n _vars _dirs sels) = case ot of Full.Query -> Core.Query <$> node Full.Mutation -> Core.Mutation <$> node where - node = traverse (hush <=< selection fr) sels + node = traverse (hush <=< selection subs fr) sels -selection :: Fragmenter -> Full.Selection -> Maybe (Either [Core.Field] Core.Field) -selection fr (Full.SelectionField _fld) = Right <$> field fr _fld -selection fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) = Just . Left $ fr n -selection _ (Full.SelectionInlineFragment _) = error "Inline fragments not supported yet" +selection + :: Schema.Subs + -> Fragmenter + -> Full.Selection + -> Maybe (Either [Core.Field] Core.Field) +selection subs fr (Full.SelectionField fld) = + Right <$> field subs fr fld +selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) = + Just . Left $ fr n +selection _ _ (Full.SelectionInlineFragment _) = + error "Inline fragments not supported yet" -- * Fragment replacement -- | Extract Fragments into a single Fragmenter function and a Operation -- Definition. -defrag :: Full.Definition -> Either Fragmenter Full.OperationDefinition -defrag (Full.DefinitionOperation op) = Right op -defrag (Full.DefinitionFragment fragDef) = Left $ fragmentDefinition fragDef - -fragmentDefinition :: Full.FragmentDefinition -> Fragmenter -fragmentDefinition (Full.FragmentDefinition name _tc _dirs sels) name' = +defrag + :: Schema.Subs + -> Full.Definition + -> Either Fragmenter Full.OperationDefinition +defrag _ (Full.DefinitionOperation op) = + Right op +defrag subs (Full.DefinitionFragment fragDef) = + Left $ fragmentDefinition subs fragDef + +fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter +fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' = -- TODO: Support fragments within fragments. Fold instead of map. if name == name' - then either id pure =<< maybeToList =<< NonEmpty.toList (selection mempty <$> sels) + then either id pure =<< maybeToList + =<< NonEmpty.toList (selection subs mempty <$> sels) else empty -field :: Fragmenter -> Full.Field -> Maybe Core.Field -field fr (Full.Field a n args _ sels) = - Core.Field a n (argument <$> args) <$> traverse (hush <=< selection fr) sels - -argument :: Full.Argument -> Core.Argument -argument (Full.Argument n v) = Core.Argument n (value v) - -value :: Full.Value -> Core.Value -value (Full.ValueVariable _) = error "Variables within fragments not supported yet" -value (Full.ValueInt i) = Core.ValueInt i -value (Full.ValueFloat f) = Core.ValueFloat f -value (Full.ValueString x) = Core.ValueString x -value (Full.ValueBoolean b) = Core.ValueBoolean b -value Full.ValueNull = Core.ValueNull -value (Full.ValueEnum e) = Core.ValueEnum e -value (Full.ValueList l) = Core.ValueList (value <$> l) -value (Full.ValueObject o) = Core.ValueObject (objectField <$> o) - -objectField :: Full.ObjectField -> Core.ObjectField -objectField (Full.ObjectField n v) = Core.ObjectField n (value v) +field :: Schema.Subs -> Fragmenter -> Full.Field -> Maybe Core.Field +field subs fr (Full.Field a n args _dirs sels) = + Core.Field a n (fold $ argument subs `traverse` args) + <$> traverse (hush <=< selection subs fr) sels + +argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument +argument subs (Full.Argument n v) = Core.Argument n <$> value subs v + +value :: Schema.Subs -> Full.Value -> Maybe Core.Value +value subs (Full.ValueVariable n) = subs n +value _ (Full.ValueInt i) = pure $ Core.ValueInt i +value _ (Full.ValueFloat f) = pure $ Core.ValueFloat f +value _ (Full.ValueString x) = pure $ Core.ValueString x +value _ (Full.ValueBoolean b) = pure $ Core.ValueBoolean b +value _ Full.ValueNull = pure Core.ValueNull +value _ (Full.ValueEnum e) = pure $ Core.ValueEnum e +value subs (Full.ValueList l) = + Core.ValueList <$> traverse (value subs) l +value subs (Full.ValueObject o) = + Core.ValueObject <$> traverse (objectField subs) o + +objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField +objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v hush :: Either a b -> Maybe b hush = either (const Nothing) Just -- cgit v1.2.3 From d2c138f8d16acadb8ae2ba410484d985dde1e37c Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 19 Feb 2017 15:29:58 -0300 Subject: Add basic Fragment Support Only field names are supported for now. --- Data/GraphQL/AST/Transform.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs index d4b1150..b08014f 100644 --- a/Data/GraphQL/AST/Transform.hs +++ b/Data/GraphQL/AST/Transform.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Data.GraphQL.AST.Transform where import Control.Applicative (empty) @@ -23,13 +24,13 @@ type Fragmenter = Name -> [Core.Field] -- TODO: Replace Maybe by Either CustomError document :: Schema.Subs -> Full.Document -> Maybe Core.Document -document subs defs = operations subs fr ops +document subs doc = operations subs fr ops where (fr, ops) = first foldFrags . partitionEithers . NonEmpty.toList $ defrag subs - <$> defs + <$> doc foldFrags :: [Fragmenter] -> Fragmenter foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs @@ -93,8 +94,17 @@ fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' = field :: Schema.Subs -> Fragmenter -> Full.Field -> Maybe Core.Field field subs fr (Full.Field a n args _dirs sels) = - Core.Field a n (fold $ argument subs `traverse` args) - <$> traverse (hush <=< selection subs fr) sels + Core.Field a n (fold $ argument subs `traverse` args) + -- TODO: hush should error when fragments are not defined in a field + <$> traverse (hush <=< selection subs fr) (foldr go empty sels) + where + go :: Full.Selection -> Full.SelectionSetOpt -> Full.SelectionSetOpt + go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) acc = + (Full.SelectionField . full <$> fr name) ++ acc + go x acc = x : acc + + full :: Core.Field -> Full.Field + full (Core.Field a' n' _args' _sels') = Full.Field a' n' empty empty [] argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument argument subs (Full.Argument n v) = Core.Argument n <$> value subs v -- cgit v1.2.3 From bada28ce24dcd0fcae95ebd7dd9a9ebb106e3842 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sat, 25 Feb 2017 16:46:51 -0300 Subject: Simplify fragment substitution --- Data/GraphQL/AST/Transform.hs | 34 ++++++++++++++-------------------- 1 file changed, 14 insertions(+), 20 deletions(-) (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs index b08014f..af55772 100644 --- a/Data/GraphQL/AST/Transform.hs +++ b/Data/GraphQL/AST/Transform.hs @@ -7,8 +7,7 @@ import Data.Bifunctor (first) import Data.Either (partitionEithers) import Data.Foldable (fold, foldMap) import qualified Data.List.NonEmpty as NonEmpty -import Data.Maybe (maybeToList) -import Data.Monoid (Alt(Alt,getAlt)) +import Data.Monoid (Alt(Alt,getAlt), (<>)) import Data.Text (Text) @@ -22,7 +21,7 @@ type Name = Text -- empty list is returned. type Fragmenter = Name -> [Core.Field] --- TODO: Replace Maybe by Either CustomError +-- TODO: Replace Maybe by MonadThrow with CustomError document :: Schema.Subs -> Full.Document -> Maybe Core.Document document subs doc = operations subs fr ops where @@ -37,6 +36,7 @@ document subs doc = operations subs fr ops -- * Operation +-- TODO: Replace Maybe by MonadThrow CustomError operations :: Schema.Subs -> Fragmenter @@ -44,6 +44,7 @@ operations -> Maybe Core.Document operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr) +-- TODO: Replace Maybe by MonadThrow CustomError operation :: Schema.Subs -> Fragmenter @@ -57,17 +58,17 @@ operation subs fr (Full.OperationDefinition ot _n _vars _dirs sels) = Full.Query -> Core.Query <$> node Full.Mutation -> Core.Mutation <$> node where - node = traverse (hush <=< selection subs fr) sels + node = traverse (hush . selection subs fr) sels selection :: Schema.Subs -> Fragmenter -> Full.Selection - -> Maybe (Either [Core.Field] Core.Field) + -> Either [Core.Field] Core.Field selection subs fr (Full.SelectionField fld) = - Right <$> field subs fr fld + Right $ field subs fr fld selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) = - Just . Left $ fr n + Left $ fr n selection _ _ (Full.SelectionInlineFragment _) = error "Inline fragments not supported yet" @@ -88,23 +89,16 @@ fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' = -- TODO: Support fragments within fragments. Fold instead of map. if name == name' - then either id pure =<< maybeToList - =<< NonEmpty.toList (selection subs mempty <$> sels) + then either id pure =<< NonEmpty.toList (selection subs mempty <$> sels) else empty -field :: Schema.Subs -> Fragmenter -> Full.Field -> Maybe Core.Field +field :: Schema.Subs -> Fragmenter -> Full.Field -> Core.Field field subs fr (Full.Field a n args _dirs sels) = - Core.Field a n (fold $ argument subs `traverse` args) - -- TODO: hush should error when fragments are not defined in a field - <$> traverse (hush <=< selection subs fr) (foldr go empty sels) + Core.Field a n (fold $ argument subs `traverse` args) (foldr go empty sels) where - go :: Full.Selection -> Full.SelectionSetOpt -> Full.SelectionSetOpt - go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) acc = - (Full.SelectionField . full <$> fr name) ++ acc - go x acc = x : acc - - full :: Core.Field -> Full.Field - full (Core.Field a' n' _args' _sels') = Full.Field a' n' empty empty [] + go :: Full.Selection -> [Core.Field] -> [Core.Field] + go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) = (fr name <>) + go sel = (either id pure (selection subs fr sel) <>) argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument argument subs (Full.Argument n v) = Core.Argument n <$> value subs v -- cgit v1.2.3