Fix block alignment in some parser tests

tests/Language/GraphQL/AST/Arbitrary.hs

@@ -1,15 +1,26 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Language.GraphQL.AST.Arbitrary where
+module Language.GraphQL.AST.Arbitrary
+    ( AnyArgument(..)
+    , AnyLocation(..)
+    , AnyName(..)
+    , AnyNode(..)
+    , AnyObjectField(..)
+    , AnyValue(..)
+    , printArgument
+    ) where
 
 import qualified Language.GraphQL.AST.Document as Doc
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import Test.QuickCheck (oneof, elements, listOf, resize, NonEmptyList (..))
 import Test.QuickCheck.Gen (Gen (..))
-import Data.Text (Text, pack)
+import Data.Text (Text)
+import qualified Data.Text as Text
 import Data.Functor ((<&>))
 
-newtype AnyPrintableChar = AnyPrintableChar { getAnyPrintableChar :: Char } deriving (Eq, Show)
+newtype AnyPrintableChar = AnyPrintableChar
+    { getAnyPrintableChar :: Char
+    } deriving (Eq, Show)
 
 alpha :: String
 alpha = ['a'..'z'] <> ['A'..'Z']
@@ -22,28 +33,40 @@ instance Arbitrary AnyPrintableChar where
         where
            chars = alpha <> num <> ['_']
 
-newtype AnyPrintableText = AnyPrintableText { getAnyPrintableText :: Text } deriving (Eq, Show)
+newtype AnyPrintableText = AnyPrintableText
+    { getAnyPrintableText :: Text
+    } deriving (Eq, Show)
 
 instance Arbitrary AnyPrintableText where
     arbitrary = do
         nonEmptyStr <- getNonEmpty <$> (arbitrary :: Gen (NonEmptyList AnyPrintableChar))
-        pure $ AnyPrintableText (pack $ map getAnyPrintableChar nonEmptyStr)
+        pure $ AnyPrintableText
+            $ Text.pack
+            $ map getAnyPrintableChar nonEmptyStr
 
 -- https://spec.graphql.org/June2018/#Name
-newtype AnyName = AnyName { getAnyName :: Text } deriving (Eq, Show)
+newtype AnyName = AnyName
+    { getAnyName :: Text
+    } deriving (Eq, Show)
 
 instance Arbitrary AnyName where
     arbitrary = do
         firstChar <- elements $ alpha <> ['_']
         rest <- (arbitrary :: Gen [AnyPrintableChar])
-        pure $ AnyName (pack $ firstChar : map getAnyPrintableChar rest)
+        pure $ AnyName
+            $ Text.pack
+            $ firstChar : map getAnyPrintableChar rest
 
-newtype AnyLocation = AnyLocation { getAnyLocation :: Doc.Location } deriving (Eq, Show)
+newtype AnyLocation = AnyLocation
+    { getAnyLocation :: Doc.Location
+    } deriving (Eq, Show)
 
 instance Arbitrary AnyLocation where
     arbitrary = AnyLocation <$> (Doc.Location <$> arbitrary <*> arbitrary)
 
-newtype AnyNode a = AnyNode { getAnyNode :: Doc.Node a } deriving (Eq, Show)
+newtype AnyNode a = AnyNode
+    { getAnyNode :: Doc.Node a
+    } deriving (Eq, Show)
 
 instance Arbitrary a => Arbitrary (AnyNode a) where
     arbitrary = do
@@ -51,7 +74,9 @@ instance Arbitrary a => Arbitrary (AnyNode a) where
         node' <- flip Doc.Node location' <$> arbitrary
         pure $ AnyNode node'
 
-newtype AnyObjectField a = AnyObjectField { getAnyObjectField :: Doc.ObjectField a } deriving (Eq, Show)
+newtype AnyObjectField a = AnyObjectField
+    { getAnyObjectField :: Doc.ObjectField a
+    } deriving (Eq, Show)
 
 instance Arbitrary a => Arbitrary (AnyObjectField a) where
     arbitrary = do
@@ -60,8 +85,9 @@ instance Arbitrary a => Arbitrary (AnyObjectField a) where
         location' <- getAnyLocation <$> arbitrary
         pure $ AnyObjectField $ Doc.ObjectField name' value' location'
 
