diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index 9951144..06dc9a6 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -10,5 +10,7 @@ import qualified Data.Aeson as Aeson (Value) import Data.GraphQL.AST import Data.GraphQL.Schema -execute :: Applicative f => Schema -> Document -> f Aeson.Value -execute = undefined +type Response = Aeson.Value + +execute :: Applicative f => Schema f -> Document -> f Response +execute _schema _doc = undefined diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 8d4e1d6..37938ee 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -5,26 +5,25 @@ import Data.HashMap.Lazy (HashMap) data Schema f = Schema (QueryRoot f) (Maybe (MutationRoot f)) -type QueryRoot f = Object f +type QueryRoot f = Map f -type MutationRoot f = Object f +type MutationRoot f = Map f -type Object f = HashMap Text (Input -> f Output) +type Map f = HashMap Text (Resolver f) -type ObjectInput = HashMap Text Input +type Resolver f = Input -> Output f -data Output = OutputScalar Scalar - | OutputObject (HashMap Text Output) - | OutputUnion [Output] - | OutputEnum Scalar - | OutputList [Output] - | OutputNonNull Output - | InputError +data Output f = OutputScalar (f Scalar) + | OutputMap (Map f) + | OutputUnion [Map f] + | OutputEnum (f Scalar) + | OutputList [Output f] + | OutputNonNull (Output f) + | InputError data Input = InputScalar Scalar - | InputObject ObjectInput | InputEnum Scalar - | InputList [Output] + | InputList [Input] | InputNonNull Input data Scalar = ScalarInt Int @@ -32,5 +31,3 @@ data Scalar = ScalarInt Int | ScalarString Text | ScalarBool Bool | ScalarID Text - -newtype Interface f = Interface (Object f) diff --git a/graphql.cabal b/graphql.cabal index 752d2ae..e32b593 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -42,6 +42,7 @@ test-suite tasty other-modules: Paths_graphql Test.StarWars build-depends: base >=4.6 && <5, + aeson >=0.7.0.3, text >=0.11.3.1, attoparsec >=0.10.4.0, tasty >=0.10, diff --git a/tests/Test/StarWars.hs b/tests/Test/StarWars.hs index 829411c..ffafd66 100644 --- a/tests/Test/StarWars.hs +++ b/tests/Test/StarWars.hs @@ -3,10 +3,35 @@ {-# LANGUAGE RecordWildCards #-} module Test.StarWars where +import Data.Functor.Identity (Identity(..)) import Data.Text (Text) -import Data.HashMap.Lazy (HashMap) + +import Data.Attoparsec.Text (parseOnly) +import qualified Data.Aeson as Aeson + +import Test.Tasty (TestTree) +import Test.Tasty.HUnit + +import Data.GraphQL.AST +import Data.GraphQL.Execute +import qualified Data.GraphQL.Parser as Parser import Data.GraphQL.Schema +-- * Test + +test :: TestTree +test = testCase "R2-D2" $ execute schema heroQuery @=? Identity expected + where + heroQuery :: Document + heroQuery = either (error "Parsing error") id $ parseOnly Parser.document + "{ query HeroNameQuery { hero { name } } }" + + expected :: Response + expected = Aeson.Object + [ ( "hero" , Aeson.Object [ ("name", "R2-D2") ] ) ] + +-- * Schema + type ID = Text schema :: Applicative f => Schema f @@ -18,23 +43,22 @@ query = [ ("hero", hero) , ("droid", droid) ] -hero :: Applicative f => Input -> f Output -hero (InputScalar (ScalarInt ep)) = OutputObject <$> getHeroF ep -hero _ = pure InputError +hero :: Applicative f => Resolver f +hero (InputScalar (ScalarInt ep)) = OutputMap $ getHeroF ep +hero _ = InputError -human :: Applicative f => Input -> f Output -human (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getHumanF id_ -human _ = pure InputError +human :: Applicative f => Resolver f +human (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getHumanF id_ +human _ = InputError -droid :: Applicative f => Input -> f Output -droid (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getDroidF id_ -droid _ = pure InputError +droid :: Applicative f => Resolver f +droid (InputScalar (ScalarString id_)) = OutputScalar $ ScalarString <$> getDroidF id_ +droid _ = InputError -- * Data -- ** Characters - data Character = Character { id_ :: ID , name :: Text @@ -61,25 +85,25 @@ artoo = Character , homePlanet = "Astrometch" } -type CharacterObject = HashMap Text Output +type CharacterMap f = Map f -character :: Character -> CharacterObject +character :: Applicative f => Character -> CharacterMap f character (Character{..}) = - [ ("id_", OutputScalar $ ScalarID id_) - , ("name", OutputScalar $ ScalarString name) - , ("friends", OutputList $ OutputScalar . ScalarID <$> friends) - , ("appearsIn", OutputList $ OutputScalar . ScalarInt <$> appearsIn) - , ("homePlanet", OutputScalar $ ScalarString homePlanet) + [ ("id_", const . OutputScalar . pure $ ScalarID id_) + , ("name", const . OutputScalar . pure $ ScalarString name) + , ("friends", const . OutputList $ OutputScalar . pure . ScalarID <$> friends) + , ("appearsIn", const . OutputList $ OutputScalar . pure . ScalarInt <$> appearsIn) + , ("homePlanet", const . OutputScalar . pure $ ScalarString homePlanet) ] -- ** Hero -getHero :: Int -> CharacterObject -getHero 5 = character luke -getHero _ = character artoo +getHero :: Int -> Character +getHero 5 = luke +getHero _ = artoo -getHeroF :: Applicative f => Int -> f CharacterObject -getHeroF = pure . getHero +getHeroF :: Applicative f => Int -> CharacterMap f +getHeroF = character . getHero -- ** Human diff --git a/tests/tasty.hs b/tests/tasty.hs index a034a79..1dd9466 100644 --- a/tests/tasty.hs +++ b/tests/tasty.hs @@ -8,16 +8,20 @@ import Control.Applicative ((<$>), (<*>)) import Data.Attoparsec.Text (parseOnly) import qualified Data.Text.IO as Text -import Test.Tasty (defaultMain) +import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit import qualified Data.GraphQL.Parser as Parser import qualified Data.GraphQL.Encoder as Encoder +import qualified Test.StarWars as SW import Paths_graphql (getDataFileName) main :: IO () -main = defaultMain =<< testCase "Kitchen Sink" +main = defaultMain . testGroup "Tests" . (: [SW.test]) =<< ksTest + +ksTest :: IO TestTree +ksTest = testCase "Kitchen Sink" <$> (assertEqual "Encode" <$> expected <*> actual) where expected = Text.readFile @@ -26,3 +30,4 @@ main = defaultMain =<< testCase "Kitchen Sink" actual = either (error "Parsing error!") Encoder.document <$> parseOnly Parser.document <$> expected +