From 5390c4ca1e7e6bcf36dbe5e773c1355dd4b65939 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sat, 28 Jan 2017 14:15:14 -0300 Subject: Split AST in 2 One AST is meant to be a target parser and tries to adhere as much as possible to the spec. The other is a simplified version of that AST meant for execution. Also newtypes have been replaced by type synonyms and NonEmpty lists are being used where it makes sense. --- tests/Test/StarWars/Schema.hs | 10 +++------- tests/tasty.hs | 6 +++--- 2 files changed, 6 insertions(+), 10 deletions(-) (limited to 'tests') diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index ff79686..29c123e 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -1,15 +1,11 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Test.StarWars.Schema where import Control.Applicative (Alternative, empty) +import Data.List.NonEmpty (NonEmpty((:|))) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -import Data.Traversable (traverse) -#endif -import Data.GraphQL.Schema +import Data.GraphQL.Schema (Schema, Resolver, Argument(..), Value(..)) import qualified Data.GraphQL.Schema as Schema import Test.StarWars.Data @@ -18,7 +14,7 @@ import Test.StarWars.Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js schema :: Alternative f => Schema f -schema = Schema [hero, human, droid] +schema = hero :| [human, droid] hero :: Alternative f => Resolver f hero = Schema.objectA "hero" $ \case diff --git a/tests/tasty.hs b/tests/tasty.hs index fa9bedf..aa8da50 100644 --- a/tests/tasty.hs +++ b/tests/tasty.hs @@ -18,10 +18,10 @@ import qualified Test.StarWars.QueryTests as SW import Paths_graphql (getDataFileName) main :: IO () -main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< ksTest +main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< kitchenTest -ksTest :: IO TestTree -ksTest = testCase "Kitchen Sink" +kitchenTest :: IO TestTree +kitchenTest = testCase "Kitchen Sink" <$> (assertEqual "Encode" <$> expected <*> actual) where expected = Text.readFile -- cgit v1.2.3 From f35e1f949ab3ee718ab773baf9f38ac411d49a28 Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 29 Jan 2017 12:53:15 -0300 Subject: Define Schema using Core AST Also, temporarily remove error reporting to simplify execution. This should be restored once the new execution model is nailed. --- tests/Test/StarWars/Schema.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 29c123e..e816d63 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -19,7 +19,7 @@ schema = hero :| [human, droid] hero :: Alternative f => Resolver f hero = Schema.objectA "hero" $ \case [] -> character artoo - [Argument "episode" (ValueInt n)] -> character $ getHero (fromIntegral n) + [Argument "episode" (ValueInt n)] -> character . getHero $ fromIntegral n _ -> empty human :: Alternative f => Resolver f @@ -34,10 +34,10 @@ droid = Schema.objectA "droid" $ \case character :: Alternative f => Character -> [Resolver f] character char = - [ Schema.scalar "id" $ id_ char - , Schema.scalar "name" $ name char - , Schema.array "friends" $ character <$> getFriends char - , Schema.enum "appearsIn" . traverse getEpisode $ appearsIn char + [ Schema.scalar "id" $ id_ char + , Schema.scalar "name" $ name char + , Schema.array "friends" $ character <$> getFriends char + , Schema.enum "appearsIn" . traverse getEpisode $ appearsIn char , Schema.scalar "secretBackstory" $ secretBackstory char - , Schema.scalar "homePlanet" $ either mempty homePlanet char + , Schema.scalar "homePlanet" $ either mempty homePlanet char ] -- cgit v1.2.3 From d2c138f8d16acadb8ae2ba410484d985dde1e37c Mon Sep 17 00:00:00 2001 From: Danny Navarro Date: Sun, 19 Feb 2017 15:29:58 -0300 Subject: Add basic Fragment Support Only field names are supported for now. --- tests/Test/StarWars/QueryTests.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'tests') diff --git a/tests/Test/StarWars/QueryTests.hs b/tests/Test/StarWars/QueryTests.hs index 85a15a9..0456f6b 100644 --- a/tests/Test/StarWars/QueryTests.hs +++ b/tests/Test/StarWars/QueryTests.hs @@ -140,17 +140,18 @@ test = testGroup "Star Wars Query Tests" $ object [ "data" .= object [ "human" .= object [hanName] ]] - , testCase "Invalid ID" . testQueryParams - (\v -> if v == "id" - then Just "Not a valid ID" - else Nothing) - [r| query humanQuery($id: String!) { - human(id: $id) { - name - } - } - |] $ object ["data" .= object ["human" .= object ["name" .= Aeson.Null]], - "errors" .= Aeson.toJSON [object ["message" .= ("field name not resolved." :: Text)]]] + -- TODO: Enable after Error handling restoration + -- , testCase "Invalid ID" . testQueryParams + -- (\v -> if v == "id" + -- then Just "Not a valid ID" + -- else Nothing) + -- [r| query humanQuery($id: String!) { + -- human(id: $id) { + -- name + -- } + -- } + -- |] $ object ["data" .= object ["human" .= object ["name" .= Aeson.Null]], + -- "errors" .= Aeson.toJSON [object ["message" .= ("field name not resolved." :: Text)]]] -- TODO: This test is directly ported from `graphql-js`, however do we want -- to mimic the same behavior? Is this part of the spec? Once proper -- exceptions are implemented this test might no longer be meaningful. -- cgit v1.2.3