From 73fc334bf8d7bd6d8b83143995844ca0968ceeda Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 3 Nov 2019 10:42:10 +0100 Subject: Move related modules to Language.GraphQL.AST Fixes #18. - `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`. - `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`. - `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`. - All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The module should be imported qualified. - All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed. The module should be imported qualified. - `Language.GraphQL.AST.Transform` is now isn't exposed publically anymore. --- tests/Language/GraphQL/AST/EncoderSpec.hs | 19 +++++++ tests/Language/GraphQL/AST/LexerSpec.hs | 92 +++++++++++++++++++++++++++++++ tests/Language/GraphQL/AST/ParserSpec.hs | 26 +++++++++ tests/Language/GraphQL/EncoderSpec.hs | 21 ------- tests/Language/GraphQL/LexerSpec.hs | 92 ------------------------------- tests/Language/GraphQL/ParserSpec.hs | 26 --------- tests/Test/KitchenSinkSpec.hs | 4 +- tests/Test/StarWars/Data.hs | 10 ++-- tests/Test/StarWars/Schema.hs | 20 +++---- 9 files changed, 154 insertions(+), 156 deletions(-) create mode 100644 tests/Language/GraphQL/AST/EncoderSpec.hs create mode 100644 tests/Language/GraphQL/AST/LexerSpec.hs create mode 100644 tests/Language/GraphQL/AST/ParserSpec.hs delete mode 100644 tests/Language/GraphQL/EncoderSpec.hs delete mode 100644 tests/Language/GraphQL/LexerSpec.hs delete mode 100644 tests/Language/GraphQL/ParserSpec.hs (limited to 'tests') diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs new file mode 100644 index 0000000..a418a61 --- /dev/null +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.AST.EncoderSpec + ( spec + ) where + +import Language.GraphQL.AST (Value(..)) +import Language.GraphQL.AST.Encoder +import Test.Hspec ( Spec + , describe + , it + , shouldBe + ) + +spec :: Spec +spec = describe "value" $ do + it "escapes \\" $ + value minified (String "\\") `shouldBe` "\"\\\\\"" + it "escapes quotes" $ + value minified (String "\"") `shouldBe` "\"\\\"\"" diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs new file mode 100644 index 0000000..b1c280f --- /dev/null +++ b/tests/Language/GraphQL/AST/LexerSpec.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.AST.LexerSpec + ( spec + ) where + +import Data.Text (Text) +import Data.Void (Void) +import Language.GraphQL.AST.Lexer +import Test.Hspec (Spec, context, describe, it) +import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) +import Text.Megaparsec (ParseErrorBundle, parse) +import Text.RawString.QQ (r) + +spec :: Spec +spec = describe "Lexer" $ do + context "Reference tests" $ do + it "accepts BOM header" $ + parse unicodeBOM "" `shouldSucceedOn` "\xfeff" + + it "lexes strings" $ do + parse string "" [r|"simple"|] `shouldParse` "simple" + parse string "" [r|" white space "|] `shouldParse` " white space " + parse string "" [r|"quote \""|] `shouldParse` [r|quote "|] + parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n" + parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|] + parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|] + `shouldParse` "unicode ሴ噸邫췯" + + it "lexes block string" $ do + parse blockString "" [r|"""simple"""|] `shouldParse` "simple" + parse blockString "" [r|""" white space """|] + `shouldParse` " white space " + parse blockString "" [r|"""contains " quote"""|] + `shouldParse` [r|contains " quote|] + parse blockString "" [r|"""contains \""" triplequote"""|] + `shouldParse` [r|contains """ triplequote|] + parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline" + parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" + `shouldParse` "multi\nline\nnormalized" + parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" + `shouldParse` "multi\nline\nnormalized" + parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|] + `shouldParse` [r|unescaped \n\r\b\t\f\u1234|] + parse blockString "" [r|"""slashes \\ \/"""|] + `shouldParse` [r|slashes \\ \/|] + parse blockString "" [r|""" + + spans + multiple + lines + + """|] `shouldParse` "spans\n multiple\n lines" + + it "lexes numbers" $ do + parse integer "" "4" `shouldParse` (4 :: Int) + parse float "" "4.123" `shouldParse` 4.123 + parse integer "" "-4" `shouldParse` (-4 :: Int) + parse integer "" "9" `shouldParse` (9 :: Int) + parse integer "" "0" `shouldParse` (0 :: Int) + parse float "" "-4.123" `shouldParse` (-4.123) + parse float "" "0.123" `shouldParse` 0.123 + parse float "" "123e4" `shouldParse` 123e4 + parse float "" "123E4" `shouldParse` 123E4 + parse float "" "123e-4" `shouldParse` 123e-4 + parse float "" "123e+4" `shouldParse` 123e+4 + parse float "" "-1.123e4" `shouldParse` (-1.123e4) + parse float "" "-1.123E4" `shouldParse` (-1.123E4) + parse float "" "-1.123e-4" `shouldParse` (-1.123e-4) + parse float "" "-1.123e+4" `shouldParse` (-1.123e+4) + parse float "" "-1.123e4567" `shouldParse` (-1.123e4567) + + it "lexes punctuation" $ do + parse bang "" "!" `shouldParse` '!' + parse dollar "" "$" `shouldParse` '$' + runBetween parens `shouldSucceedOn` "()" + parse spread "" "..." `shouldParse` "..." + parse colon "" ":" `shouldParse` ":" + parse equals "" "=" `shouldParse` "=" + parse at "" "@" `shouldParse` '@' + runBetween brackets `shouldSucceedOn` "[]" + runBetween braces `shouldSucceedOn` "{}" + parse pipe "" "|" `shouldParse` "|" + + context "Implementation tests" $ do + it "lexes empty block strings" $ + parse blockString "" [r|""""""|] `shouldParse` "" + it "lexes ampersand" $ + parse amp "" "&" `shouldParse` "&" + +runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () +runBetween parser = parse (parser $ pure ()) "" diff --git a/tests/Language/GraphQL/AST/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs new file mode 100644 index 0000000..8473d73 --- /dev/null +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Language.GraphQL.AST.ParserSpec + ( spec + ) where + +import Language.GraphQL.AST.Parser +import Test.Hspec (Spec, describe, it) +import Test.Hspec.Megaparsec (shouldSucceedOn) +import Text.Megaparsec (parse) +import Text.RawString.QQ (r) + +spec :: Spec +spec = describe "Parser" $ do + it "accepts BOM header" $ + parse document "" `shouldSucceedOn` "\xfeff{foo}" + + it "accepts block strings as argument" $ + parse document "" `shouldSucceedOn` [r|{ + hello(text: """Argument""") + }|] + + it "accepts strings as argument" $ + parse document "" `shouldSucceedOn` [r|{ + hello(text: "Argument") + }|] diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs deleted file mode 100644 index d2d4a00..0000000 --- a/tests/Language/GraphQL/EncoderSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Language.GraphQL.EncoderSpec - ( spec - ) where - -import Language.GraphQL.AST ( Value(..)) -import Language.GraphQL.Encoder ( value - , minified - ) -import Test.Hspec ( Spec - , describe - , it - , shouldBe - ) - -spec :: Spec -spec = describe "value" $ do - it "escapes \\" $ - value minified (ValueString "\\") `shouldBe` "\"\\\\\"" - it "escapes quotes" $ - value minified (ValueString "\"") `shouldBe` "\"\\\"\"" diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/LexerSpec.hs deleted file mode 100644 index 274b29a..0000000 --- a/tests/Language/GraphQL/LexerSpec.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -module Language.GraphQL.LexerSpec - ( spec - ) where - -import Data.Text (Text) -import Data.Void (Void) -import Language.GraphQL.Lexer -import Test.Hspec (Spec, context, describe, it) -import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) -import Text.Megaparsec (ParseErrorBundle, parse) -import Text.RawString.QQ (r) - -spec :: Spec -spec = describe "Lexer" $ do - context "Reference tests" $ do - it "accepts BOM header" $ - parse unicodeBOM "" `shouldSucceedOn` "\xfeff" - - it "lexes strings" $ do - parse string "" [r|"simple"|] `shouldParse` "simple" - parse string "" [r|" white space "|] `shouldParse` " white space " - parse string "" [r|"quote \""|] `shouldParse` [r|quote "|] - parse string "" [r|"escaped \n"|] `shouldParse` "escaped \n" - parse string "" [r|"slashes \\ \/"|] `shouldParse` [r|slashes \ /|] - parse string "" [r|"unicode \u1234\u5678\u90AB\uCDEF"|] - `shouldParse` "unicode ሴ噸邫췯" - - it "lexes block string" $ do - parse blockString "" [r|"""simple"""|] `shouldParse` "simple" - parse blockString "" [r|""" white space """|] - `shouldParse` " white space " - parse blockString "" [r|"""contains " quote"""|] - `shouldParse` [r|contains " quote|] - parse blockString "" [r|"""contains \""" triplequote"""|] - `shouldParse` [r|contains """ triplequote|] - parse blockString "" "\"\"\"multi\nline\"\"\"" `shouldParse` "multi\nline" - parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" - `shouldParse` "multi\nline\nnormalized" - parse blockString "" "\"\"\"multi\rline\r\nnormalized\"\"\"" - `shouldParse` "multi\nline\nnormalized" - parse blockString "" [r|"""unescaped \n\r\b\t\f\u1234"""|] - `shouldParse` [r|unescaped \n\r\b\t\f\u1234|] - parse blockString "" [r|"""slashes \\ \/"""|] - `shouldParse` [r|slashes \\ \/|] - parse blockString "" [r|""" - - spans - multiple - lines - - """|] `shouldParse` "spans\n multiple\n lines" - - it "lexes numbers" $ do - parse integer "" "4" `shouldParse` (4 :: Int) - parse float "" "4.123" `shouldParse` 4.123 - parse integer "" "-4" `shouldParse` (-4 :: Int) - parse integer "" "9" `shouldParse` (9 :: Int) - parse integer "" "0" `shouldParse` (0 :: Int) - parse float "" "-4.123" `shouldParse` (-4.123) - parse float "" "0.123" `shouldParse` 0.123 - parse float "" "123e4" `shouldParse` 123e4 - parse float "" "123E4" `shouldParse` 123E4 - parse float "" "123e-4" `shouldParse` 123e-4 - parse float "" "123e+4" `shouldParse` 123e+4 - parse float "" "-1.123e4" `shouldParse` (-1.123e4) - parse float "" "-1.123E4" `shouldParse` (-1.123E4) - parse float "" "-1.123e-4" `shouldParse` (-1.123e-4) - parse float "" "-1.123e+4" `shouldParse` (-1.123e+4) - parse float "" "-1.123e4567" `shouldParse` (-1.123e4567) - - it "lexes punctuation" $ do - parse bang "" "!" `shouldParse` '!' - parse dollar "" "$" `shouldParse` '$' - runBetween parens `shouldSucceedOn` "()" - parse spread "" "..." `shouldParse` "..." - parse colon "" ":" `shouldParse` ":" - parse equals "" "=" `shouldParse` "=" - parse at "" "@" `shouldParse` '@' - runBetween brackets `shouldSucceedOn` "[]" - runBetween braces `shouldSucceedOn` "{}" - parse pipe "" "|" `shouldParse` "|" - - context "Implementation tests" $ do - it "lexes empty block strings" $ - parse blockString "" [r|""""""|] `shouldParse` "" - it "lexes ampersand" $ - parse amp "" "&" `shouldParse` "&" - -runBetween :: (Parser () -> Parser ()) -> Text -> Either (ParseErrorBundle Text Void) () -runBetween parser = parse (parser $ pure ()) "" diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/ParserSpec.hs deleted file mode 100644 index 9b71c62..0000000 --- a/tests/Language/GraphQL/ParserSpec.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -module Language.GraphQL.ParserSpec - ( spec - ) where - -import Language.GraphQL.Parser (document) -import Test.Hspec (Spec, describe, it) -import Test.Hspec.Megaparsec (shouldSucceedOn) -import Text.Megaparsec (parse) -import Text.RawString.QQ (r) - -spec :: Spec -spec = describe "Parser" $ do - it "accepts BOM header" $ - parse document "" `shouldSucceedOn` "\xfeff{foo}" - - it "accepts block strings as argument" $ - parse document "" `shouldSucceedOn` [r|{ - hello(text: """Argument""") - }|] - - it "accepts strings as argument" $ - parse document "" `shouldSucceedOn` [r|{ - hello(text: "Argument") - }|] diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs index 674f85b..9f5a947 100644 --- a/tests/Test/KitchenSinkSpec.hs +++ b/tests/Test/KitchenSinkSpec.hs @@ -7,8 +7,8 @@ module Test.KitchenSinkSpec import qualified Data.Text.IO as Text.IO import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Data.Text.Lazy as Lazy (Text) -import qualified Language.GraphQL.Encoder as Encoder -import qualified Language.GraphQL.Parser as Parser +import qualified Language.GraphQL.AST.Encoder as Encoder +import qualified Language.GraphQL.AST.Parser as Parser import Paths_graphql (getDataFileName) import Test.Hspec (Spec, describe, it) import Test.Hspec.Megaparsec (parseSatisfies) diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 6a514c5..4854f8f 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -26,7 +26,7 @@ import Control.Monad.Trans.Except (throwE) import Data.Maybe (catMaybes) import Data.Text (Text) import Language.GraphQL.Trans -import Language.GraphQL.Type +import qualified Language.GraphQL.Type as Type -- * Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js @@ -191,8 +191,8 @@ getDroid' _ = empty getFriends :: Character -> [Character] getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char -getEpisode :: Int -> Maybe (Wrapping Text) -getEpisode 4 = pure $ Named "NEWHOPE" -getEpisode 5 = pure $ Named "EMPIRE" -getEpisode 6 = pure $ Named "JEDI" +getEpisode :: Int -> Maybe (Type.Wrapping Text) +getEpisode 4 = pure $ Type.Named "NEWHOPE" +getEpisode 5 = pure $ Type.Named "EMPIRE" +getEpisode 6 = pure $ Type.Named "JEDI" getEpisode _ = empty diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index f516f2a..7b98747 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -15,7 +15,7 @@ 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 qualified Language.GraphQL.Type as Type import Test.StarWars.Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js @@ -26,23 +26,23 @@ schema = hero :| [human, droid] hero :: MonadIO m => Schema.Resolver m hero = Schema.objectA "hero" $ \case [] -> character artoo - [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 + [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4 + [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5 + [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6 _ -> ActionT $ throwE "Invalid arguments." human :: MonadIO m => Schema.Resolver m human = Schema.wrappedObjectA "human" $ \case - [Schema.Argument "id" (Schema.ValueString i)] -> do + [Schema.Argument "id" (Schema.String i)] -> do humanCharacter <- lift $ return $ getHuman i >>= Just case humanCharacter of - Nothing -> return Null - Just e -> Named <$> character e + Nothing -> return Type.Null + Just e -> Type.Named <$> character e _ -> ActionT $ throwE "Invalid arguments." droid :: MonadIO m => Schema.Resolver m droid = Schema.objectA "droid" $ \case - [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i) + [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i) _ -> ActionT $ throwE "Invalid arguments." character :: MonadIO m => Character -> ActionT m [Schema.Resolver m] @@ -50,8 +50,8 @@ 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.wrappedScalar "appearsIn" $ return . List + $ 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 -- cgit v1.2.3