diff options
| author | Danny Navarro <j@dannynavarro.net> | 2017-02-19 15:29:58 -0300 |
|---|---|---|
| committer | Danny Navarro <j@dannynavarro.net> | 2017-02-23 15:29:58 -0300 |
| commit | d2c138f8d16acadb8ae2ba410484d985dde1e37c (patch) | |
| tree | 19e51376737f5197922e93c1b4539a10377f5f81 /Data/GraphQL | |
| parent | 39731ff2338d74bfabf9863fb5921e8f255858dd (diff) | |
| download | graphql-d2c138f8d16acadb8ae2ba410484d985dde1e37c.tar.gz | |
Add basic Fragment Support
Only field names are supported for now.
Diffstat (limited to 'Data/GraphQL')
| -rw-r--r-- | Data/GraphQL/AST/Transform.hs | 18 | ||||
| -rw-r--r-- | Data/GraphQL/Execute.hs | 2 |
2 files changed, 15 insertions, 5 deletions
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 diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index fe78323..7609561 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -28,7 +28,7 @@ execute execute schema subs doc = document schema =<< maybe empty pure (Transform.document subs doc) document :: Alternative f => Schema f -> AST.Core.Document -> f Aeson.Value -document schema (op :| [])= operation schema op +document schema (op :| []) = operation schema op document _ _ = error "Multiple operations not supported yet" operation :: Alternative f => Schema f -> AST.Core.Operation -> f Aeson.Value |