diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/Language/GraphQL/ParserSpec.hs | 14 | ||||
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 9 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 32 |
3 files changed, 32 insertions, 23 deletions
diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/ParserSpec.hs index c412c85..6425ea5 100644 --- a/tests/Language/GraphQL/ParserSpec.hs +++ b/tests/Language/GraphQL/ParserSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Language.GraphQL.ParserSpec ( spec ) where @@ -11,8 +12,19 @@ import Test.Hspec ( Spec , shouldSatisfy ) import Text.Megaparsec (parse) +import Text.RawString.QQ (r) spec :: Spec -spec = describe "Parser" $ +spec = describe "Parser" $ do it "accepts BOM header" $ parse document "" "\xfeff{foo}" `shouldSatisfy` isRight + + it "accepts block strings as argument" $ + parse document "" [r|{ + hello(text: """Argument""") + }|] `shouldSatisfy` isRight + + it "accepts strings as argument" $ + parse document "" [r|{ + hello(text: "Argument") + }|] `shouldSatisfy` isRight diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 55ff207..6a514c5 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -26,6 +26,7 @@ import Control.Monad.Trans.Except (throwE) import Data.Maybe (catMaybes) import Data.Text (Text) import Language.GraphQL.Trans +import Language.GraphQL.Type -- * Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js @@ -190,8 +191,8 @@ getDroid' _ = empty getFriends :: Character -> [Character] getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char -getEpisode :: Alternative f => Int -> f Text -getEpisode 4 = pure "NEWHOPE" -getEpisode 5 = pure "EMPIRE" -getEpisode 6 = pure "JEDI" +getEpisode :: Int -> Maybe (Wrapping Text) +getEpisode 4 = pure $ Named "NEWHOPE" +getEpisode 5 = pure $ Named "EMPIRE" +getEpisode 6 = pure $ Named "JEDI" getEpisode _ = empty diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 101bbdf..f516f2a 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -11,52 +11,48 @@ module Test.StarWars.Schema import Control.Monad.Trans.Except (throwE) import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (MonadIO(..)) -import Data.List.NonEmpty (NonEmpty((:|))) -import Language.GraphQL.Schema ( Schema - , Resolver - , Argument(..) - , Value(..) - ) +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 Test.StarWars.Data --- * Schema -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js -schema :: MonadIO m => Schema m +schema :: MonadIO m => NonEmpty (Schema.Resolver m) schema = hero :| [human, droid] -hero :: MonadIO m => Resolver m +hero :: MonadIO m => Schema.Resolver m hero = Schema.objectA "hero" $ \case [] -> character artoo - [Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4 - [Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5 - [Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6 + [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 _ -> ActionT $ throwE "Invalid arguments." -human :: MonadIO m => Resolver m +human :: MonadIO m => Schema.Resolver m human = Schema.wrappedObjectA "human" $ \case - [Argument "id" (ValueString i)] -> do + [Schema.Argument "id" (Schema.ValueString i)] -> do humanCharacter <- lift $ return $ getHuman i >>= Just case humanCharacter of Nothing -> return Null Just e -> Named <$> character e _ -> ActionT $ throwE "Invalid arguments." -droid :: MonadIO m => Resolver m +droid :: MonadIO m => Schema.Resolver m droid = Schema.objectA "droid" $ \case - [Argument "id" (ValueString i)] -> character =<< liftIO (getDroid i) + [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i) _ -> ActionT $ throwE "Invalid arguments." -character :: MonadIO m => Character -> ActionT m [Resolver m] +character :: MonadIO m => Character -> ActionT m [Schema.Resolver m] 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.enum "appearsIn" $ return $ foldMap getEpisode $ appearsIn char + , Schema.wrappedScalar "appearsIn" $ return . List + $ catMaybes (getEpisode <$> appearsIn char) , Schema.scalar "secretBackstory" $ secretBackstory char , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char , Schema.scalar "__typename" $ return $ typeName char |
