OSS/graphql
1
1
Fork 1
Code Issues 5 Pull Requests Actions Releases 22 Wiki Activity

Replace substitution function with a map

Browse Source 
It makes using variables with queries more approachable, but some work
still has to be done.
- The type `Subs` should be renamed and moved out of `Schema`, together with
`AST.Core.Value` probably.
- Some kind of conversion should be possible from a user-defined input
type T to the Value. So the final HashMap should have a type like
`HashMap name a`, where a is an instance of a potential typeclass
InputType.
This commit is contained in:
Eugen Wissner 2019-12-30 18:26:24 +01:00
parent fdf5914626
commit 44dc80bb37
6 changed files with 103 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@ -16,6 +16,8 @@ and this project adheres to
can also be definitions. can also be definitions.
- Move all AST data to `AST.Document` and reexport them. - Move all AST data to `AST.Document` and reexport them.
- Rename `AST.OperationSelectionSet` to `AST.Document.SelectionSet`. - Rename `AST.OperationSelectionSet` to `AST.Document.SelectionSet`.
- Make `Schema.Subs` a `Data.HashMap.Strict` (was a function
`key -> Maybe value` before).
### Removed ### Removed
- `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`. - `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.

2
src/Language/GraphQL.hs
View File

@ -20,7 +20,7 @@ graphql :: MonadIO m
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers. => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
-> T.Text -- ^ Text representing a @GraphQL@ request document. -> T.Text -- ^ Text representing a @GraphQL@ request document.
-> m Aeson.Value -- ^ Response. -> m Aeson.Value -- ^ Response.
graphql = flip graphqlSubs $ const Nothing graphql = flip graphqlSubs mempty
-- | If the text parses correctly as a @GraphQL@ query the substitution is -- | If the text parses correctly as a @GraphQL@ query the substitution is
-- applied to the query and the query is then executed using to the given -- applied to the query and the query is then executed using to the given

6
src/Language/GraphQL/Execute/Transform.hs
View File

@ -11,7 +11,7 @@ module Language.GraphQL.Execute.Transform
import Control.Arrow (first) import Control.Arrow (first)
import Control.Monad (foldM, unless) import Control.Monad (foldM, unless)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT) import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify) import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
@ -155,9 +155,7 @@ argument :: Full.Argument -> TransformT Core.Argument
argument (Full.Argument n v) = Core.Argument n <$> value v argument (Full.Argument n v) = Core.Argument n <$> value v
value :: Full.Value -> TransformT Core.Value value :: Full.Value -> TransformT Core.Value
value (Full.Variable n) = do value (Full.Variable name) = lift (asks $ HashMap.lookup name) >>= lift . lift
substitute' <- lift ask
lift . lift $ substitute' n
value (Full.Int i) = pure $ Core.Int i value (Full.Int i) = pure $ Core.Int i
value (Full.Float f) = pure $ Core.Float f value (Full.Float f) = pure $ Core.Float f
value (Full.String x) = pure $ Core.String x value (Full.String x) = pure $ Core.String x

5
src/Language/GraphQL/Schema.hs
View File

@ -44,8 +44,9 @@ data Resolver m = Resolver
Text -- ^ Name Text -- ^ Name
(Field -> CollectErrsT m Aeson.Object) -- ^ Resolver (Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
-- | Variable substitution function. -- | Contains variables for the query. The key of the map is a variable name,
type Subs = Name -> Maybe Value -- and the value is the variable value.
type Subs = HashMap Name Value
-- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's. -- | Create a new 'Resolver' with the given 'Name' from the given 'Resolver's.
object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m

2
stack.yaml
View File

@ -1,4 +1,4 @@
resolver: lts-14.18 resolver: lts-14.19
packages: packages:
- . - .

176
tests/Test/StarWars/QuerySpec.hs
View File

@ -5,20 +5,14 @@ module Test.StarWars.QuerySpec
) where ) where
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
import Data.Aeson ( object import Data.Aeson ((.=))
, (.=) import qualified Data.HashMap.Strict as HashMap
)
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL import Language.GraphQL
import Language.GraphQL.Schema (Subs) import Language.GraphQL.Schema (Subs)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
import Test.Hspec.Expectations ( Expectation import Test.Hspec.Expectations (Expectation, shouldBe)
, shouldBe import Test.Hspec (Spec, describe, it)
)
import Test.Hspec ( Spec
, describe
, it
)
import Test.StarWars.Schema import Test.StarWars.Schema
-- * Test -- * Test
@ -34,7 +28,11 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]] $ Aeson.object
[ "data" .= Aeson.object
[ "hero" .= Aeson.object ["id" .= ("2001" :: Text)]
]
]
it "R2-D2 ID and friends" $ testQuery it "R2-D2 ID and friends" $ testQuery
[r| query HeroNameAndFriendsQuery { [r| query HeroNameAndFriendsQuery {
hero { hero {
@ -46,14 +44,14 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"hero" .= object "hero" .= Aeson.object
[ "id" .= ("2001" :: Text) [ "id" .= ("2001" :: Text)
, r2d2Name , r2d2Name
, "friends" .= , "friends" .=
[ object [lukeName] [ Aeson.object [lukeName]
, object [hanName] , Aeson.object [hanName]
, object [leiaName] , Aeson.object [leiaName]
] ]
] ]
]] ]]
@ -73,37 +71,37 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"hero" .= object [ "hero" .= Aeson.object [
"name" .= ("R2-D2" :: Text) "name" .= ("R2-D2" :: Text)
, "friends" .= [ , "friends" .= [
object [ Aeson.object [
"name" .= ("Luke Skywalker" :: Text) "name" .= ("Luke Skywalker" :: Text)
, "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text] , "appearsIn" .= ["NEWHOPE","EMPIRE","JEDI" :: Text]
, "friends" .= [ , "friends" .= [
object [hanName] Aeson.object [hanName]
, object [leiaName] , Aeson.object [leiaName]
, object [c3poName] , Aeson.object [c3poName]
, object [r2d2Name] , Aeson.object [r2d2Name]
] ]
] ]
, object [ , Aeson.object [
hanName hanName
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text] , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
, "friends" .= [ , "friends" .=
object [lukeName] [ Aeson.object [lukeName]
, object [leiaName] , Aeson.object [leiaName]
, object [r2d2Name] , Aeson.object [r2d2Name]
] ]
] ]
, object [ , Aeson.object [
leiaName leiaName
, "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text] , "appearsIn" .= [ "NEWHOPE","EMPIRE","JEDI" :: Text]
, "friends" .= [ , "friends" .=
object [lukeName] [ Aeson.object [lukeName]
, object [hanName] , Aeson.object [hanName]
, object [c3poName] , Aeson.object [c3poName]
, object [r2d2Name] , Aeson.object [r2d2Name]
] ]
] ]
] ]
@ -116,40 +114,40 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object
"human" .= object [lukeName] [ "human" .= Aeson.object [lukeName]
]] ]]
it "Luke ID with variable" $ testQueryParams it "Luke ID with variable" $ testQueryParams
(\v -> if v == "someId" then Just "1000" else Nothing) (HashMap.singleton "someId" "1000")
[r| query FetchSomeIDQuery($someId: String!) { [r| query FetchSomeIDQuery($someId: String!) {
human(id: $someId) { human(id: $someId) {
name name
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"human" .= object [lukeName] "human" .= Aeson.object [lukeName]
]] ]]
it "Han ID with variable" $ testQueryParams it "Han ID with variable" $ testQueryParams
(\v -> if v == "someId" then Just "1002" else Nothing) (HashMap.singleton "someId" "1002")
[r| query FetchSomeIDQuery($someId: String!) { [r| query FetchSomeIDQuery($someId: String!) {
human(id: $someId) { human(id: $someId) {
name name
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"human" .= object [hanName] "human" .= Aeson.object [hanName]
]] ]]
it "Invalid ID" $ testQueryParams it "Invalid ID" $ testQueryParams
(\v -> if v == "id" then Just "Not a valid ID" else Nothing) (HashMap.singleton "id" "Not a valid ID")
[r| query humanQuery($id: String!) { [r| query humanQuery($id: String!) {
human(id: $id) { human(id: $id) {
name name
} }
} }
|] $ object ["data" .= object ["human" .= Aeson.Null]] |] $ Aeson.object ["data" .= Aeson.object ["human" .= Aeson.Null]]
it "Luke aliased" $ testQuery it "Luke aliased" $ testQuery
[r| query FetchLukeAliased { [r| query FetchLukeAliased {
luke: human(id: "1000") { luke: human(id: "1000") {
@ -157,8 +155,8 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"luke" .= object [lukeName] "luke" .= Aeson.object [lukeName]
]] ]]
it "R2-D2 ID and friends aliased" $ testQuery it "R2-D2 ID and friends aliased" $ testQuery
[r| query HeroNameAndFriendsQuery { [r| query HeroNameAndFriendsQuery {
@ -171,14 +169,14 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"hero" .= object [ "hero" .= Aeson.object [
"id" .= ("2001" :: Text) "id" .= ("2001" :: Text)
, r2d2Name , r2d2Name
, "friends" .= [ , "friends" .=
object ["friendName" .= ("Luke Skywalker" :: Text)] [ Aeson.object ["friendName" .= ("Luke Skywalker" :: Text)]
, object ["friendName" .= ("Han Solo" :: Text)] , Aeson.object ["friendName" .= ("Han Solo" :: Text)]
, object ["friendName" .= ("Leia Organa" :: Text)] , Aeson.object ["friendName" .= ("Leia Organa" :: Text)]
] ]
] ]
]] ]]
@ -192,9 +190,9 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object
"luke" .= object [lukeName] [ "luke" .= Aeson.object [lukeName]
, "leia" .= object [leiaName] , "leia" .= Aeson.object [leiaName]
]] ]]
describe "Fragments for complex queries" $ do describe "Fragments for complex queries" $ do
@ -210,9 +208,9 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"luke" .= object [lukeName, tatooine] "luke" .= Aeson.object [lukeName, tatooine]
, "leia" .= object [leiaName, alderaan] , "leia" .= Aeson.object [leiaName, alderaan]
]] ]]
it "Fragment for duplicate content" $ testQuery it "Fragment for duplicate content" $ testQuery
[r| query UseFragment { [r| query UseFragment {
@ -228,9 +226,9 @@ spec = describe "Star Wars Query Tests" $ do
homePlanet homePlanet
} }
|] |]
$ object [ "data" .= object [ $ Aeson.object [ "data" .= Aeson.object [
"luke" .= object [lukeName, tatooine] "luke" .= Aeson.object [lukeName, tatooine]
, "leia" .= object [leiaName, alderaan] , "leia" .= Aeson.object [leiaName, alderaan]
]] ]]
describe "__typename" $ do describe "__typename" $ do
@ -242,8 +240,11 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object ["data" .= object [ $ Aeson.object ["data" .= Aeson.object [
"hero" .= object ["__typename" .= ("Droid" :: Text), r2d2Name] "hero" .= Aeson.object
[ "__typename" .= ("Droid" :: Text)
, r2d2Name
]
]] ]]
it "Luke is a human" $ testQuery it "Luke is a human" $ testQuery
[r| query CheckTypeOfLuke { [r| query CheckTypeOfLuke {
@ -253,8 +254,11 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object ["data" .= object [ $ Aeson.object ["data" .= Aeson.object [
"hero" .= object ["__typename" .= ("Human" :: Text), lukeName] "hero" .= Aeson.object
[ "__typename" .= ("Human" :: Text)
, lukeName
]
]] ]]
describe "Errors in resolvers" $ do describe "Errors in resolvers" $ do
@ -267,15 +271,15 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object $ Aeson.object
[ "data" .= object [ "data" .= Aeson.object
[ "hero" .= object [ "hero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text) [ "name" .= ("R2-D2" :: Text)
, "secretBackstory" .= Aeson.Null , "secretBackstory" .= Aeson.Null
] ]
] ]
, "errors" .= , "errors" .=
[ object [ Aeson.object
["message" .= ("secretBackstory is secret." :: Text)] ["message" .= ("secretBackstory is secret." :: Text)]
] ]
] ]
@ -290,19 +294,19 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object ["data" .= object $ Aeson.object ["data" .= Aeson.object
[ "hero" .= object [ "hero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text) [ "name" .= ("R2-D2" :: Text)
, "friends" .= , "friends" .=
[ object [ Aeson.object
[ "name" .= ("Luke Skywalker" :: Text) [ "name" .= ("Luke Skywalker" :: Text)
, "secretBackstory" .= Aeson.Null , "secretBackstory" .= Aeson.Null
] ]
, object , Aeson.object
[ "name" .= ("Han Solo" :: Text) [ "name" .= ("Han Solo" :: Text)
, "secretBackstory" .= Aeson.Null , "secretBackstory" .= Aeson.Null
] ]
, object , Aeson.object
[ "name" .= ("Leia Organa" :: Text) [ "name" .= ("Leia Organa" :: Text)
, "secretBackstory" .= Aeson.Null , "secretBackstory" .= Aeson.Null
] ]
@ -310,9 +314,15 @@ spec = describe "Star Wars Query Tests" $ do
] ]
] ]
, "errors" .= , "errors" .=
[ object ["message" .= ("secretBackstory is secret." :: Text)] [ Aeson.object
, object ["message" .= ("secretBackstory is secret." :: Text)] [ "message" .= ("secretBackstory is secret." :: Text)
, object ["message" .= ("secretBackstory is secret." :: Text)] ]
, Aeson.object
[ "message" .= ("secretBackstory is secret." :: Text)
]
, Aeson.object
[ "message" .= ("secretBackstory is secret." :: Text)
]
] ]
] ]
it "error on secretBackstory with alias" $ testQuery it "error on secretBackstory with alias" $ testQuery
@ -323,15 +333,17 @@ spec = describe "Star Wars Query Tests" $ do
} }
} }
|] |]
$ object $ Aeson.object
[ "data" .= object [ "data" .= Aeson.object
[ "mainHero" .= object [ "mainHero" .= Aeson.object
[ "name" .= ("R2-D2" :: Text) [ "name" .= ("R2-D2" :: Text)
, "story" .= Aeson.Null , "story" .= Aeson.Null
] ]
] ]
, "errors" .= , "errors" .=
[ object ["message" .= ("secretBackstory is secret." :: Text)] [ Aeson.object
[ "message" .= ("secretBackstory is secret." :: Text)
]
] ]
] ]