mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-21 06:21:39 +03:00
e22eb1afea
## Description Following on from #4572, this removes more dead code as identified by Weeder. Comments and thoughts similarly welcome! PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4587 GitOrigin-RevId: 73aa6a5a2833ee41d29b71fcd0a72ed19822ca73
37 lines
1.2 KiB
Haskell
37 lines
1.2 KiB
Haskell
module Hasura.RQL.IR.SelectSpec (spec) where
|
|
|
|
import Data.Bifoldable
|
|
import Hasura.Backends.Postgres.RQLGenerator
|
|
import Hasura.Generator.Common (defaultRange)
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.Select (AnnSelectG (..), bifoldMapAnnSelectG)
|
|
import Hasura.SQL.Backend
|
|
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
|
|
let singleton :: a -> [a]
|
|
singleton x = [x]
|
|
|
|
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)
|