diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index 1f921aa..1abda00 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -module Data.GraphQL.Execute where +module Data.GraphQL.Execute (execute) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), pure) @@ -17,20 +17,28 @@ import Data.GraphQL.AST import Data.GraphQL.Schema (Resolver, Schema(..)) import qualified Data.GraphQL.Schema as Schema -execute :: (Alternative m, Monad m) => Schema m -> Schema.Subs -> Document -> m Aeson.Value +execute + :: (Alternative m, Monad m) + => Schema m -> Schema.Subs -> Document -> m Aeson.Value execute (Schema resolv) f doc = selectionSet f resolv =<< query doc query :: Alternative f => Document -> f SelectionSet -query (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) = - pure sels +query (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) = pure sels query _ = empty -selectionSet :: Alternative f => Schema.Subs -> Resolver f -> SelectionSet -> f Aeson.Value -selectionSet f resolv = fmap (Aeson.Object . fold) . traverse (selection f resolv) +selectionSet + :: Alternative f + => Schema.Subs -> Resolver f -> SelectionSet -> f Aeson.Value +selectionSet f resolv = fmap (Aeson.Object . fold) + . traverse (selection f resolv) -selection :: Alternative f => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object +selection + :: Alternative f + => Schema.Subs -> Resolver f -> Selection -> f Aeson.Object selection f resolv (SelectionField field@(Field alias name _ _ _)) = - fmap (HashMap.singleton aliasOrName) $ Aeson.toJSON <$> resolv (fieldToInput f field) + fmap (HashMap.singleton aliasOrName) + $ Aeson.toJSON + <$> resolv (fieldToInput f field) where aliasOrName = if T.null alias then name else alias selection _ _ _ = empty @@ -48,6 +56,7 @@ argument _ _ = error "argument: not implemented yet" fieldToInput :: Schema.Subs -> Field -> Schema.Input fieldToInput f (Field _ n as _ sels) = + -- TODO: Get rid of `catMaybes`, invalid arguments should raise an error Schema.InputField n (catMaybes $ argument f <$> as) (fieldToInput f . selectionToField <$> sels) diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 8d63696..4ec3748 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -10,7 +10,7 @@ import Data.Aeson (ToJSON(toJSON)) import Data.HashMap.Strict (HashMap) import Data.Text (Text, pack) -data Schema f = Schema (QueryRoot f) -- (Maybe MutationRoot) +data Schema f = Schema (QueryRoot f) type QueryRoot f = Resolver f @@ -21,8 +21,6 @@ data Output = OutputObject (HashMap Text Output) | OutputScalar Scalar | OutputEnum Text deriving (Show) - -- | OutputUnion [Output] - -- | OutputNonNull (Output) type Argument = (Text, Scalar) @@ -31,7 +29,7 @@ type Subs = Text -> Maybe Scalar data Input = InputField Text [Argument] [Input] deriving (Show) --- TODO: Make ScalarInt Int32 +-- TODO: GraphQL spec for Integer Scalar is 32bits data Scalar = ScalarInt Int | ScalarFloat Double | ScalarString Text @@ -40,7 +38,7 @@ data Scalar = ScalarInt Int deriving (Show) instance IsString Scalar where - fromString = ScalarString . pack + fromString = ScalarString . pack instance ToJSON Scalar where toJSON (ScalarInt x) = toJSON x diff --git a/stack.yaml b/stack.yaml index ed928ac..93788d8 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-5.2 +resolver: lts-5.3 packages: - '.' extra-deps: []