Rough implementation of execute
The first end-to-end test taken from `graphql-js` passes but this still needs to be extended to support more general cases. - `Data.GraphQL.Schema` has been heavily modified to support the execution model. More drastic changes are expected in this module. - When defining a `Schema` ordinary functions taking fields as input are being used instead of maps. This makes the implementation of `execute` easier, and, arguably, makes `Schema` definitions more *Haskellish*. - Drop explicit `unordered-containers` dependency. `Aeson.Value`s and field functions should be good enough for now.
This commit is contained in:
@ -1,16 +1,32 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
module Data.GraphQL.Execute where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative (Applicative)
|
||||
#endif
|
||||
|
||||
import qualified Data.Aeson as Aeson (Value)
|
||||
import qualified Data.Aeson as Aeson
|
||||
|
||||
import Data.GraphQL.AST
|
||||
import Data.GraphQL.Schema
|
||||
|
||||
type Response = Aeson.Value
|
||||
|
||||
execute :: Applicative f => Schema f -> Document -> f Response
|
||||
execute _schema _doc = undefined
|
||||
execute :: Schema -> Document -> Maybe Response
|
||||
execute (Schema resolv0) doc = go resolv0 =<< root doc
|
||||
where
|
||||
|
||||
root :: Document -> Maybe Selection
|
||||
root (Document [DefinitionOperation (Query (Node _ _ _ [sel]))]) = Just sel
|
||||
root _ = error "root: Not implemented yet"
|
||||
|
||||
go :: Resolver -> Selection -> Maybe Response
|
||||
go resolv (SelectionField (Field _ n _ _ sfs)) =
|
||||
case resolv (InputField n) of
|
||||
(OutputScalar s) -> if null sfs
|
||||
then Just $ Aeson.Object [(n, Aeson.toJSON s)]
|
||||
else Nothing
|
||||
(OutputResolver resolv') -> (\r-> Aeson.Object [(n, r)]) <$> go resolv' (head sfs)
|
||||
_ -> error "go case resolv: Not implemented yet"
|
||||
go _ _ = error "go: Not implemented yet"
|
||||
|
@ -1,33 +1,48 @@
|
||||
module Data.GraphQL.Schema where
|
||||
|
||||
import Data.Maybe (catMaybes)
|
||||
import Text.Show.Functions ()
|
||||
|
||||
import Data.Text (Text)
|
||||
import Data.HashMap.Lazy (HashMap)
|
||||
import Data.Aeson (ToJSON(toJSON))
|
||||
|
||||
data Schema f = Schema (QueryRoot f) (Maybe (MutationRoot f))
|
||||
data Schema = Schema QueryRoot -- (Maybe MutationRoot)
|
||||
|
||||
type QueryRoot f = Map f
|
||||
type QueryRoot = Resolver
|
||||
|
||||
type MutationRoot f = Map f
|
||||
type Resolver = Input -> Output
|
||||
|
||||
type Map f = HashMap Text (Resolver f)
|
||||
|
||||
type Resolver f = Input -> Output f
|
||||
|
||||
data Output f = OutputScalar (f Scalar)
|
||||
| OutputMap (Map f)
|
||||
| OutputUnion [Map f]
|
||||
| OutputEnum (f Scalar)
|
||||
| OutputList [Output f]
|
||||
| OutputNonNull (Output f)
|
||||
| InputError
|
||||
data Output = OutputResolver Resolver
|
||||
| OutputList [Output]
|
||||
| OutputScalar Scalar
|
||||
-- | OutputUnion [Output]
|
||||
-- | OutputEnum [Scalar]
|
||||
-- | OutputNonNull (Output)
|
||||
| OutputError
|
||||
deriving (Show)
|
||||
|
||||
data Input = InputScalar Scalar
|
||||
| InputEnum Scalar
|
||||
| InputField Text
|
||||
| InputList [Input]
|
||||
| InputNonNull Input
|
||||
deriving (Show)
|
||||
|
||||
data Scalar = ScalarInt Int
|
||||
| ScalarFloat Double
|
||||
| ScalarString Text
|
||||
| ScalarBool Bool
|
||||
| ScalarID Text
|
||||
field :: Input -> Maybe Text
|
||||
field (InputField x) = Just x
|
||||
field _ = Nothing
|
||||
|
||||
fields :: [Input] -> [Text]
|
||||
fields = catMaybes . fmap field
|
||||
|
||||
data Scalar = ScalarInt Int
|
||||
| ScalarFloat Double
|
||||
| ScalarString Text
|
||||
| ScalarBoolean Bool
|
||||
| ScalarID Text
|
||||
deriving (Show)
|
||||
|
||||
instance ToJSON Scalar where
|
||||
toJSON (ScalarInt x) = toJSON x
|
||||
toJSON (ScalarFloat x) = toJSON x
|
||||
toJSON (ScalarString x) = toJSON x
|
||||
toJSON (ScalarBoolean x) = toJSON x
|
||||
toJSON (ScalarID x) = toJSON x
|
||||
|
Reference in New Issue
Block a user