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/Schema.hs | 59 ++++++++++++++++++++------------------------------ 1 file changed, 23 insertions(+), 36 deletions(-) (limited to 'Data/GraphQL/Schema.hs') diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index b8668d9..2198362 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -3,7 +3,7 @@ -- | This module provides a representation of a @GraphQL@ Schema in addition to -- functions for defining and manipulating Schemas. module Data.GraphQL.Schema - ( Schema(..) + ( Schema , Resolver , Subs , object @@ -15,31 +15,31 @@ module Data.GraphQL.Schema , enum , enumA , resolvers - , fields -- * AST Reexports , Field , Argument(..) , Value(..) ) where -import Data.Bifunctor (first) -import Data.Monoid (Alt(Alt,getAlt)) import Control.Applicative (Alternative((<|>), empty)) -import Data.Maybe (catMaybes) +import Data.Bifunctor (first) import Data.Foldable (fold) +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe) +import Data.Monoid (Alt(Alt,getAlt)) import qualified Data.Aeson as Aeson import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) -import qualified Data.Text as T (null, unwords) +import qualified Data.Text as T (unwords) -import Data.GraphQL.AST +import Data.GraphQL.AST.Core import Data.GraphQL.Error -- | A GraphQL schema. -- @f@ is usually expected to be an instance of 'Alternative'. -data Schema f = Schema [Resolver f] +type Schema f = NonEmpty (Resolver f) -- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information -- (or 'empty'). @f@ is usually expected to be an instance of 'Alternative'. @@ -48,18 +48,16 @@ type Resolver f = Field -> CollectErrsT f Aeson.Object -- | Variable substitution function. type Subs = Text -> Maybe Text --- | Create a named 'Resolver' from a list of 'Resolver's. -object :: Alternative f => Text -> [Resolver f] -> Resolver f +object :: Alternative f => Name -> [Resolver f] -> Resolver f object name resolvs = objectA name $ \case - [] -> resolvs - _ -> empty + [] -> resolvs + _ -> empty -- | Like 'object' but also taking 'Argument's. objectA :: Alternative f - => Text -> ([Argument] -> [Resolver f]) -> Resolver f -objectA name f fld@(Field _ _ args _ sels) = - withField name (resolvers (f args) $ fields sels) fld + => Name -> ([Argument] -> [Resolver f]) -> Resolver f +objectA name f fld@(Field _ _ args sels) = withField name (resolvers (f args) sels) fld -- | A scalar represents a primitive value, like a string or an integer. scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f @@ -70,11 +68,10 @@ scalar name s = scalarA name $ \case -- | Like 'scalar' but also taking 'Argument's. scalarA :: (Alternative f, Aeson.ToJSON a) - => Text -> ([Argument] -> f a) -> Resolver f -scalarA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld + => Name -> ([Argument] -> f a) -> Resolver f +scalarA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld scalarA _ _ _ = empty --- | Like 'object' but taking lists of 'Resolver's instead of a single list. array :: Alternative f => Text -> [[Resolver f]] -> Resolver f array name resolvs = arrayA name $ \case [] -> resolvs @@ -84,8 +81,8 @@ array name resolvs = arrayA name $ \case arrayA :: Alternative f => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f -arrayA name f fld@(Field _ _ args _ sels) = - withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ f args) fld +arrayA name f fld@(Field _ _ args sels) = + withField name (joinErrs $ traverse (`resolvers` sels) $ f args) fld -- | Represents one of a finite set of possible values. -- Used in place of a 'scalar' when the possible responses are easily enumerable. @@ -96,19 +93,19 @@ enum name enums = enumA name $ \case -- | Like 'enum' but also taking 'Argument's. enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f -enumA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld +enumA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld enumA _ _ _ = empty -- | Helper function to facilitate 'Argument' handling. withField :: (Alternative f, Aeson.ToJSON a) - => Text -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value) -withField name f (Field alias name' _ _ _) = + => Name -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value) +withField name f (Field alias name' _ _) = if name == name' then fmap (first $ HashMap.singleton aliasOrName . Aeson.toJSON) f else empty where - aliasOrName = if T.null alias then name' else alias + aliasOrName = fromMaybe name' alias -- | Takes a list of 'Resolver's and a list of 'Field's and applies each -- 'Resolver' to each 'Field'. Resolves into a value containing the @@ -118,18 +115,8 @@ resolvers resolvs = fmap (first Aeson.toJSON . fold) . traverse (\fld -> getAlt (foldMap (Alt . ($ fld)) resolvs) <|> errmsg fld) where - errmsg (Field alias name _ _ _) = addErrMsg msg $ (errWrap . pure) val + errmsg (Field alias name _ _) = addErrMsg msg $ (errWrap . pure) val where val = HashMap.singleton aliasOrName Aeson.Null msg = T.unwords ["field", name, "not resolved."] - aliasOrName = if T.null alias then name else alias - --- | Checks whether the given 'Selection' contains a 'Field' and --- returns the 'Field' if so, else returns 'Nothing'. -field :: Selection -> Maybe Field -field (SelectionField x) = Just x -field _ = Nothing - --- | Returns a list of the 'Field's contained in the given 'SelectionSet'. -fields :: SelectionSet -> [Field] -fields = catMaybes . fmap field + aliasOrName = fromMaybe name alias -- cgit v1.2.3 From f35e1f949ab3ee718ab773baf9f38ac411d49a28 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 29 Jan 2017 12:53:15 -0300 Subject: Define Schema using Core AST Also, temporarily remove error reporting to simplify execution. This should be restored once the new execution model is nailed. --- Data/GraphQL/Schema.hs | 74 ++++++++++++++++++++++++-------------------------- 1 file changed, 36 insertions(+), 38 deletions(-) (limited to 'Data/GraphQL/Schema.hs') diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 2198362..aa25046 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} -- | This module provides a representation of a @GraphQL@ Schema in addition to -- functions for defining and manipulating Schemas. @@ -14,15 +13,14 @@ module Data.GraphQL.Schema , arrayA , enum , enumA - , resolvers + , resolve -- * AST Reexports , Field , Argument(..) , Value(..) ) where -import Control.Applicative (Alternative((<|>), empty)) -import Data.Bifunctor (first) +import Control.Applicative (Alternative( empty)) import Data.Foldable (fold) import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) @@ -32,10 +30,8 @@ import qualified Data.Aeson as Aeson import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) -import qualified Data.Text as T (unwords) import Data.GraphQL.AST.Core -import Data.GraphQL.Error -- | A GraphQL schema. -- @f@ is usually expected to be an instance of 'Alternative'. @@ -43,24 +39,31 @@ type Schema f = NonEmpty (Resolver f) -- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information -- (or 'empty'). @f@ is usually expected to be an instance of 'Alternative'. -type Resolver f = Field -> CollectErrsT f Aeson.Object +type Resolver f = Field -> f Aeson.Object + +type Resolvers f = [Resolver f] + +type Fields = [Field] + +type Arguments = [Argument] -- | Variable substitution function. type Subs = Text -> Maybe Text -object :: Alternative f => Name -> [Resolver f] -> Resolver f -object name resolvs = objectA name $ \case - [] -> resolvs - _ -> empty +-- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's. +object :: Alternative f => Name -> Resolvers f -> Resolver f +object name resolvers = objectA name $ \case + [] -> resolvers + _ -> empty -- | Like 'object' but also taking 'Argument's. objectA :: Alternative f - => Name -> ([Argument] -> [Resolver f]) -> Resolver f -objectA name f fld@(Field _ _ args sels) = withField name (resolvers (f args) sels) fld + => Name -> (Arguments -> Resolvers f) -> Resolver f +objectA name f fld@(Field _ _ args flds) = withField name (resolve (f args) flds) fld -- | A scalar represents a primitive value, like a string or an integer. -scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f +scalar :: (Alternative f, Aeson.ToJSON a) => Name -> a -> Resolver f scalar name s = scalarA name $ \case [] -> pure s _ -> empty @@ -68,21 +71,21 @@ scalar name s = scalarA name $ \case -- | Like 'scalar' but also taking 'Argument's. scalarA :: (Alternative f, Aeson.ToJSON a) - => Name -> ([Argument] -> f a) -> Resolver f -scalarA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld + => Name -> (Arguments -> f a) -> Resolver f +scalarA name f fld@(Field _ _ args []) = withField name (f args) fld scalarA _ _ _ = empty -array :: Alternative f => Text -> [[Resolver f]] -> Resolver f -array name resolvs = arrayA name $ \case - [] -> resolvs +array :: Alternative f => Name -> [Resolvers f] -> Resolver f +array name resolvers = arrayA name $ \case + [] -> resolvers _ -> empty -- | Like 'array' but also taking 'Argument's. arrayA :: Alternative f - => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f + => Text -> (Arguments -> [Resolvers f]) -> Resolver f arrayA name f fld@(Field _ _ args sels) = - withField name (joinErrs $ traverse (`resolvers` sels) $ f args) fld + withField name (traverse (`resolve` sels) $ f args) fld -- | Represents one of a finite set of possible values. -- Used in place of a 'scalar' when the possible responses are easily enumerable. @@ -93,30 +96,25 @@ enum name enums = enumA name $ \case -- | Like 'enum' but also taking 'Argument's. enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f -enumA name f fld@(Field _ _ args []) = withField name (errWrap $ f args) fld +enumA name f fld@(Field _ _ args []) = withField name (f args) fld enumA _ _ _ = empty -- | Helper function to facilitate 'Argument' handling. withField :: (Alternative f, Aeson.ToJSON a) - => Name -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value) + => Name -> f a -> Field -> f (HashMap Text Aeson.Value) withField name f (Field alias name' _ _) = - if name == name' - then fmap (first $ HashMap.singleton aliasOrName . Aeson.toJSON) f - else empty - where - aliasOrName = fromMaybe name' alias + if name == name' + then fmap (HashMap.singleton aliasOrName . Aeson.toJSON) f + else empty + where + aliasOrName = fromMaybe name alias + -- | Takes a list of 'Resolver's and a list of 'Field's and applies each -- 'Resolver' to each 'Field'. Resolves into a value containing the -- resolved 'Field', or a null value and error information. -resolvers :: Alternative f => [Resolver f] -> [Field] -> CollectErrsT f Aeson.Value -resolvers resolvs = - fmap (first Aeson.toJSON . fold) - . traverse (\fld -> getAlt (foldMap (Alt . ($ fld)) resolvs) <|> errmsg fld) - where - errmsg (Field alias name _ _) = addErrMsg msg $ (errWrap . pure) val - where - val = HashMap.singleton aliasOrName Aeson.Null - msg = T.unwords ["field", name, "not resolved."] - aliasOrName = fromMaybe name alias +resolve :: Alternative f => Resolvers f -> Fields -> f Aeson.Value +resolve resolvers = + fmap (Aeson.toJSON . fold) + . traverse (\fld -> getAlt (foldMap (Alt . ($ fld)) resolvers)) -- 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/Schema.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Data/GraphQL/Schema.hs') diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index aa25046..548c4eb 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -20,7 +20,7 @@ module Data.GraphQL.Schema , Value(..) ) where -import Control.Applicative (Alternative( empty)) +import Control.Applicative (Alternative(empty)) import Data.Foldable (fold) import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe) -- 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/Schema.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'Data/GraphQL/Schema.hs') diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 548c4eb..4acc4ac 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -48,7 +48,7 @@ type Fields = [Field] type Arguments = [Argument] -- | Variable substitution function. -type Subs = Text -> Maybe Text +type Subs = Name -> Maybe Value -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's. object :: Alternative f => Name -> Resolvers f -> Resolver f @@ -110,7 +110,6 @@ withField name f (Field alias name' _ _) = where aliasOrName = fromMaybe name alias - -- | Takes a list of 'Resolver's and a list of 'Field's and applies each -- 'Resolver' to each 'Field'. Resolves into a value containing the -- resolved 'Field', or a null value and error information. -- cgit v1.2.3