diff --git a/cabal.project b/cabal.project index 566a70e..0742af9 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,3 @@ -packages: . +packages: . ../graphql constraints: graphql -json -tests: False diff --git a/graphql-spice.cabal b/graphql-spice.cabal index a56d044..c2efb06 100644 --- a/graphql-spice.cabal +++ b/graphql-spice.cabal @@ -32,9 +32,13 @@ library build-depends: aeson ^>= 2.0.3, base ^>=4.14.3.0, + containers ^>= 0.6.2, + exceptions ^>= 0.10.4, graphql ^>= 1.0.2, + megaparsec >= 9.0 && < 10, scientific ^>= 0.3.7, text ^>= 1.2.5, + vector ^>= 0.12.3, unordered-containers ^>= 0.2.16 default-language: Haskell2010 diff --git a/src/Language/GraphQL/Foundation.hs b/src/Language/GraphQL/Foundation.hs index 4647a47..4d0d4f3 100644 --- a/src/Language/GraphQL/Foundation.hs +++ b/src/Language/GraphQL/Foundation.hs @@ -1,5 +1,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)