diff options
| -rw-r--r-- | Data/GraphQL/Schema.hs | 39 | ||||
| -rw-r--r-- | graphql.cabal | 1 | ||||
| -rw-r--r-- | tests/Test/StarWars.hs | 111 |
3 files changed, 124 insertions, 27 deletions
diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index cfa1c9c..8d4e1d6 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -3,38 +3,29 @@ module Data.GraphQL.Schema where import Data.Text (Text) import Data.HashMap.Lazy (HashMap) -data Schema = Schema QueryRoot MutationRoot +data Schema f = Schema (QueryRoot f) (Maybe (MutationRoot f)) -type QueryRoot = ObjectOutput +type QueryRoot f = Object f -type MutationRoot = ObjectOutput +type MutationRoot f = Object f -type ObjectOutput = HashMap Text Output +type Object f = HashMap Text (Input -> f Output) type ObjectInput = HashMap Text Input -data Type = TypeScalar Scalar - | TypeOutputObject ObjectOutput - | TypeInterface Interface - | TypeUnion Union - | TypeEnum Scalar - | TypeInputObject ObjectInput - | TypeList List - | TypeNonNull NonNull - data Output = OutputScalar Scalar - | OutputObject ObjectOutput - | OutputInterface Interface - | OutputUnion Union + | OutputObject (HashMap Text Output) + | OutputUnion [Output] | OutputEnum Scalar - | OutputList List - | OutputNonNull NonNull + | OutputList [Output] + | OutputNonNull Output + | InputError data Input = InputScalar Scalar | InputObject ObjectInput | InputEnum Scalar - | InputList List - | InputNonNull NonNull + | InputList [Output] + | InputNonNull Input data Scalar = ScalarInt Int | ScalarFloat Double @@ -42,10 +33,4 @@ data Scalar = ScalarInt Int | ScalarBool Bool | ScalarID Text -newtype Interface = Interface (HashMap Text Output) - -newtype Union = Union [ObjectOutput] - -type List = [Type] - -type NonNull = Type +newtype Interface f = Interface (Object f) diff --git a/graphql.cabal b/graphql.cabal index a78f6ab..752d2ae 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -40,6 +40,7 @@ test-suite tasty main-is: tasty.hs ghc-options: -Wall other-modules: Paths_graphql + Test.StarWars build-depends: base >=4.6 && <5, text >=0.11.3.1, attoparsec >=0.10.4.0, diff --git a/tests/Test/StarWars.hs b/tests/Test/StarWars.hs new file mode 100644 index 0000000..829411c --- /dev/null +++ b/tests/Test/StarWars.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE RecordWildCards #-} +module Test.StarWars where + +import Data.Text (Text) +import Data.HashMap.Lazy (HashMap) +import Data.GraphQL.Schema + +type ID = Text + +schema :: Applicative f => Schema f +schema = Schema query Nothing + +query :: Applicative f => QueryRoot f +query = [ ("hero", hero) + , ("human", human) + , ("droid", droid) + ] + +hero :: Applicative f => Input -> f Output +hero (InputScalar (ScalarInt ep)) = OutputObject <$> getHeroF ep +hero _ = pure InputError + +human :: Applicative f => Input -> f Output +human (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getHumanF id_ +human _ = pure InputError + +droid :: Applicative f => Input -> f Output +droid (InputScalar (ScalarString id_)) = OutputScalar . ScalarString <$> getDroidF id_ +droid _ = pure InputError + +-- * Data + +-- ** Characters + + +data Character = Character + { id_ :: ID + , name :: Text + , friends :: [ID] + , appearsIn :: [Int] + , homePlanet :: Text + } + +luke :: Character +luke = Character + { id_ = "1000" + , name = "Luke Skywalker" + , friends = ["1002","1003","2000","2001"] + , appearsIn = [4,5,6] + , homePlanet = "Tatoonie" + } + +artoo :: Character +artoo = Character + { id_ = "2001" + , name = "R2-D2" + , friends = ["1000","1002","1003"] + , appearsIn = [4,5,6] + , homePlanet = "Astrometch" + } + +type CharacterObject = HashMap Text Output + +character :: Character -> CharacterObject +character (Character{..}) = + [ ("id_", OutputScalar $ ScalarID id_) + , ("name", OutputScalar $ ScalarString name) + , ("friends", OutputList $ OutputScalar . ScalarID <$> friends) + , ("appearsIn", OutputList $ OutputScalar . ScalarInt <$> appearsIn) + , ("homePlanet", OutputScalar $ ScalarString homePlanet) + ] + +-- ** Hero + +getHero :: Int -> CharacterObject +getHero 5 = character luke +getHero _ = character artoo + +getHeroF :: Applicative f => Int -> f CharacterObject +getHeroF = pure . getHero + +-- ** Human + +getHuman :: ID -> Text +getHuman "1000" = "luke" +getHuman "1001" = "vader" +getHuman "1002" = "han" +getHuman "1003" = "leia" +getHuman "1004" = "tarkin" +getHuman _ = "" + +getHumanF :: Applicative f => ID -> f Text +getHumanF = pure . getHuman + +getHumanIO :: ID -> IO Text +getHumanIO = getHumanF + +-- ** Droid + +getDroid :: ID -> Text +getDroid "2000" = "threepio" +getDroid "2001" = "artoo" +getDroid _ = "" + +getDroidF :: Applicative f => ID -> f Text +getDroidF = pure . getDroid + +getDroidIO :: ID -> IO Text +getDroidIO = getDroidF |