mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-20 05:51:54 +03:00
f3aac06dd2
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4094 GitOrigin-RevId: f592adbd686aa7cc78c094d5d4b88f4b62500d18
35 lines
1.2 KiB
Haskell
35 lines
1.2 KiB
Haskell
module Hasura.RQL.IR.SelectSpec (spec) where
|
|
|
|
import Data.Bifoldable
|
|
import Data.List.Extended (singleton)
|
|
import Hasura.Backends.Postgres.RQLGenerator
|
|
import Hasura.Generator.Common (defaultRange)
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.Select (AnnSelectG (..), bifoldMapAnnSelectG)
|
|
import Hasura.RQL.Types
|
|
import Hedgehog
|
|
import Hedgehog.Gen (int)
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog (hedgehog)
|
|
|
|
newtype MyPair (b :: BackendType) r v = MyPair (r, v)
|
|
deriving stock (Show)
|
|
deriving newtype (Foldable, Bifoldable)
|
|
|
|
genMyPair :: MonadGen m => m r -> m v -> m (MyPair b r v)
|
|
genMyPair genR genV = do
|
|
r <- genR
|
|
v <- genV
|
|
pure $ MyPair (r, v)
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "bifoldMapAnnSelectG" $ do
|
|
it "bifoldMapAnnSelectG (const mempty) == foldMap" $
|
|
hedgehog $ do
|
|
annSelectG :: AnnSelectG ('Postgres 'Vanilla) (MyPair ('Postgres 'Vanilla) Int) Int <-
|
|
forAll $
|
|
genAnnSelectG (int defaultRange) (genMyPair (int defaultRange) (int defaultRange))
|
|
bifoldMapAnnSelectG (const []) singleton annSelectG === foldMap singleton annSelectG
|
|
bifoldMapAnnSelectG singleton (const []) annSelectG === foldMap (foldMap $ bifoldMap singleton (const [])) (_asnFields annSelectG)
|