diff options
Diffstat (limited to 'Data/GraphQL')
| -rw-r--r-- | Data/GraphQL/Execute.hs | 22 | ||||
| -rw-r--r-- | Data/GraphQL/Schema.hs | 23 |
2 files changed, 21 insertions, 24 deletions
diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index 0af3e7f..b843f07 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -1,10 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE LambdaCase #-} module Data.GraphQL.Execute where #if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) +import Control.Applicative (Applicative, (<$>), pure) #endif +import Control.Applicative (Alternative, empty) import qualified Data.Aeson as Aeson @@ -13,20 +15,20 @@ import Data.GraphQL.Schema type Response = Aeson.Value -execute :: Schema -> Document -> Maybe Response +execute :: (Alternative f, Monad f) => Schema f -> Document -> f Response execute (Schema resolv0) doc = go resolv0 =<< root doc where - - root :: Document -> Maybe Selection - root (Document [DefinitionOperation (Query (Node _ _ _ [sel]))]) = Just sel + root :: Applicative f => Document -> f Selection + root (Document [DefinitionOperation (Query (Node _ _ _ [sel]))]) = pure sel root _ = error "root: Not implemented yet" - go :: Resolver -> Selection -> Maybe Response + go :: (Alternative f, Monad f) => Resolver f -> Selection -> f 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 + resolv (InputField n) >>= \case + (OutputScalar s) -> + if null sfs + then (\s' -> Aeson.Object [(n, Aeson.toJSON s')]) <$> s + else empty (OutputResolver resolv') -> (\r-> Aeson.Object [(n, r)]) <$> go resolv' (head sfs) _ -> error "go case resolv: Not implemented yet" go _ _ = error "go: Not implemented yet" diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 795bb19..a4ba0ca 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -1,27 +1,22 @@ module Data.GraphQL.Schema where import Data.Maybe (catMaybes) -import Text.Show.Functions () import Data.Text (Text) import Data.Aeson (ToJSON(toJSON)) --- TODO: Support side-effects +data Schema f = Schema (QueryRoot f) -- (Maybe MutationRoot) -data Schema = Schema QueryRoot -- (Maybe MutationRoot) +type QueryRoot f = Resolver f -type QueryRoot = Resolver +type Resolver f = Input -> f (Output f) -type Resolver = Input -> Output - -data Output = OutputResolver Resolver - | OutputList [Output] - | OutputScalar Scalar - -- | OutputUnion [Output] - -- | OutputEnum [Scalar] - -- | OutputNonNull (Output) - | OutputError - deriving (Show) +data Output f = OutputResolver (Resolver f) + | OutputList (f [Output f]) + | OutputScalar (f Scalar) + -- | OutputUnion [Output] + -- | OutputEnum [Scalar] + -- | OutputNonNull (Output) data Input = InputScalar Scalar | InputField Text |