Fix block alignment in some parser tests
This commit is contained in:
@ -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'
|
||||
|
Reference in New Issue
Block a user