diff options
| -rw-r--r-- | CHANGELOG.md | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Transform.hs | 6 | ||||
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 5 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rw-r--r-- | tests/Test/StarWars/QuerySpec.hs | 176 |
6 files changed, 103 insertions, 90 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 518b53e..0be063e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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`. diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs index afce8aa..952f8ac 100644 --- a/src/Language/GraphQL.hs +++ b/src/Language/GraphQL.hs @@ -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 diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 7c2e100..a85e451 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -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 diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index fa8bf78..facf722 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -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 @@ -1,4 +1,4 @@ -resolver: lts-14.18 +resolver: lts-14.19 packages: - . diff --git a/tests/Test/StarWars/QuerySpec.hs b/tests/Test/StarWars/QuerySpec.hs index 0f6a2ef..4f92801 100644 --- a/tests/Test/StarWars/QuerySpec.hs +++ b/tests/Test/StarWars/QuerySpec.hs @@ -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) + ] ] ] |