graphql/Data/GraphQL/Execute.hs

43 lines
1.3 KiB
Haskell
Raw Normal View History

{-# LANGUAGE CPP #-}
2016-02-17 13:13:01 +01:00
module Data.GraphQL.Execute (execute) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Applicative (Alternative)
import Data.Maybe (catMaybes)
import qualified Data.Aeson as Aeson
import Data.GraphQL.AST
import Data.GraphQL.Schema (Schema(..))
import qualified Data.GraphQL.Schema as Schema
2016-02-17 13:13:01 +01:00
execute
:: Alternative m
2016-02-17 13:13:01 +01:00
=> Schema m -> Schema.Subs -> Document -> m Aeson.Value
execute (Schema resolvm) subs =
fmap Aeson.toJSON . Schema.withFields resolvm . rootFields subs
rootFields :: Schema.Subs -> Document -> [Field]
rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
Schema.fields $ substitute subs <$> sels
rootFields _ _ = []
substitute :: Schema.Subs -> Selection -> Selection
substitute subs (SelectionField (Field alias name args directives sels)) =
SelectionField $ Field
alias
name
-- TODO: Get rid of `catMaybes`, invalid arguments should raise an error
(catMaybes $ subsArg subs <$> args)
directives
(substitute subs <$> sels)
substitute _ sel = sel
-- TODO: Support different value types
subsArg :: Schema.Subs -> Argument -> Maybe Argument
subsArg subs (Argument n (ValueVariable (Variable v))) =
Argument n . ValueString . StringValue <$> subs v
subsArg _ arg = Just arg