Replace substitution function with a map

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

View File

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

View File

@ -20,7 +20,7 @@ graphql :: MonadIO m
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
-> T.Text -- ^ Text representing a @GraphQL@ request document.
-> 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
-- applied to the query and the query is then executed using to the given

View File

@ -11,7 +11,7 @@ module Language.GraphQL.Execute.Transform
import Control.Arrow (first)
import Control.Monad (foldM, unless)
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 Data.HashMap.Strict (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
value :: Full.Value -> TransformT Core.Value
value (Full.Variable n) = do
substitute' <- lift ask
lift . lift $ substitute' n
value (Full.Variable name) = lift (asks $ HashMap.lookup name) >>= lift . lift
value (Full.Int i) = pure $ Core.Int i
value (Full.Float f) = pure $ Core.Float f
value (Full.String x) = pure $ Core.String x

View File

@ -44,8 +44,9 @@ data Resolver m = Resolver
Text -- ^ Name
(Field -> CollectErrsT m Aeson.Object) -- ^ Resolver
-- | Variable substitution function.
type Subs = Name -> Maybe Value
-- | Contains variables for the query. The key of the map is a variable name,
-- 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.
object :: MonadIO m => Name -> ActionT m [Resolver m] -> Resolver m

View File

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

View File

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