mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 09:22:43 +03:00
e953efeb40
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7758 Co-authored-by: Tom Harding <6302310+i-am-tom@users.noreply.github.com> GitOrigin-RevId: 311f6c4a5c629c18a55d75a5d5a74f826078e86d
117 lines
3.4 KiB
Haskell
117 lines
3.4 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
module Main
|
|
( main,
|
|
)
|
|
where
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
import BlockStrings (blockTest)
|
|
import Control.Monad (unless)
|
|
import Data.ByteString.Builder qualified as BSB
|
|
import Data.ByteString.Lazy qualified as LBS
|
|
import Data.Text (Text)
|
|
import Data.Text qualified as T
|
|
import Data.Text.Encoding.Error qualified as TEE
|
|
import Data.Text.Lazy qualified as LT
|
|
import Data.Text.Lazy.Builder qualified as LTB
|
|
import Data.Text.Lazy.Encoding qualified as LTE
|
|
import Hedgehog
|
|
( Group (..),
|
|
Property,
|
|
TestLimit,
|
|
checkParallel,
|
|
failure,
|
|
footnote,
|
|
forAll,
|
|
property,
|
|
withTests,
|
|
(===),
|
|
)
|
|
import Keywords qualified
|
|
import Language.GraphQL.Draft.Generator
|
|
import Language.GraphQL.Draft.Parser qualified as Input
|
|
import Language.GraphQL.Draft.Printer qualified as Output
|
|
import Language.GraphQL.Draft.Syntax
|
|
import Prettyprinter qualified as PP
|
|
import Prettyprinter.Render.Text qualified as PP
|
|
import System.Environment (getArgs)
|
|
import System.Exit (exitFailure)
|
|
import Text.Builder qualified as TB
|
|
import Prelude
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
data TestMode = TMDev | TMQuick | TMRelease
|
|
deriving stock (Show)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
case parseArgs args of
|
|
TMQuick -> runTest 100
|
|
TMDev -> runTest 500
|
|
TMRelease -> runTest 1000
|
|
where
|
|
parseArgs = foldr parseArg TMDev
|
|
parseArg str _ = case str of
|
|
"quick" -> TMQuick
|
|
"release" -> TMRelease
|
|
_ -> TMDev
|
|
|
|
runTest :: TestLimit -> IO ()
|
|
runTest limit = do
|
|
allGood1 <- tests limit
|
|
allGood2 <- blockTest
|
|
unless (allGood1 && allGood2) exitFailure
|
|
|
|
tests :: TestLimit -> IO Bool
|
|
tests nTests =
|
|
checkParallel $
|
|
Group "Test.printer.parser" $
|
|
[ ("property [ parse (prettyPrint ast) == ast ]", propParserPrettyPrinter nTests),
|
|
("property [ parse (textBuilderPrint ast) == ast ]", propParserTextPrinter nTests),
|
|
("property [ parse (lazyTextBuilderPrint ast) == ast ]", propParserLazyTextPrinter nTests),
|
|
("property [ parse (bytestringBuilderPrint ast) == ast ]", propParserBSPrinter nTests)
|
|
]
|
|
++ Keywords.primitiveTests
|
|
|
|
propParserPrettyPrinter :: TestLimit -> Property
|
|
propParserPrettyPrinter = mkPropParserPrinter $ prettyPrinter . Output.executableDocument
|
|
where
|
|
prettyPrinter :: PP.Doc Text -> Text
|
|
prettyPrinter = PP.renderStrict . PP.layoutPretty PP.defaultLayoutOptions
|
|
|
|
propParserTextPrinter :: TestLimit -> Property
|
|
propParserTextPrinter = mkPropParserPrinter $ TB.run . Output.executableDocument
|
|
|
|
propParserLazyTextPrinter :: TestLimit -> Property
|
|
propParserLazyTextPrinter =
|
|
mkPropParserPrinter $
|
|
LT.toStrict
|
|
. LTB.toLazyText
|
|
. Output.executableDocument
|
|
|
|
propParserBSPrinter :: TestLimit -> Property
|
|
propParserBSPrinter =
|
|
mkPropParserPrinter $
|
|
bsToTxt
|
|
. BSB.toLazyByteString
|
|
. Output.executableDocument
|
|
|
|
mkPropParserPrinter :: (ExecutableDocument Name -> Text) -> (TestLimit -> Property)
|
|
mkPropParserPrinter printer = \space ->
|
|
withTests space $
|
|
property $ do
|
|
xs <- forAll genExecutableDocument
|
|
let rendered = printer xs
|
|
either onError (xs ===) $ Input.parseExecutableDoc rendered
|
|
where
|
|
onError (T.unpack -> errorMsg) = do
|
|
footnote errorMsg
|
|
failure
|
|
|
|
bsToTxt :: LBS.ByteString -> Text
|
|
bsToTxt = LT.toStrict . LTE.decodeUtf8With TEE.lenientDecode
|