diff options
| author | Danny Navarro <j@dannynavarro.net> | 2016-01-26 12:43:18 +0100 |
|---|---|---|
| committer | Danny Navarro <j@dannynavarro.net> | 2016-01-26 12:43:18 +0100 |
| commit | bb685c9afa740091864220616ecd84d9329bee98 (patch) | |
| tree | e01009704534a6ce278b6c81c7649c533e2bc87a /Data/GraphQL/Execute.hs | |
| parent | 4e5dc3433a53c2e0404fd2adb9fb33c898d1afa6 (diff) | |
| download | graphql-bb685c9afa740091864220616ecd84d9329bee98.tar.gz | |
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.
Diffstat (limited to 'Data/GraphQL/Execute.hs')
| -rw-r--r-- | Data/GraphQL/Execute.hs | 22 |
1 files changed, 19 insertions, 3 deletions
diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index 06dc9a6..40eb122 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -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" |