-newtype AnyValue = AnyValue { getAnyValue :: Doc.Value }
+newtype AnyValue = AnyValue
-    deriving (Eq, Show)
+    { getAnyValue :: Doc.Value
+    } deriving (Eq, Show)
 
 instance Arbitrary AnyValue
   where
@@ -88,8 +114,9 @@ instance Arbitrary AnyValue
             , Doc.Object <$> objectGen
             ]
 
-newtype AnyArgument a = AnyArgument { getAnyArgument :: Doc.Argument }
+newtype AnyArgument a = AnyArgument
-    deriving (Eq, Show)
+    { getAnyArgument :: Doc.Argument
+    } deriving (Eq, Show)
 
 instance Arbitrary a => Arbitrary (AnyArgument a) where
     arbitrary = do
@@ -99,4 +126,5 @@ instance Arbitrary a => Arbitrary (AnyArgument a) where
         pure $ AnyArgument $ Doc.Argument name' (Doc.Node value' location') location'
 
 printArgument :: AnyArgument AnyValue -> Text
-printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) = name' <> ": " <> (pack . show) value'
+printArgument (AnyArgument (Doc.Argument name' (Doc.Node value' _) _)) =
+    name' <> ": " <> (Text.pack . show) value'

tests/Language/GraphQL/AST/EncoderSpec.hs

@@ -14,12 +14,9 @@ import qualified Language.GraphQL.AST.DirectiveLocation as DirectiveLocation
 spec :: Spec
 spec = do
     describe "value" $ do
-        context "null value" $ do
-            let testNull formatter = value formatter Full.Null `shouldBe` "null"
-            it "minified" $ testNull minified
-            it "pretty" $ testNull pretty
-
         context "minified" $ do
+            it "encodes null" $
+                value minified Full.Null `shouldBe` "null"
             it "escapes \\" $
                 value minified (Full.String "\\") `shouldBe` "\"\\\\\""
             it "escapes double quotes" $
@@ -45,6 +42,9 @@ spec = do
                 it "~" $ value minified (Full.String "\x007E") `shouldBe` "\"~\""
 
         context "pretty" $ do
+            it "encodes null" $
+                value pretty Full.Null `shouldBe` "null"
+
             it "uses strings for short string values" $
                 value pretty (Full.String "Short text") `shouldBe` "\"Short text\""
             it "uses block strings for text with new lines, with newline symbol" $

tests/Language/GraphQL/AST/ParserSpec.hs

@@ -1,16 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
 module Language.GraphQL.AST.ParserSpec
     ( spec
     ) where
 
 import Data.List.NonEmpty (NonEmpty(..))
-import Data.Text (Text)
 import qualified Data.Text as Text
 import Language.GraphQL.AST.Document
 import qualified Language.GraphQL.AST.DirectiveLocation as DirLoc
 import Language.GraphQL.AST.Parser
-import Language.GraphQL.TH
 import Test.Hspec (Spec, describe, it, context)
 import Test.Hspec.Megaparsec
     ( shouldParse
@@ -28,127 +25,105 @@ spec = describe "Parser" $ do
         parse document "" `shouldSucceedOn` "\xfeff{foo}"
 
     context "Arguments" $ do
-       it "accepts block strings as argument" $
+        it "accepts block strings as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn`
-                 hello(text: """Argument""")
+                "{ hello(text: \"\"\"Argument\"\"\") }"
-               }|]
 
-       it "accepts strings as argument" $
+        it "accepts strings as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn` "{ hello(text: \"Argument\") }"
-                 hello(text: "Argument")
-               }|]
 
-       it "accepts int as argument1" $
+        it "accepts int as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn` "{ user(id: 4) }"
-                 user(id: 4)
-               }|]
 
-       it "accepts boolean as argument" $
+        it "accepts boolean as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn`
-                 hello(flag: true) { field1 }
+                "{ hello(flag: true) { field1 } }"
-               }|]
 
-       it "accepts float as argument" $
+        it "accepts float as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn`
-                 body(height: 172.5) { height }
+                "{ body(height: 172.5) { height } }"
-               }|]
 
-       it "accepts empty list as argument" $
+        it "accepts empty list as argument" $
-           parse document "" `shouldSucceedOn` [gql|{
+            parse document "" `shouldSucceedOn` "{ query(list: []) { field1 } }"
-                 query(list: []) { field1 }
-               }|]
 
