@@ -9,13 +9,14 @@ import Prelude
99
1010import Control.Lazy (class Lazy)
1111import Control.Monad.Error.Class (class MonadError, catchError)
12+import Control.Parallel (class Parallel, parallel, sequential)
1213import Data.Argonaut as Json
1314import Data.Either (Either)
1415import Data.List (List, singleton)
1516import Data.Map (Map, lookup)
1617import Data.Maybe (Maybe(..), fromMaybe)
1718import Data.Newtype (class Newtype, unwrap)
18−import Data.Traversable (traverse)
19+import Data.Traversable (sequence, traverse)
1920import Data.Tuple (Tuple(..))
2021import Effect.Exception (Error, message)
2122import GraphQL.Execution.Result (Result(..))
@@ -40,32 +41,15 @@ instance graphqlTypeObjectType :: GraphQLType (ObjectType m) where
4041 introspect (ObjectType configFn) = (configFn unit).introspection
4142
4243
43−instance outputTypeObjectType :: (MonadError Error m) => OutputType m (ObjectType m) where
44+instance (MonadError Error m, Parallel f m) => OutputType m (ObjectType m) where
45+ -- output :: forall t a. t a -> Maybe AST.SelectionSetNode -> ExecutionContext -> m a -> m Result
4446 output (ObjectType fno) (Just (AST.SelectionSetNode { selections })) execCtx mValue = do
4547 value <- mValue
46− let serializeField node@(AST.FieldNode fld) =
47− let (AST.NameNode { value: name }) = fld.name
48− (AST.NameNode { value: alias }) = fromMaybe fld.name fld.alias
49− o = fno unit
50− in case lookup name o.fields of
51− Just (ExecutableField { execute }) ->
52− Tuple alias <$>
53− (flip catchError (message >>> ResultError >>> pure) $
54− execute value node execCtx)
55− Nothing ->
56− if
57− name == "__typename"
58− then
59− pure $ Tuple alias $ ResultLeaf $ Json.fromString o.name
60− else
61− pure $ Tuple alias $
62− ResultError ("Unknown field `" <> name <> "` on type `" <> o.name <> "`.")
63− -- TODO: This branch needs fixing. It is for fragment spreads and so on. Maybe normalise
64− -- the query first and completely eliminate the branch...
65− serializeField _ = pure $ Tuple "unknown" $ ResultError "Unexpected fragment spread!"
66− ResultObject <$> traverse serializeField (selections >>= collectField)
48+ let allFields = selections >>= collectField
49+ let resolvingFields = serializeField value <$> allFields
50+ map ResultObject $ (sequential :: f ~> m) $ sequence $ (parallel :: m ~> f ) <$> resolvingFields
6751 where
68− -- Flatten the selection node structure by spreading all fragments into the list
52+ -- | Flatten the selection node structure by spreading all fragments into the list
6953 collectField :: AST.SelectionNode -> List AST.SelectionNode
7054 collectField n@(AST.FieldNode _) = singleton n
7155 collectField (AST.InlineFragmentNode {
@@ -78,6 +62,28 @@ instance outputTypeObjectType :: (MonadError Error m) => OutputType m (ObjectTyp
7862 }) -> collectField =<< s
7963 _ -> mempty
8064
65+ -- serializeField :: a -> AST.SelectionNode -> m (Tuple String Result)
66+ serializeField value node@(AST.FieldNode fld) = do
67+ let (AST.NameNode { value: name }) = fld.name
68+ let (AST.NameNode { value: alias }) = fromMaybe fld.name fld.alias
69+ let o = fno unit
70+ case lookup name o.fields of
71+ Just (ExecutableField { execute }) ->
72+ Tuple alias <$>
73+ (flip catchError (message >>> ResultError >>> pure) $
74+ execute value node execCtx)
75+ Nothing ->
76+ if
77+ name == "__typename"
78+ then
79+ pure $ Tuple alias $ ResultLeaf $ Json.fromString o.name
80+ else
81+ pure $ Tuple alias $
82+ ResultError ("Unknown field `" <> name <> "` on type `" <> o.name <> "`.")
83+ -- TODO: This branch needs fixing. It is for fragment spreads and so on. Maybe normalise
84+ -- the query first and completely eliminate the branch...
85+ serializeField _ _ = pure $ Tuple "unknown" $ ResultError "Unexpected fragment spread!"
86+
8187 output _ _ _ _ = pure $ ResultError "Missing subselection on object type."
8288
8389