mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 17:31:56 +03:00
d8ff0329a0
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7819 GitOrigin-RevId: bf5d1616a90a771e1c72321b64b38d9c153b0e94
77 lines
2.4 KiB
Haskell
77 lines
2.4 KiB
Haskell
module Hasura.Generator.Common
|
|
( genHashMap,
|
|
genInt,
|
|
genText,
|
|
genNonEmptyText,
|
|
genArbitraryUnicodeText,
|
|
genArbitraryAlphaNumText,
|
|
genArbitraryAlphaNumTextExcluding,
|
|
genFieldName,
|
|
genGName,
|
|
genDescription,
|
|
defaultRange,
|
|
jsonRoundTrip,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import Data.Aeson qualified as Aeson
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.Text.NonEmpty (NonEmptyText, mkNonEmptyText)
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.Common (FieldName (FieldName))
|
|
import Hedgehog
|
|
import Hedgehog.Gen qualified as Gen
|
|
import Hedgehog.Range qualified as Range
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog
|
|
|
|
genHashMap ::
|
|
MonadGen m =>
|
|
Hashable a =>
|
|
m a ->
|
|
m b ->
|
|
Range Int ->
|
|
m (HashMap a b)
|
|
genHashMap genA genB range = fmap HM.fromList . Gen.list range $ (,) <$> genA <*> genB
|
|
|
|
genInt :: Gen Int
|
|
genInt = fromIntegral <$> Gen.int32 (Range.linear 1 99999)
|
|
|
|
genText :: Gen Text
|
|
genText = Gen.text (Range.linear 0 11) Gen.unicode
|
|
|
|
genNonEmptyText :: MonadGen m => Range Int -> m NonEmptyText
|
|
genNonEmptyText range = mkNonEmptyText `Gen.mapMaybeT` genArbitraryUnicodeText range
|
|
|
|
genArbitraryUnicodeText :: MonadGen m => Range Int -> m Text
|
|
genArbitraryUnicodeText range = Gen.text range Gen.unicode
|
|
|
|
genArbitraryAlphaNumText :: MonadGen m => Range Int -> m Text
|
|
genArbitraryAlphaNumText range = Gen.text range Gen.alphaNum
|
|
|
|
genArbitraryAlphaNumTextExcluding :: (MonadGen m, GenBase m ~ Identity) => [Text] -> Range Int -> m Text
|
|
genArbitraryAlphaNumTextExcluding excluded = Gen.filter (`notElem` excluded) . genArbitraryAlphaNumText
|
|
|
|
genFieldName :: MonadGen m => Range Int -> m FieldName
|
|
genFieldName range = FieldName <$> genArbitraryUnicodeText range
|
|
|
|
genGName :: MonadGen m => Range Int -> m G.Name
|
|
genGName range = G.mkName `Gen.mapMaybeT` genArbitraryAlphaNumText range
|
|
|
|
genDescription :: MonadGen m => Range Int -> m G.Description
|
|
genDescription range = G.Description <$> genArbitraryUnicodeText range
|
|
|
|
-- | A reasonable range size to generate data on dev machines without
|
|
-- blowing up.
|
|
defaultRange :: Integral a => Range a
|
|
defaultRange = Range.linear 0 8
|
|
|
|
-- | Given 'Gen' @a@, assert that @a@'s Aeson instances are isomorphic.
|
|
jsonRoundTrip :: forall a. (FromJSON a, ToJSON a, Eq a, Show a) => Gen a -> String -> Spec
|
|
jsonRoundTrip gen ty = do
|
|
it ty $ hedgehog $ do
|
|
term <- forAll gen
|
|
tripping term Aeson.toJSON Aeson.fromJSON
|