Fix block alignment in some parser tests
All checks were successful
Build / audit (push) Successful in 18s
Build / test (push) Successful in 6m4s
Build / doc (push) Successful in 5m5s

This commit is contained in:
2024-10-17 18:08:30 +02:00
parent b056b4256f
commit cdb2aa76b6
3 changed files with 148 additions and 157 deletions

View File

@ -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']
@ -20,30 +31,42 @@ num = ['0'..'9']
instance Arbitrary AnyPrintableChar where
arbitrary = AnyPrintableChar <$> elements chars
where
chars = alpha <> num <> ['_']
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 }
deriving (Eq, Show)
newtype AnyValue = AnyValue
{ 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 }
deriving (Eq, Show)
newtype AnyArgument a = AnyArgument
{ 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'