mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
6ed800abaa
### Context One of the ways we use the Backend type families is to use `Void` for all types for which a backend has no representation; this allows us to make some branches of our metadata and IR unrepresentable, making some functions total, where they would have to handle those unsupported cases otherwise. However, one of the biggest features, functions, cannot be cut that way, due to one of the constraints on `FunctionName b`: the metadata generator requires it to have an `Arbitrary` instance, and `Arbitrary` does not have a recovery mechanism which would allow for a `Void` instance... ### Description This PR solves this problem and removes the `Arbitrary` constraints in `Backend`. To do so, it introduces a new typeclass: `PartialArbitrary`, which is very similar to `Arbitrary`, except that it returns a `Maybe (Gen a)`, allowing for `Void` to have a well-formed instance. An `Arbitrary` instance for `Metadata` can easily be retrieved with `arbitrary = fromJust . partialArbitrary`. Furthermore, `PartialArbitrary` has a generic implementation, inspired by the one in `generic-arbitrary`, which automatically prunes branches that return `Nothing`, allowing to automatically construct most types. Types that don't have a type parameter and therefore can't contain `Void` can easily get their `PartialArbitrary` instance from `Arbitrary` with `partialArbitrary = Just arbitrary`. This is what a default overlappable instance provides. In conjunction with other cleanups in #1666, **this allows for Void function names**. ### Notes While this solves the stated problem, there are other possible solutions we could explore, such as: - switching from QuickCheck to a library that supports that kind of pruning natively - removing the test altogether, and dropping all notion of Arbitrary from the code There are also several things we could do with the Generator module: - move it out of RQL.DDL.Metadata, to some place that makes more sense - move ALL Arbitrary instances in the code to it, since nothing else uses Arbitrary - or, to the contrary, move all those Arbitrary instances alongside their types, to avoid an orphan instance https://github.com/hasura/graphql-engine-mono/pull/1667 GitOrigin-RevId: 88e304ea453840efb5c0d39294639b8b30eefb81
116 lines
4.1 KiB
Haskell
116 lines
4.1 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
{- |
|
|
|
|
Generic re-implementation of Arbitrary, that discards unrepresentable
|
|
values. Modified from the existing generic-arbitrary.
|
|
|
|
This is a parallel reimplementation of Arbitrary, in which each type might fail
|
|
to produce a value, if it contains a dreaded @Void@ field or any otherwise
|
|
unrepresentable type that cannot have a 'Arbitrary' instance. The default
|
|
generic implementation automatically disregard constructors whose walues
|
|
contains such a field, allowing all strctures with other constructors to suceed.
|
|
|
|
-}
|
|
|
|
module Test.QuickCheck.Arbitrary.Partial
|
|
( PartialArbitrary (..)
|
|
, genericPartialArbitrary
|
|
) where
|
|
|
|
import Control.Applicative
|
|
import Data.Maybe
|
|
import Data.Proxy
|
|
import Data.Void
|
|
import GHC.Generics
|
|
import GHC.TypeLits
|
|
import Prelude
|
|
import Test.QuickCheck
|
|
|
|
|
|
-- | A partial version of Arbitrary, for types that cannot or might not be able
|
|
-- to have an instance because of unrepresentable types such as Void. By
|
|
-- default, the generic implementation implements it by recursively calling
|
|
-- `partialArbitrary`. Any branch that fails to produce a value gets discarded.
|
|
--
|
|
-- At the top of the tree: a type that needs arbitrary but has potentially
|
|
-- unrepresentable fields can implement its own arbitrary instance with:
|
|
--
|
|
-- instance Arbitrary MyType where
|
|
-- arbitrary = fromJust partialArbitrary
|
|
--
|
|
-- This will succeed as long as there's one possible representation.
|
|
--
|
|
-- At the bottom of the tree: a global overlappable instance means you only need
|
|
-- to provide PartialArbitrary instances for said unrepresentable types, or
|
|
-- containers; any other type will use this catch-all PartialArbitrary instance,
|
|
-- which delegates back to Arbitrary.
|
|
|
|
class PartialArbitrary a where
|
|
partialArbitrary :: Maybe (Gen a)
|
|
default partialArbitrary :: (Generic a, GPArbitrary ga, ga ~ Rep a) => Maybe (Gen a)
|
|
partialArbitrary = genericPartialArbitrary
|
|
|
|
instance PartialArbitrary Void where
|
|
partialArbitrary = Nothing
|
|
|
|
instance (PartialArbitrary a, PartialArbitrary b) => PartialArbitrary (a,b) where
|
|
partialArbitrary = liftA2 (,) <$> partialArbitrary <*> partialArbitrary
|
|
|
|
instance PartialArbitrary a => PartialArbitrary [a] where
|
|
partialArbitrary = liftArbitrary <$> partialArbitrary
|
|
|
|
instance PartialArbitrary a => PartialArbitrary (Maybe a) where
|
|
partialArbitrary = liftArbitrary <$> partialArbitrary
|
|
|
|
instance {-# OVERLAPPABLE #-} Arbitrary a => PartialArbitrary a where
|
|
partialArbitrary = Just arbitrary
|
|
|
|
genericPartialArbitrary :: (Generic a, GPArbitrary ga, ga ~ Rep a) => Maybe (Gen a)
|
|
genericPartialArbitrary = (fmap . fmap) to gPArbitrary
|
|
|
|
|
|
-- | Generic version of PartialArbitrary, used to implement
|
|
-- 'genericPartialArbitrary'. This was originally taken verbatim from
|
|
-- generic-arbitrary but was adapted for our @Maybe@ approach.
|
|
|
|
class GPArbitrary a where
|
|
gPArbitrary :: Maybe (Gen (a x))
|
|
|
|
instance GPArbitrary U1 where
|
|
gPArbitrary = Just $ pure U1
|
|
|
|
instance PartialArbitrary c => GPArbitrary (K1 i c) where
|
|
gPArbitrary = (fmap . fmap) K1 partialArbitrary
|
|
|
|
instance GPArbitrary f => GPArbitrary (M1 i c f) where
|
|
gPArbitrary = (fmap . fmap) M1 gPArbitrary
|
|
|
|
instance (GPArbitrary a, GPArbitrary b) => GPArbitrary (a :*: b) where
|
|
gPArbitrary = (liftA2 . liftA2) (:*:) gPArbitrary gPArbitrary
|
|
|
|
instance
|
|
( GPArbitrary a
|
|
, GPArbitrary b
|
|
, KnownNat (SumLen a)
|
|
, KnownNat (SumLen b)
|
|
) => GPArbitrary (a :+: b) where
|
|
gPArbitrary = case (l1, r1) of
|
|
-- both branches are representable: distribute evenly
|
|
(Just a, Just b) -> Just $ frequency [(lfreq, a), (rfreq, b)]
|
|
-- pick whichever is representable
|
|
(a, b ) -> a <|> b
|
|
where
|
|
l1 = (fmap . fmap) L1 gPArbitrary
|
|
r1 = (fmap . fmap) R1 gPArbitrary
|
|
lfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen a))
|
|
rfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen b))
|
|
|
|
|
|
-- | Calculates count of constructors encoded by particular ':+:'. This is used
|
|
-- to ensure that we consider all constructors of a type evenly.
|
|
|
|
type family SumLen a :: Nat where
|
|
SumLen (a :+: b) = (SumLen a) + (SumLen b)
|
|
SumLen a = 1
|