blob: 4d0d4f3ec3fbb39108133095745875a8daa205bc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Language.GraphQL.Foundation
( module Language.GraphQL.Serialize
, graphql
) where
import Language.GraphQL.Serialize
import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.HashMap.Strict (HashMap)
import qualified Data.Aeson.KeyMap as KeyMap
import Data.Maybe (catMaybes)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Language.GraphQL as GraphQL
import Language.GraphQL.AST
import Language.GraphQL.Error
import Language.GraphQL.Type.Schema (Schema)
import Data.Bifunctor (Bifunctor(..))
-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
graphql :: MonadCatch m
=> Schema m -- ^ Resolvers.
-> Text -- ^ Text representing a @GraphQL@ request document.
-> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphql schema = fmap (bimap stream formatResponse)
. GraphQL.graphql schema mempty (mempty :: HashMap Name JSON)
where
stream :: ResponseEventStream m JSON -> ResponseEventStream m Aeson.Value
stream = undefined
formatResponse :: Response JSON -> Aeson.Object
formatResponse Response{ errors, data' = JSON json } =
let dataResponse = KeyMap.singleton "data" json
in case errors of
Seq.Empty -> dataResponse
_ -> flip (KeyMap.insert "errors") dataResponse
$ Aeson.Array $ foldr fromError mempty errors
fromError :: Error -> Vector Aeson.Value -> Vector Aeson.Value
fromError Error{..} = Vector.cons $ Aeson.object $ catMaybes
[ Just ("message", Aeson.String message)
, toMaybe fromLocation "locations" locations
, toMaybe fromPath "path" path
]
fromPath (Segment segment) = Aeson.String segment
fromPath (Index index) = Aeson.toJSON index
fromLocation Location{..} = Aeson.object
[ ("line", Aeson.toJSON line)
, ("column", Aeson.toJSON column)
]
toMaybe _ _ [] = Nothing
toMaybe f key xs = Just (key, Aeson.listValue f xs)
|
