diff --git a/CHANGELOG.md b/CHANGELOG.md index e88559f..2700497 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,8 @@ and this project adheres to - `Schema.wrappedScalarA`. - `Schema.wrappedObjectA`. - `Schema.objectA`. +- `AST.Argument`. Replaced with `AST.Arguments` which holds all arguments as a + key/value map. ## [0.6.1.0] - 2019-12-23 ### Fixed diff --git a/semaphoreci.sh b/semaphoreci.sh index c14bd56..eb9ef38 100755 --- a/semaphoreci.sh +++ b/semaphoreci.sh @@ -8,7 +8,12 @@ setup() { then curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C $SEMAPHORE_CACHE_DIR '*/stack' fi + if [ -e "$SEMAPHORE_CACHE_DIR/graphql.cabal" ] + then + cp -a $SEMAPHORE_CACHE_DIR/graphql.cabal graphql.cabal + fi $STACK --no-terminal setup + cp -a graphql.cabal $SEMAPHORE_CACHE_DIR/graphql.cabal } setup_test() { diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index 7ba4830..084ae21 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -1,7 +1,6 @@ -- | This is the AST meant to be executed. module Language.GraphQL.AST.Core ( Alias - , Argument(..) , Arguments(..) , Directive(..) , Document @@ -35,16 +34,19 @@ data Operation -- | Single GraphQL field. data Field - = Field (Maybe Alias) Name [Argument] (Seq Selection) + = Field (Maybe Alias) Name Arguments (Seq Selection) deriving (Eq, Show) --- | Single argument. -data Argument = Argument Name Value deriving (Eq, Show) - -- | Argument list. newtype Arguments = Arguments (HashMap Name Value) deriving (Eq, Show) +instance Semigroup Arguments where + (Arguments x) <> (Arguments y) = Arguments $ x <> y + +instance Monoid Arguments where + mempty = Arguments mempty + -- | Directive. data Directive = Directive Name Arguments deriving (Eq, Show) diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index a85e451..5a9eef8 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -60,7 +60,6 @@ operations operations' = do operation :: Full.OperationDefinition -> TransformT Core.Operation operation (Full.SelectionSet 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) @@ -73,7 +72,7 @@ selection :: TransformT (Either (Seq Core.Selection) Core.Selection) selection (Full.Field alias name arguments' directives' selections) = maybe (Left mempty) (Right . Core.SelectionField) <$> do - fieldArguments <- traverse argument arguments' + fieldArguments <- arguments arguments' fieldSelections <- appendSelection selections fieldDirectives <- Directive.selection <$> directives directives' let field' = Core.Field alias name fieldArguments fieldSelections @@ -147,12 +146,9 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do arguments :: [Full.Argument] -> TransformT Core.Arguments arguments = fmap Core.Arguments . foldM go HashMap.empty where - go arguments' argument' = do - (Core.Argument name value') <- argument argument' - return $ HashMap.insert name value' arguments' - -argument :: Full.Argument -> TransformT Core.Argument -argument (Full.Argument n v) = Core.Argument n <$> value v + go arguments' (Full.Argument name value') = do + substitutedValue <- value value' + return $ HashMap.insert name substitutedValue arguments' value :: Full.Value -> TransformT Core.Value value (Full.Variable name) = lift (asks $ HashMap.lookup name) >>= lift . lift diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index a6c37db..8bdf605 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -12,7 +12,6 @@ module Language.GraphQL.Schema , wrappedScalar -- * AST Reexports , Field - , Argument(..) , Value(..) ) where @@ -90,11 +89,7 @@ resolveFieldValue f resolveRight fld@(Field _ _ args _) = do result <- lift $ reader . runExceptT . runActionT $ f either resolveLeft (resolveRight fld) result where - reader = flip runReaderT - $ Context - $ HashMap.fromList - $ argumentToTuple <$> args - argumentToTuple (Argument name value) = (name, value) + reader = flip runReaderT $ Context {arguments=args} resolveLeft err = do _ <- addErrMsg err return $ HashMap.singleton (aliasOrName fld) Aeson.Null diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs index 3eef904..24752a2 100644 --- a/src/Language/GraphQL/Trans.hs +++ b/src/Language/GraphQL/Trans.hs @@ -1,7 +1,7 @@ -- | Monad transformer stack used by the @GraphQL@ resolvers. module Language.GraphQL.Trans ( ActionT(..) - , Context(Context) + , Context(..) , argument ) where @@ -11,7 +11,6 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT, asks) -import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -19,7 +18,9 @@ import Language.GraphQL.AST.Core import Prelude hiding (lookup) -- | Resolution context holds resolver arguments. -newtype Context = Context (HashMap Name Value) +newtype Context = Context + { arguments :: Arguments + } -- | Monad transformer stack used by the resolvers to provide error handling -- and resolution context (resolver arguments). @@ -57,7 +58,7 @@ instance Monad m => MonadPlus (ActionT m) where -- be optional then). argument :: MonadIO m => Name -> ActionT m Value argument argumentName = do - argumentValue <- ActionT $ lift $ asks lookup + argumentValue <- ActionT $ lift $ asks $ lookup . arguments pure $ fromMaybe Null argumentValue where - lookup (Context argumentMap) = HashMap.lookup argumentName argumentMap + lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap