Uses tasty as the test framework

.hlint.yaml

@@ -0,0 +1,38 @@
+#######################################
+# HLint Configuration                 #
+#                                     #
+# https://github.com/ndmitchell/hlint #
+#######################################
+
+# This file contains a template configuration file, which is typically placed
+# as '.hlint.yaml' in the root directory of your project.
+
+- arguments: [--color=auto]
+
+# Add some functions to the blocklist by default.
+- functions:
+  - {name: unsafePerformIO, within: []}
+  - {name: unsafeCoerce, within: []}
+  - {name: head, within: []}
+  - {name: tail, within: []}
+  - {name: init, within: []}
+  - {name: last, within: []}
+  - {name: fromJust, within: []}
+  - {name: decodeUtf8, within: [], message: "Use decodeUtf8' or decodeUtf8With lenientDecode"}
+
+# Ignore some builtin hints.
+- ignore: {name: Avoid lambda}
+- ignore: {name: Use <$>}
+
+# Applicative-Monad Proposal fallout.
+- warning: {lhs: mapM, rhs: traverse, name: Generalize mapM}
+- warning: {lhs: mapM_, rhs: traverse_, name: Generalize mapM_}
+- warning: {lhs: forM, rhs: for, name: Generalize forM}
+- warning: {lhs: forM_, rhs: for_, name: Generalize forM_}
+- warning: {lhs: sequence, rhs: sequenceA, name: Generalize sequence}
+- warning: {lhs: sequence_, rhs: sequenceA_, name: Generalize sequence_}
+- warning: {lhs: return, rhs: pure, name: Avoid return}
+
+# Applicative style
+- warning: {lhs: f <$> pure a <*> b, rhs: f a <$> b, name: Avoid redundant pure}
+- warning: {lhs: f <$> pure a <* b, rhs: f a <$ b, name: Avoid redundant pure}

Makefile

@@ -1,7 +1,7 @@
 .PHONY: format
 format:
 	cabal-fmt -i graphql-parser.cabal
-	find src test bench \
+	find src tests bench \
 	  -type f \( -name "*.hs" -o -name "*.hs-boot" \) | \
 	  xargs ormolu -ie
 
@@ -83,9 +83,9 @@ ghcid-test:
 	    $(CABAL) repl \
 	      --repl-option '-fobject-code' \
 	      --repl-option '-O0' \
-	      graphql-parser-test \
+	      graphql-parser:test:tests \
 	    " \
-	--test ":main"
+	  --test ":main"
 
 .PHONY: ghcid-bench
 ghcid-bench:
@@ -94,7 +94,7 @@ ghcid-bench:
 	    $(CABAL) repl \
 	      --repl-option '-fobject-code' \
 	      --repl-option '-O0' \
-	      graphql-parser-bench \
+	      graphql-parser:bench:bench \
 	    "
 
 .PHONY: lint
@@ -103,4 +103,4 @@ lint:
 
 .PHONY: lint-all
 lint-all:
-	hlint src/ test/ bench/
+	hlint src/ tests/ bench/

cabal.project

@@ -11,4 +11,6 @@ package *
   haddock-quickjump: true
 
 package graphql-parser
+  benchmarks: True
+  tests: True
   ghc-options: -j

graphql-parser.cabal

@@ -92,26 +92,29 @@ library
     Language.GraphQL.Draft.Syntax.Internal
     Language.GraphQL.Draft.Syntax.QQ
 
-test-suite graphql-parser-test
-  import:         common-all
-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N
-  type:           exitcode-stdio-1.0
-  hs-source-dirs: test
-  main-is:        Spec.hs
-  other-modules:
-    BlockStrings
-    Keywords
-
+test-suite tests
+  import:             common-all
+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N
+  type:               exitcode-stdio-1.0
+  hs-source-dirs:     tests
+  main-is:            Driver.hs
+  build-tool-depends: tasty-discover:tasty-discover -any
   build-depends:
     , base
     , bytestring
     , graphql-parser
     , hedgehog
+    , hspec           >=2.9
     , prettyprinter
+    , tasty
+    , tasty-hedgehog
+    , tasty-hspec
     , text
     , text-builder
 
-benchmark graphql-parser-bench
+  other-modules:      Language.GraphQL.Draft.ParserTest
+
+benchmark bench
   import:         common-all
   type:           exitcode-stdio-1.0
   hs-source-dirs: bench

src/Language/GraphQL/Draft/Generator.hs

@@ -184,14 +184,14 @@ genBlockText = T.unlines <$> Gen.list (Range.linear 0 20) line
     line = do
       Gen.frequency
         [ (10, Gen.text (Range.linear 1 10) Gen.unicode),
-          (10, return "\n"),
+          (10, pure "\n"),
           (6, genIndentation),
           (5, genMinIndentedText 10),
-          (4, return ""),
-          (3, return " "),
-          (6, return "\t"),
-          (3, return "\""), -- "
-          (3, return "\\") -- \
+          (4, pure ""),
+          (3, pure " "),
+          (6, pure "\t"),
+          (3, pure "\""), -- "
+          (3, pure "\\") -- \
         ]
 
 -- | Like `genText` but with random indentation in the start of the string according
@@ -201,11 +201,11 @@ genMinIndentedText min_ = do
   let minIndent = T.replicate min_ " "
   i <- genIndentation
   t <- genText
-  return (minIndent <> i <> t)
+  pure (minIndent <> i <> t)
 
 genIndentation :: Gen Text
 genIndentation = do
-  Gen.text (Range.linear 0 100) (return ' ')
+  Gen.text (Range.linear 0 100) (pure ' ')
 
 -------------------------------------------------------------------------------
 

src/Language/GraphQL/Draft/Parser.hs

@@ -66,7 +66,7 @@ executableDocument = whiteSpace *> (AST.ExecutableDocument <$> many1 definitionE
 
 runParser :: AT.Parser a -> Text -> Either Text a
 runParser parser t =
-  either (Left . T.pack) return $ AT.parseOnly (parser <* AT.endOfInput) t
+  either (Left . T.pack) pure $ AT.parseOnly (parser <* AT.endOfInput) t
 
 parseExecutableDoc :: Text -> Either Text (AST.ExecutableDocument AST.Name)
 parseExecutableDoc = runParser executableDocument
@@ -149,7 +149,7 @@ aliasAndFld = do
   colonM <- optional (tok ":")
   case colonM of
     Just _ -> (Just n,) <$> nameParser
-    Nothing -> return (Nothing, n)
+    Nothing -> pure (Nothing, n)
 {-# INLINE aliasAndFld #-}
 
 field :: Variable var => Parser (AST.Field AST.FragmentSpread var)
@@ -546,7 +546,7 @@ blockString = extractText <$> ("\"\"\"" *> blockContents)
     blockContents =
       AT.runScanner Continue scanner >>= \case
         -- this drop the parsed closing quotes (since we are using a different parser)
-        (textBlock, Done) -> return $ T.lines (T.dropEnd 3 textBlock)
+        (textBlock, Done) -> pure $ T.lines (T.dropEnd 3 textBlock)
         -- there is only one way to get to a Done, so we need this here because runScanner never fails
         _ -> fail "couldn't parse block string"
 

src/Language/GraphQL/Draft/Printer.hs

@@ -15,6 +15,7 @@ import Data.Scientific (Scientific)
 import Data.String (IsString)
 import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Text.Encoding.Error (lenientDecode)
 import Data.Text.Lazy qualified as LT hiding (singleton)
 import Data.Text.Lazy.Builder qualified as LT (Builder)
 import Data.Text.Lazy.Builder qualified as LTB
@@ -279,7 +280,11 @@ dispatchStringPrinter t =
     hasWhitespaceEnd = T.all isWhitespace $ T.takeWhileEnd (/= '\n') t
     -- Condition 4: if none of the remaining lines (i.e. not the first line)
     -- contains nonzero indentation, we can't print it as a block string
-    hasZeroIndentation = any lineZeroIndentation $ tail $ T.lines t
+    --
+    -- NOTE: We use @'drop' 1@ here rather than 'tail' because 'tail' is a
+    -- partial function which will error on an empty list, while @'drop' 1@ is
+    -- not.
+    hasZeroIndentation = any lineZeroIndentation . drop 1 . T.lines $ t
       where
         lineZeroIndentation line = case T.uncons line of
           Nothing -> False -- empty lines don't count
@@ -293,9 +298,14 @@ dispatchStringPrinter t =
     isSourceCharacter :: Char -> Bool
     isSourceCharacter = not . isControl
 
--- | We use Aeson to decode string values, and therefore use Aeson to encode them back.
+-- | We use Aeson to decode string values, and therefore use Aeson to encode
+-- them back.
+--
+-- NOTE: This function uses @'LTE.decodeUtf8With' 'lenientDecode'@, which
+-- replaces invalid input bytes with the Unicode replacement character @U+FFFD@.
 stringValue :: Printer a => Text -> a
-stringValue s = textP $ LT.toStrict $ LTE.decodeUtf8 $ J.encode s
+stringValue =
+  textP . LT.toStrict . LTE.decodeUtf8With lenientDecode . J.encode
 
 blockStringValue :: Printer a => Text -> a
 blockStringValue t = textP "\"\"\"\n" <> textP t <> textP "\n\"\"\""

src/Language/GraphQL/Draft/Syntax.hs

@@ -234,7 +234,7 @@ newtype ExecutableDocument var = ExecutableDocument {getExecutableDefinitions ::
 instance J.FromJSON (ExecutableDocument Name) where
   parseJSON = J.withText "ExecutableDocument" $ \t ->
     case parseExecutableDoc t of
-      Right a -> return a
+      Right a -> pure a
       Left _ -> fail "parsing the graphql query failed"
 
 instance J.ToJSON (ExecutableDocument Name) where
@@ -306,7 +306,7 @@ newtype SchemaDocument
 instance J.FromJSON SchemaDocument where
   parseJSON = J.withText "SchemaDocument" $ \t ->
     case parseSchemaDocument t of
-      Right schemaDoc -> return schemaDoc
+      Right schemaDoc -> pure schemaDoc
       Left err -> fail $ "parsing the schema document: " <> show err
 
 -- | A variant of 'SchemaDocument' that additionally stores, for each interface,