forked from OSS/graphql
Garden
This commit is contained in:
parent
7131d1c142
commit
a6b2fd297b
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -1,4 +1,4 @@
|
||||
resolver: lts-5.2
|
||||
resolver: lts-5.3
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps: []
|
||||
|
Loading…
Reference in New Issue
Block a user