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.
This commit is contained in:
Danny Navarro 2017-01-29 18:44:03 -03:00
parent f35e1f949a
commit 693b7d18dc
No known key found for this signature in database
GPG Key ID: 81E5F99780FA6A32
5 changed files with 92 additions and 11 deletions

View File

@ -23,8 +23,9 @@ data Argument = Argument Name Value deriving (Eq,Show)
data Value = ValueInt Int32 data Value = ValueInt Int32
-- GraphQL Float is double precision -- GraphQL Float is double precision
| ValueFloat Double | ValueFloat Double
| ValueBoolean Bool
| ValueString Text | ValueString Text
| ValueBoolean Bool
| ValueNull
| ValueEnum Name | ValueEnum Name
| ValueList [Value] | ValueList [Value]
| ValueObject [ObjectField] | ValueObject [ObjectField]

View File

@ -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

View File

@ -10,17 +10,10 @@ import qualified Data.Aeson as Aeson
import qualified Data.GraphQL.AST as AST import qualified Data.GraphQL.AST as AST
import qualified Data.GraphQL.AST.Core as AST.Core import qualified Data.GraphQL.AST.Core as AST.Core
import qualified Data.GraphQL.AST.Transform as Transform
import Data.GraphQL.Schema (Schema) import Data.GraphQL.Schema (Schema)
import qualified Data.GraphQL.Schema as Schema import qualified Data.GraphQL.Schema as Schema
core :: Schema.Subs -> AST.Document -> AST.Core.Document
core subs ((AST.DefinitionOperation opDef) :| []) = error "Not implemented yet"
core _ ((AST.DefinitionFragment fragDef) :| []) =
error "Fragment definitions not supported yet"
core _ _ = error "Multiple definitions not supported yet"
-- | Takes a 'Schema', a variable substitution function ('Schema.Subs'), and a -- | Takes a 'Schema', a variable substitution function ('Schema.Subs'), and a
-- @GraphQL@ 'document'. The substitution is applied to the document using -- @GraphQL@ 'document'. The substitution is applied to the document using
-- 'rootFields', and the 'Schema''s resolvers are applied to the resulting fields. -- 'rootFields', and the 'Schema''s resolvers are applied to the resulting fields.
@ -30,7 +23,7 @@ core _ _ = error "Multiple definitions not supported yet"
execute execute
:: Alternative f :: Alternative f
=> Schema f -> Schema.Subs -> AST.Document -> f Aeson.Value => Schema f -> Schema.Subs -> AST.Document -> f Aeson.Value
execute schema subs doc = document schema $ core subs doc execute schema subs doc = document schema $ Transform.document subs doc
document :: Alternative f => Schema f -> AST.Core.Document -> f Aeson.Value document :: Alternative f => Schema f -> AST.Core.Document -> f Aeson.Value
document schema (op :| [])= operation schema op document schema (op :| [])= operation schema op

View File

@ -26,6 +26,7 @@ library
exposed-modules: Data.GraphQL exposed-modules: Data.GraphQL
Data.GraphQL.AST Data.GraphQL.AST
Data.GraphQL.AST.Core Data.GraphQL.AST.Core
Data.GraphQL.AST.Transform
Data.GraphQL.Execute Data.GraphQL.Execute
Data.GraphQL.Encoder Data.GraphQL.Encoder
Data.GraphQL.Error Data.GraphQL.Error