1 files changed, 103 insertions, 36 deletions
diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs
index cd25599..5fcdf3e 100644
--- a/tests/Test/StarWars/Schema.hs
+++ b/tests/Test/StarWars/Schema.hs
@@ -1,66 +1,133 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Test.StarWars.Schema
-    ( character
-    , droid
-    , hero
-    , human
-    , schema
+    ( schema
     ) where
 
+import Control.Monad.Trans.Reader (asks)
 import Control.Monad.Trans.Except (throwE)
 import Control.Monad.Trans.Class (lift)
 import Data.Functor.Identity (Identity)
-import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
-import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
-import qualified Language.GraphQL.Schema as Schema
 import Language.GraphQL.Trans
-import qualified Language.GraphQL.Type as Type
+import Language.GraphQL.Type
+import qualified Language.GraphQL.Type.In as In
+import qualified Language.GraphQL.Type.Out as Out
 import Test.StarWars.Data
+import Prelude hiding (id)
 
 -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
 
-schema :: HashMap Text (NonEmpty (Schema.Resolver Identity))
-schema = HashMap.singleton "Query" $ hero :| [human, droid]
+schema :: Schema Identity
+schema = Schema { query = queryType, mutation = Nothing }
+  where
+    queryType = Out.ObjectType "Query" Nothing [] $ HashMap.fromList
+        [ ("hero", Out.Resolver heroField hero)
+        , ("human", Out.Resolver humanField human)
+        , ("droid", Out.Resolver droidField droid)
+        ]
+    heroField = Out.Field Nothing (Out.NamedObjectType heroObject)
+        $ HashMap.singleton "episode"
+        $ In.Argument Nothing (In.NamedEnumType episodeEnum) Nothing
+    humanField = Out.Field Nothing (Out.NamedObjectType heroObject)
+        $ HashMap.singleton "id"
+        $ In.Argument Nothing (In.NonNullScalarType string) Nothing
+    droidField = Out.Field Nothing (Out.NamedObjectType droidObject) mempty
 
-hero :: Schema.Resolver Identity
-hero = Schema.object "hero" $ do
+heroObject :: Out.ObjectType Identity
+heroObject = Out.ObjectType "Human" Nothing [] $ HashMap.fromList
+    [ ("id", Out.Resolver idFieldType (idField "id"))
+    , ("name", Out.Resolver nameFieldType (idField "name"))
+    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+    , ("homePlanet", Out.Resolver homePlanetFieldType (idField "homePlanet"))
+    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    ]
+  where
+    homePlanetFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+droidObject :: Out.ObjectType Identity
+droidObject = Out.ObjectType "Droid" Nothing [] $ HashMap.fromList
+    [ ("id", Out.Resolver idFieldType (idField "id"))
+    , ("name", Out.Resolver nameFieldType (idField "name"))
+    , ("friends", Out.Resolver friendsFieldType (idField "friends"))
+    , ("appearsIn", Out.Resolver appearsInField (idField "appearsIn"))
+    , ("primaryFunction", Out.Resolver primaryFunctionFieldType (idField "primaryFunction"))
+    , ("secretBackstory", Out.Resolver secretBackstoryFieldType (String <$> secretBackstory))
+    , ("__typename", Out.Resolver (Out.Field Nothing (Out.NamedScalarType string) mempty) (idField "__typename"))
+    ]
+  where
+    primaryFunctionFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idFieldType :: Out.Field Identity
+idFieldType = Out.Field Nothing (Out.NamedScalarType id) mempty
+
+nameFieldType :: Out.Field Identity
+nameFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+friendsFieldType :: Out.Field Identity
+friendsFieldType = Out.Field Nothing (Out.ListType $ Out.NamedObjectType droidObject) mempty
+
+appearsInField :: Out.Field Identity
+appearsInField = Out.Field (Just description) fieldType mempty
+  where
+    fieldType = Out.ListType $ Out.NamedEnumType episodeEnum
+    description = "Which movies they appear in."
+
+secretBackstoryFieldType :: Out.Field Identity
+secretBackstoryFieldType = Out.Field Nothing (Out.NamedScalarType string) mempty
+
+idField :: Text -> ActionT Identity Value
+idField f = do
+    v <- ActionT $ lift $ asks values
+    let (Object v') = v
+    pure $ v' HashMap.! f
+
+episodeEnum :: EnumType
+episodeEnum = EnumType "Episode" (Just description)
+    $ HashMap.fromList [newHope, empire, jedi]
+  where
+    description = "One of the films in the Star Wars Trilogy"
+    newHope = ("NEW_HOPE", EnumValue $ Just "Released in 1977.")
+    empire = ("EMPIRE", EnumValue $ Just "Released in 1980.")
+    jedi = ("JEDI", EnumValue $ Just "Released in 1983.")
+
+hero :: ActionT Identity Value
+hero = do
   episode <- argument "episode"
-  character $ case episode of
-      Schema.Enum "NEWHOPE" -> getHero 4
-      Schema.Enum "EMPIRE" -> getHero 5
-      Schema.Enum "JEDI" -> getHero 6
+  pure $ character $ case episode of
+      Enum "NEW_HOPE" -> getHero 4
+      Enum "EMPIRE" -> getHero 5
+      Enum "JEDI" -> getHero 6
       _ -> artoo
 
-human :: Schema.Resolver Identity
-human = Schema.wrappedObject "human" $ do
+human :: ActionT Identity Value
+human = do
     id' <- argument "id"
     case id' of
-        Schema.String i -> do
+        String i -> do
             humanCharacter <- lift $ return $ getHuman i >>= Just
             case humanCharacter of
-                Nothing -> return Type.Null
-                Just e -> Type.Named <$> character e
+                Nothing -> pure Null
+                Just e -> pure $ character e
         _ -> ActionT $ throwE "Invalid arguments."
 
-droid :: Schema.Resolver Identity
-droid = Schema.object "droid" $ do
+droid :: ActionT Identity Value
+droid = do
     id' <- argument "id"
     case id' of
-        Schema.String i -> character =<< getDroid i
+        String i -> character <$> getDroid i
         _ -> ActionT $ throwE "Invalid arguments."
 
-character :: Character -> ActionT Identity [Schema.Resolver Identity]
-character char = return
-    [ Schema.scalar "id" $ return $ id_ char
-    , Schema.scalar "name" $ return $ name char
-    , Schema.wrappedObject "friends"
-        $ 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
-    , Schema.scalar "__typename" $ return $ typeName char
+character :: Character -> Value
+character char = Object $ HashMap.fromList
+    [ ("id", String $ id_ char)
+    , ("name", String $ name_ char)
+    , ("friends", List $ character <$> getFriends char)
+    , ("appearsIn", List $ Enum <$> catMaybes (getEpisode <$> appearsIn char))
+    , ("homePlanet", String $ either mempty homePlanet char)
+    , ("__typename", String $ typeName char)
     ]