aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/GraphQL/AST/EncoderSpec.hs19
-rw-r--r--tests/Language/GraphQL/AST/LexerSpec.hs (renamed from tests/Language/GraphQL/LexerSpec.hs)8
-rw-r--r--tests/Language/GraphQL/AST/ParserSpec.hs (renamed from tests/Language/GraphQL/ParserSpec.hs)10
-rw-r--r--tests/Language/GraphQL/EncoderSpec.hs21
-rw-r--r--tests/Test/FragmentSpec.hs75
-rw-r--r--tests/Test/KitchenSinkSpec.hs4
-rw-r--r--tests/Test/StarWars/Data.hs10
-rw-r--r--tests/Test/StarWars/Schema.hs20
8 files changed, 119 insertions, 48 deletions
diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs
new file mode 100644
index 0000000..a418a61
--- /dev/null
+++ b/tests/Language/GraphQL/AST/EncoderSpec.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.GraphQL.AST.EncoderSpec
+ ( spec
+ ) where
+
+import Language.GraphQL.AST (Value(..))
+import Language.GraphQL.AST.Encoder
+import Test.Hspec ( Spec
+ , describe
+ , it
+ , shouldBe
+ )
+
+spec :: Spec
+spec = describe "value" $ do
+ it "escapes \\" $
+ value minified (String "\\") `shouldBe` "\"\\\\\""
+ it "escapes quotes" $
+ value minified (String "\"") `shouldBe` "\"\\\"\""
diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs
index 274b29a..a0acb9f 100644
--- a/tests/Language/GraphQL/LexerSpec.hs
+++ b/tests/Language/GraphQL/AST/LexerSpec.hs
@@ -1,12 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
-module Language.GraphQL.LexerSpec
+module Language.GraphQL.AST.LexerSpec
( spec
) where
import Data.Text (Text)
import Data.Void (Void)
-import Language.GraphQL.Lexer
+import Language.GraphQL.AST.Lexer
import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse)
@@ -71,8 +71,8 @@ spec = describe "Lexer" $ do
parse float "" "-1.123e4567" `shouldParse` (-1.123e4567)
it "lexes punctuation" $ do
- parse bang "" "!" `shouldParse` '!'
- parse dollar "" "$" `shouldParse` '$'
+ parse bang "" "!" `shouldParse` "!"
+ parse dollar "" "$" `shouldParse` "$"
runBetween parens `shouldSucceedOn` "()"
parse spread "" "..." `shouldParse` "..."
parse colon "" ":" `shouldParse` ":"
diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs
index 9b71c62..3e20e8f 100644
--- a/tests/Language/GraphQL/ParserSpec.hs
+++ b/tests/Language/GraphQL/AST/ParserSpec.hs
@@ -1,10 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
-module Language.GraphQL.ParserSpec
+module Language.GraphQL.AST.ParserSpec
( spec
) where
-import Language.GraphQL.Parser (document)
+import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldSucceedOn)
import Text.Megaparsec (parse)
@@ -24,3 +24,9 @@ spec = describe "Parser" $ do
parse document "" `shouldSucceedOn` [r|{
hello(text: "Argument")
}|]
+
+ it "accepts two required arguments" $
+ parse document "" `shouldSucceedOn` [r|
+ mutation auth($username: String!, $password: String!){
+ test
+ }|]
diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs
deleted file mode 100644
index d2d4a00..0000000
--- a/tests/Language/GraphQL/EncoderSpec.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Language.GraphQL.EncoderSpec
- ( spec
- ) where
-
-import Language.GraphQL.AST ( Value(..))
-import Language.GraphQL.Encoder ( value
- , minified
- )
-import Test.Hspec ( Spec
- , describe
- , it
- , shouldBe
- )
-
-spec :: Spec
-spec = describe "value" $ do
- it "escapes \\" $
- value minified (ValueString "\\") `shouldBe` "\"\\\\\""
- it "escapes quotes" $
- value minified (ValueString "\"") `shouldBe` "\"\\\"\""
diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs
index 7b2bb92..69f1344 100644
--- a/tests/Test/FragmentSpec.hs
+++ b/tests/Test/FragmentSpec.hs
@@ -10,7 +10,13 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Language.GraphQL
import qualified Language.GraphQL.Schema as Schema
-import Test.Hspec (Spec, describe, it, shouldBe, shouldNotSatisfy)
+import Test.Hspec ( Spec
+ , describe
+ , it
+ , shouldBe
+ , shouldSatisfy
+ , shouldNotSatisfy
+ )
import Text.RawString.QQ (r)
size :: Schema.Resolver IO
@@ -37,6 +43,10 @@ inlineQuery = [r|{
}
}|]
+hasErrors :: Value -> Bool
+hasErrors (Object object') = HashMap.member "errors" object'
+hasErrors _ = True
+
spec :: Spec
spec = describe "Inline fragment executor" $ do
it "chooses the first selection if the type matches" $ do
@@ -92,6 +102,63 @@ spec = describe "Inline fragment executor" $ do
actual <- graphql (size :| []) query
actual `shouldNotSatisfy` hasErrors
- where
- hasErrors (Object object') = HashMap.member "errors" object'
- hasErrors _ = True
+
+ it "evaluates nested fragments" $ do
+ let query = [r|
+ {
+ ...circumferenceFragment
+ }
+
+ fragment circumferenceFragment on Hat {
+ circumference
+ }
+
+ fragment hatFragment on Hat {
+ ...circumferenceFragment
+ }
+ |]
+
+ actual <- graphql (circumference :| []) query
+ let expected = object
+ [ "data" .= object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ in actual `shouldBe` expected
+
+ it "evaluates fragments defined in any order" $ do
+ let query = [r|
+ {
+ ...circumferenceFragment
+ }
+
+ fragment circumferenceFragment on Hat {
+ ...hatFragment
+ }
+
+ fragment hatFragment on Hat {
+ circumference
+ }
+ |]
+
+ actual <- graphql (circumference :| []) query
+ let expected = object
+ [ "data" .= object
+ [ "circumference" .= (60 :: Int)
+ ]
+ ]
+ in actual `shouldBe` expected
+
+ it "rejects recursive" $ do
+ let query = [r|
+ {
+ ...circumferenceFragment
+ }
+
+ fragment circumferenceFragment on Hat {
+ ...circumferenceFragment
+ }
+ |]
+
+ actual <- graphql (circumference :| []) query
+ actual `shouldSatisfy` hasErrors
diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs
index 674f85b..9f5a947 100644
--- a/tests/Test/KitchenSinkSpec.hs
+++ b/tests/Test/KitchenSinkSpec.hs
@@ -7,8 +7,8 @@ module Test.KitchenSinkSpec
import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Lazy.IO as Text.Lazy.IO
import qualified Data.Text.Lazy as Lazy (Text)
-import qualified Language.GraphQL.Encoder as Encoder
-import qualified Language.GraphQL.Parser as Parser
+import qualified Language.GraphQL.AST.Encoder as Encoder
+import qualified Language.GraphQL.AST.Parser as Parser
import Paths_graphql (getDataFileName)
import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (parseSatisfies)
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
index 6a514c5..4854f8f 100644
--- a/tests/Test/StarWars/Data.hs
+++ b/tests/Test/StarWars/Data.hs
@@ -26,7 +26,7 @@ import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Language.GraphQL.Trans
-import Language.GraphQL.Type
+import qualified Language.GraphQL.Type as Type
-- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@@ -191,8 +191,8 @@ getDroid' _ = empty
getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
-getEpisode :: Int -> Maybe (Wrapping Text)
-getEpisode 4 = pure $ Named "NEWHOPE"
-getEpisode 5 = pure $ Named "EMPIRE"
-getEpisode 6 = pure $ Named "JEDI"
+getEpisode :: Int -> Maybe (Type.Wrapping Text)
+getEpisode 4 = pure $ Type.Named "NEWHOPE"
+getEpisode 5 = pure $ Type.Named "EMPIRE"
+getEpisode 6 = pure $ Type.Named "JEDI"
getEpisode _ = empty
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index f516f2a..7b98747 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -15,7 +15,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes)
import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans
-import Language.GraphQL.Type
+import qualified Language.GraphQL.Type as Type
import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
@@ -26,23 +26,23 @@ schema = hero :| [human, droid]
hero :: MonadIO m => Schema.Resolver m
hero = Schema.objectA "hero" $ \case
[] -> character artoo
- [Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4
- [Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5
- [Schema.Argument "episode" (Schema.ValueEnum "JEDI" )] -> character $ getHero 6
+ [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4
+ [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5
+ [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6
_ -> ActionT $ throwE "Invalid arguments."
human :: MonadIO m => Schema.Resolver m
human = Schema.wrappedObjectA "human" $ \case
- [Schema.Argument "id" (Schema.ValueString i)] -> do
+ [Schema.Argument "id" (Schema.String i)] -> do
humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of
- Nothing -> return Null
- Just e -> Named <$> character e
+ Nothing -> return Type.Null
+ Just e -> Type.Named <$> character e
_ -> ActionT $ throwE "Invalid arguments."
droid :: MonadIO m => Schema.Resolver m
droid = Schema.objectA "droid" $ \case
- [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i)
+ [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i)
_ -> ActionT $ throwE "Invalid arguments."
character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
@@ -50,8 +50,8 @@ character char = return
[ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char
, Schema.wrappedObject "friends"
- $ traverse character $ List $ Named <$> getFriends char
- , Schema.wrappedScalar "appearsIn" $ return . List
+ $ traverse character $ Type.List $ Type.Named <$> getFriends char
+ , Schema.wrappedScalar "appearsIn" $ return . Type.List
$ catMaybes (getEpisode <$> appearsIn char)
, Schema.scalar "secretBackstory" $ secretBackstory char
, Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:53:00 +0000