-       it "accepts two required arguments" $
+        it "accepts two required arguments" $
-           parse document "" `shouldSucceedOn` [gql|
+            parse document "" `shouldSucceedOn`
-               mutation auth($username: String!, $password: String!){
+                "mutation auth($username: String!, $password: String!) { test }"
-                 test
-               }|]
 
-       it "accepts two string arguments" $
+        it "accepts two string arguments" $
-           parse document "" `shouldSucceedOn` [gql|
+            parse document "" `shouldSucceedOn`
-               mutation auth{
+                "mutation auth { test(username: \"username\", password: \"password\") }"
-                 test(username: "username", password: "password")
-               }|]
 
-       it "accepts two block string arguments" $
+        it "accepts two block string arguments" $
-           parse document "" `shouldSucceedOn` [gql|
+            let given = "mutation auth {\n\
-               mutation auth{
+                    \  test(username: \"\"\"username\"\"\", password: \"\"\"password\"\"\")\n\
-                 test(username: """username""", password: """password""")
+                    \}"
-               }|]
+             in parse document "" `shouldSucceedOn` given
 
-       it "fails to parse an empty argument list in parens" $
+        it "fails to parse an empty argument list in parens" $
-           parse document "" `shouldFailOn` "{ test() }"
+            parse document "" `shouldFailOn` "{ test() }"
 
-       it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
+        it "accepts any arguments" $ mapSize (const 10) $ property $ \xs ->
-            let
+            let arguments' = map printArgument
-                query' :: Text
+                    $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
-                arguments' = map printArgument $ getNonEmpty (xs :: NonEmptyList (AnyArgument AnyValue))
+                query' = "query(" <> Text.intercalate ", " arguments' <> ")"
-                query' = "query(" <> Text.intercalate ", " arguments' <> ")" in
+             in parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
-            parse document "" `shouldSucceedOn` ("{ " <> query' <> " }")
 
     it "parses minimal schema definition" $
-        parse document "" `shouldSucceedOn` [gql|schema { query: Query }|]
+        parse document "" `shouldSucceedOn` "schema { query: Query }"
 
     it "parses minimal scalar definition" $
-        parse document "" `shouldSucceedOn` [gql|scalar Time|]
+        parse document "" `shouldSucceedOn` "scalar Time"
 
     it "parses ImplementsInterfaces" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            type Person implements NamedEntity & ValuedEntity {
+            "type Person implements NamedEntity & ValuedEntity {\n\
-              name: String
+            \  name: String\n\
-            }
+            \}"
-        |]
 
     it "parses a  type without ImplementsInterfaces" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            type Person {
+            "type Person {\n\
-              name: String
+            \  name: String\n\
-            }
+            \}"
-        |]
 
     it "parses ArgumentsDefinition in an ObjectDefinition" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            type Person {
+            "type Person {\n\
-              name(first: String, last: String): String
+            \  name(first: String, last: String): String\n\
-            }
+            \}"
-        |]
 
     it "parses minimal union type definition" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            union SearchResult = Photo | Person
+            "union SearchResult = Photo | Person"
-        |]
 
     it "parses minimal interface type definition" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            interface NamedEntity {
+            "interface NamedEntity {\n\
-              name: String
+            \  name: String\n\
-            }
+            \}"
-        |]
 
     it "parses minimal enum type definition" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            enum Direction {
+            "enum Direction {\n\
-              NORTH
+            \  NORTH\n\
-              EAST
+            \  EAST\n\
-              SOUTH
+            \  SOUTH\n\
-              WEST
+            \  WEST\n\
-            }
+            \}"
-        |]
 
     it "parses minimal input object type definition" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            input Point2D {
+            "input Point2D {\n\
-              x: Float
+            \  x: Float\n\
-              y: Float
+            \  y: Float\n\
-            }
+            \}"
-        |]
 
     it "parses minimal input enum definition with an optional pipe" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            directive @example on
+            "directive @example on\n\
-              | FIELD
+            \  | FIELD\n\
-              | FRAGMENT_SPREAD
+            \  | FRAGMENT_SPREAD"
-        |]
 
     it "parses two minimal directive definitions" $
         let directive name' loc = TypeSystemDefinition
@@ -165,10 +140,10 @@ spec = describe "Parser" $ do
                 (DirLoc.ExecutableDirectiveLocation DirLoc.Field)
                 (Location {line = 2, column = 1})
             testSchemaExtension = example1 :| [example2]
-            query = [gql|
+            query = Text.unlines
-              directive @example1 on FIELD_DEFINITION
+                [ "directive @example1 on FIELD_DEFINITION"
-              directive @example2 on FIELD
+                , "directive @example2 on FIELD"
-            |]
+                ]
          in parse document "" query `shouldParse` testSchemaExtension
 
     it "parses a directive definition with a default empty list argument" $
@@ -185,21 +160,19 @@ spec = describe "Parser" $ do
             definition = DirectiveDefinition
                 (Description Nothing)
                 "test"
-                (ArgumentsDefinition [argumentValueDefinition] )
+                (ArgumentsDefinition [argumentValueDefinition])
                 False
                 (loc :| [])
             directive = TypeSystemDefinition definition
                 $ Location{ line = 1, column = 1 }
-            query = [gql|directive @test(foo: [String] = []) on FIELD_DEFINITION|]
+            query = "directive @test(foo: [String] = []) on FIELD_DEFINITION"
          in parse document "" query `shouldParse` (directive :| [])
 
     it "parses schema extension with a new directive" $
-        parse document "" `shouldSucceedOn`[gql|
+        parse document "" `shouldSucceedOn` "extend schema @newDirective"
-            extend schema @newDirective
-        |]
 
     it "parses schema extension with an operation type definition" $
-        parse document "" `shouldSucceedOn` [gql|extend schema { query: Query }|]
+        parse document "" `shouldSucceedOn` "extend schema { query: Query }"
 
     it "parses schema extension with an operation type and directive" $
         let newDirective = Directive "newDirective" [] $ Location 1 15
@@ -208,52 +181,42 @@ spec = describe "Parser" $ do
                 $ OperationTypeDefinition Query "Query" :| []
             testSchemaExtension = TypeSystemExtension schemaExtension
                 $ Location 1 1
-            query = [gql|extend schema @newDirective { query: Query }|]
+            query = "extend schema @newDirective { query: Query }"
          in parse document "" query `shouldParse` (testSchemaExtension :| [])
 
     it "parses a repeatable directive definition" $
-        let given = [gql|directive @test repeatable on FIELD_DEFINITION|]
+        let given = "directive @test repeatable on FIELD_DEFINITION"
             isRepeatable (TypeSystemDefinition definition' _ :| [])
                 | DirectiveDefinition _ _ _ repeatable _ <- definition' = repeatable
             isRepeatable _ = False
          in parse document "" given `parseSatisfies` isRepeatable
 
     it "parses an object extension" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            extend type Story {
+            "extend type Story { isHiddenLocally: Boolean }"
-              isHiddenLocally: Boolean
-            }
-        |]
 
     it "rejects variables in DefaultValue" $
-        parse document "" `shouldFailOn` [gql|
+        parse document "" `shouldFailOn`
-            query ($book: String = "Zarathustra", $author: String = $book) {
+            "query ($book: String = \"Zarathustra\", $author: String = $book) {\n\
-              title
+            \  title\n\
-            }
+            \}"
-        |]
 
     it "rejects empty selection set" $
-       parse document "" `shouldFailOn` [gql|
+       parse document "" `shouldFailOn` "query { innerField {} }"
-            query {
-              innerField {}
-            }
-        |]
 
     it "parses documents beginning with a comment" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            """
+            "\"\"\"\n\
-            Query
+            \Query\n\
-            """
+            \\"\"\"\n\
-            type Query {
+            \type Query {\n\
-                queryField: String
+            \  queryField: String\n\
-            }
+            \}"
-        |]
 
     it "parses subscriptions" $
-        parse document "" `shouldSucceedOn` [gql|
+        parse document "" `shouldSucceedOn`
-            subscription NewMessages {
+            "subscription NewMessages {\n\
-              newMessage(roomId: 123) {
+            \  newMessage(roomId: 123) {\n\
-                sender
+            \    sender\n\
-              }
+            \  }\n\
-            }
+            \}"
-        |]