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:
Danny Navarro
2016-01-26 12:43:18 +01:00
parent 4e5dc3433a
commit bb685c9afa
4 changed files with 135 additions and 116 deletions

View File

@ -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"

View File

@ -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