mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
8a77386fcf
### Description This PR adds the required IR for DB to DB joins, based on @paf31 and @0x777 's `feature/db-to-db` branch. To do so, it also refactors the IR to introduce a new type parameter, `r`, which is used to recursively constructs the `v` parameter of remote QueryDBs. When collecting remote joins, we replace `r` with `Const Void`, indicating at the type level that there cannot be any leftover remote join. Furthermore, this PR refactors IR.Select for readability, moves some code from IR.Root to IR.Select to avoid having to deal with circular dependencies, and makes it compile by adding `error` in all new cases in the execution pipeline. The diff doesn't make it clear, but most of Select.hs is actually unchanged. Declarations have just been reordered by topic, in the following order: - type declarations - instance declarations - type aliases - constructor functions - traverse functions https://github.com/hasura/graphql-engine-mono/pull/1580 Co-authored-by: Phil Freeman <630306+paf31@users.noreply.github.com> GitOrigin-RevId: bbdcb4119cec8bb3fc32f1294f91b8dea0728721
301 lines
13 KiB
Haskell
301 lines
13 KiB
Haskell
{-# OPTIONS_HADDOCK not-home #-}
|
||
|
||
-- | Supporting functionality for fine-grained dependency tracking.
|
||
module Hasura.Incremental.Internal.Dependency where
|
||
|
||
import Hasura.Prelude
|
||
|
||
import qualified Data.Dependent.Map as DM
|
||
import qualified Data.HashMap.Strict as Map
|
||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||
import qualified Data.URL.Template as UT
|
||
import qualified Language.GraphQL.Draft.Syntax as G
|
||
import qualified Network.URI.Extended as N
|
||
|
||
import Data.Aeson (Value)
|
||
import Data.ByteString (ByteString)
|
||
import Data.CaseInsensitive (CI)
|
||
import Data.Functor.Classes (Eq1 (..), Eq2 (..))
|
||
import Data.GADT.Compare
|
||
import Data.Int
|
||
import Data.Scientific (Scientific)
|
||
import Data.Set (Set)
|
||
import Data.Text.NonEmpty
|
||
import Data.Time
|
||
import Data.Vector (Vector)
|
||
import Data.Word
|
||
import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), V1,
|
||
(:*:) (..), (:+:) (..))
|
||
import System.Cron.Types
|
||
|
||
import Hasura.Incremental.Select
|
||
|
||
|
||
-- | A 'Dependency' represents a value that a 'Rule' can /conditionally/ depend on. A 'Dependency'
|
||
-- is created using 'newDependency', and it can be “opened” again using 'dependOn'. What makes a
|
||
-- 'Dependency' useful is the way it cooperates with 'cache'---if a 'Dependency' is passed to a
|
||
-- cached rule, but that rule (or any of its sub-rules) never “opens” it using 'dependOn', then
|
||
-- subsequent executions of the rule will ignore the 'Dependency' when computing whether or not it
|
||
-- is necessary to re-execute the rule.
|
||
--
|
||
-- The above functionality is useful on its own to express conditional dependencies, but even more
|
||
-- useful is the ability to express /partial/ dependencies. For example, if a 'Dependency' contains
|
||
-- a 'HashMap', a rule can choose to only depend on the value associated with a particular key by
|
||
-- using 'selectKeyD' (or the more general 'selectD'). Only the parts that are actually used will be
|
||
-- counted when computing whether a rule needs to be re-executed.
|
||
data Dependency a = Dependency !(DependencyKey a) !a
|
||
|
||
instance (Eq a) => Eq (Dependency a) where
|
||
Dependency _ a == Dependency _ b = a == b
|
||
|
||
-- | Applies a 'Selector' to select part of a 'Dependency'.
|
||
selectD :: (Select a) => Selector a b -> Dependency a -> Dependency b
|
||
selectD k (Dependency dk a) = Dependency (DependencyChild k dk) (select k a)
|
||
|
||
-- | Selects a single key from a dependency containing a map-like data structure.
|
||
selectKeyD :: (Select a, Selector a ~ ConstS k v) => k -> Dependency a -> Dependency v
|
||
selectKeyD = selectD . ConstS
|
||
|
||
-- | Tracks whether a 'Dependency' is a “root” dependency created by 'newDependency' or a “child”
|
||
-- dependency created from an existing dependency using 'selectD'.
|
||
data DependencyKey a where
|
||
DependencyRoot :: !(UniqueS a) -> DependencyKey a
|
||
DependencyChild :: (Select a) => !(Selector a b) -> !(DependencyKey a) -> DependencyKey b
|
||
|
||
instance GEq DependencyKey where
|
||
DependencyRoot a `geq` DependencyRoot b
|
||
| Just Refl <- a `geq` b
|
||
= Just Refl
|
||
DependencyChild a1 a2 `geq` DependencyChild b1 b2
|
||
| Just Refl <- a2 `geq` b2
|
||
, Just Refl <- a1 `geq` b1
|
||
= Just Refl
|
||
_ `geq` _ = Nothing
|
||
|
||
instance GCompare DependencyKey where
|
||
DependencyRoot a `gcompare` DependencyRoot b = case gcompare a b of
|
||
GLT -> GLT
|
||
GEQ -> GEQ
|
||
GGT -> GGT
|
||
DependencyChild a1 a2 `gcompare` DependencyChild b1 b2 = case gcompare a2 b2 of
|
||
GLT -> GLT
|
||
GEQ -> case gcompare a1 b1 of
|
||
GLT -> GLT
|
||
GEQ -> GEQ
|
||
GGT -> GGT
|
||
GGT -> GGT
|
||
DependencyRoot _ `gcompare` DependencyChild _ _ = GLT
|
||
DependencyChild _ _ `gcompare` DependencyRoot _ = GGT
|
||
|
||
-- | A typeclass that implements the dependency-checking machinery used by 'cache'. Morally, this
|
||
-- class is like 'Eq', but it only checks the parts of a 'Dependency' that were actually accessed on
|
||
-- the previous execution. It is highly unlikely you will need to implement any 'Cacheable'
|
||
-- instances yourself; the default implementation uses 'Generic' to derive an instance
|
||
-- automatically.
|
||
class (Eq a) => Cacheable a where
|
||
unchanged :: Accesses -> a -> a -> Bool
|
||
|
||
default unchanged :: (Generic a, GCacheable (Rep a)) => Accesses -> a -> a -> Bool
|
||
unchanged accesses a b = gunchanged (from a) (from b) accesses
|
||
{-# INLINABLE unchanged #-}
|
||
|
||
-- | A mapping from root 'Dependency' keys to the accesses made against those dependencies.
|
||
newtype Accesses = Accesses { unAccesses :: DM.DMap UniqueS Access }
|
||
|
||
instance Semigroup Accesses where
|
||
Accesses a <> Accesses b = Accesses $ DM.unionWithKey (const (<>)) a b
|
||
instance Monoid Accesses where
|
||
mempty = Accesses DM.empty
|
||
|
||
recordAccess :: DependencyKey a -> Access a -> Accesses -> Accesses
|
||
recordAccess depKey !access (Accesses accesses) = case depKey of
|
||
DependencyRoot rootKey -> Accesses $ DM.insertWith' (<>) rootKey access accesses
|
||
DependencyChild selector parentKey ->
|
||
recordAccess parentKey (AccessedParts $ DM.singleton selector access) (Accesses accesses)
|
||
|
||
-- | Records the accesses made within a single 'Dependency' and its children. The 'Semigroup'
|
||
-- instance for 'Access' computes a least upper bound:
|
||
--
|
||
-- * 'AccessedAll' serves as the top of the lattice and records the dependency’s entire value was
|
||
-- accessed.
|
||
-- * 'AccessedParts' records a set of accesses for individual parts of a dependency.
|
||
data Access a where
|
||
AccessedAll :: (Cacheable a) => Access a
|
||
AccessedParts :: (Select a) => !(DM.DMap (Selector a) Access) -> Access a
|
||
|
||
instance Semigroup (Access a) where
|
||
AccessedAll <> _ = AccessedAll
|
||
_ <> AccessedAll = AccessedAll
|
||
AccessedParts a <> AccessedParts b = AccessedParts $ DM.unionWithKey (const (<>)) a b
|
||
|
||
instance (Cacheable a) => Cacheable (Dependency a) where
|
||
unchanged accesses (Dependency key1 v1) (Dependency _ v2) =
|
||
-- look up which parts of this dependency were previously accessed
|
||
case lookupAccess key1 of
|
||
-- looking up the access was enough to determine the result
|
||
Left result -> result
|
||
-- otherwise, look through the accessed children
|
||
Right access -> unchangedBy v1 v2 access
|
||
where
|
||
-- Looks up the Access associated with the given DependencyKey, if it exists.
|
||
lookupAccess :: DependencyKey b -> Either Bool (Access b)
|
||
lookupAccess = \case
|
||
DependencyRoot key -> handleNoAccess $ DM.lookup key (unAccesses accesses)
|
||
DependencyChild selector key -> lookupAccess key >>= \case
|
||
AccessedAll -> Left (unchanged accesses v1 v2)
|
||
AccessedParts parts -> handleNoAccess $ DM.lookup selector parts
|
||
where
|
||
-- if this dependency was never accessed, then it’s certainly unchanged
|
||
handleNoAccess = maybe (Left True) Right
|
||
|
||
-- Walks the given values guided by the given Access, checking that all the subparts
|
||
-- identified by the AccessedAll leaves are unchanged.
|
||
unchangedBy :: forall b. b -> b -> Access b -> Bool
|
||
unchangedBy a b = \case
|
||
AccessedAll -> unchanged accesses a b
|
||
AccessedParts parts -> DM.foldrWithKey reduce True parts
|
||
where
|
||
reduce :: (Select b) => Selector b c -> Access c -> Bool -> Bool
|
||
reduce selector = (&&) . unchangedBy (select selector a) (select selector b)
|
||
|
||
-- -------------------------------------------------------------------------------------------------
|
||
-- boilerplate Cacheable instances
|
||
|
||
instance Cacheable Char where unchanged _ = (==)
|
||
instance Cacheable Double where unchanged _ = (==)
|
||
instance Cacheable Int where unchanged _ = (==)
|
||
instance Cacheable Int32 where unchanged _ = (==)
|
||
instance Cacheable Integer where unchanged _ = (==)
|
||
instance Cacheable Scientific where unchanged _ = (==)
|
||
instance Cacheable Text where unchanged _ = (==)
|
||
instance Cacheable NonEmptyText where unchanged _ = (==)
|
||
instance Cacheable N.URIAuth where unchanged _ = (==)
|
||
instance Cacheable G.Name where unchanged _ = (==)
|
||
instance Cacheable DiffTime where unchanged _ = (==)
|
||
instance Cacheable NominalDiffTime where unchanged _ = (==)
|
||
instance Cacheable UTCTime where unchanged _ = (==)
|
||
instance Cacheable Day where unchanged _ = (==)
|
||
instance Cacheable TimeOfDay where unchanged _ = (==)
|
||
instance Cacheable LocalTime where unchanged _ = (==)
|
||
instance Cacheable ByteString where unchanged _ = (==)
|
||
instance Cacheable Float where unchanged _ = (==)
|
||
instance Cacheable Word8 where unchanged _ = (==)
|
||
|
||
-- instances for CronSchedule from package `cron`
|
||
instance Cacheable StepField
|
||
instance Cacheable RangeField
|
||
instance Cacheable SpecificField
|
||
instance Cacheable BaseField
|
||
instance Cacheable CronField
|
||
instance Cacheable MonthSpec
|
||
instance Cacheable DayOfMonthSpec
|
||
instance Cacheable DayOfWeekSpec
|
||
instance Cacheable HourSpec
|
||
instance Cacheable MinuteSpec
|
||
instance Cacheable CronSchedule
|
||
|
||
instance (Cacheable a) => Cacheable (Seq a) where
|
||
unchanged = liftEq . unchanged
|
||
instance (Cacheable a) => Cacheable (Vector a) where
|
||
unchanged = liftEq . unchanged
|
||
instance (Cacheable k, Cacheable v) => Cacheable (HashMap k v) where
|
||
unchanged accesses = liftEq2 (unchanged accesses) (unchanged accesses)
|
||
instance (Cacheable a) => Cacheable (HashSet a) where
|
||
unchanged = liftEq . unchanged
|
||
instance (Cacheable a) => Cacheable (CI a) where
|
||
unchanged _ = (==)
|
||
instance (Cacheable a) => Cacheable (Set a) where
|
||
unchanged = liftEq . unchanged
|
||
instance (Hashable k, Cacheable k, Cacheable v) => Cacheable (InsOrdHashMap k v) where
|
||
unchanged accesses l r = unchanged accesses (toHashMap l) (toHashMap r)
|
||
where
|
||
toHashMap = Map.fromList . OMap.toList
|
||
|
||
instance Cacheable ()
|
||
instance (Cacheable a, Cacheable b) => Cacheable (a, b)
|
||
instance (Cacheable a, Cacheable b, Cacheable c) => Cacheable (a, b, c)
|
||
instance (Cacheable a, Cacheable b, Cacheable c, Cacheable d) => Cacheable (a, b, c, d)
|
||
instance (Cacheable a, Cacheable b, Cacheable c, Cacheable d, Cacheable e) => Cacheable (a, b, c, d, e)
|
||
instance (Cacheable a, Cacheable b, Cacheable c, Cacheable d, Cacheable e, Cacheable f) => Cacheable (a, b, c, d, e, f)
|
||
instance (Cacheable a, Cacheable b, Cacheable c, Cacheable d, Cacheable e, Cacheable f, Cacheable g) => Cacheable (a, b, c, d, e, f, g)
|
||
|
||
|
||
instance Cacheable Bool
|
||
instance Cacheable Void
|
||
instance Cacheable Value
|
||
instance Cacheable G.FragmentDefinition
|
||
instance Cacheable G.GType
|
||
instance Cacheable G.Nullability
|
||
instance Cacheable G.OperationType
|
||
instance Cacheable G.VariableDefinition
|
||
instance Cacheable G.InputValueDefinition
|
||
instance Cacheable G.EnumValueDefinition
|
||
instance (Cacheable a) => Cacheable (G.FieldDefinition a)
|
||
instance Cacheable G.ScalarTypeDefinition
|
||
instance Cacheable G.UnionTypeDefinition
|
||
instance (Cacheable possibleTypes, Cacheable a) => Cacheable (G.InterfaceTypeDefinition a possibleTypes)
|
||
instance Cacheable G.EnumTypeDefinition
|
||
instance (Cacheable a) => Cacheable (G.InputObjectTypeDefinition a)
|
||
instance (Cacheable a) => Cacheable (G.ObjectTypeDefinition a)
|
||
instance (Cacheable a, Cacheable possibleTypes) => Cacheable (G.TypeDefinition a possibleTypes)
|
||
instance Cacheable N.URI
|
||
instance Cacheable UT.Variable
|
||
instance Cacheable UT.TemplateItem
|
||
instance Cacheable UT.URLTemplate
|
||
instance (Cacheable a) => Cacheable (Maybe a)
|
||
instance (Cacheable a, Cacheable b) => Cacheable (Either a b)
|
||
instance (Cacheable a) => Cacheable (NESeq a)
|
||
instance Cacheable a => Cacheable [a]
|
||
instance Cacheable a => Cacheable (NonEmpty a)
|
||
instance Cacheable a => Cacheable (G.Directive a)
|
||
instance Cacheable a => Cacheable (G.ExecutableDefinition a)
|
||
instance (Cacheable (a b), Cacheable b) => Cacheable (G.Field a b)
|
||
instance Cacheable a => Cacheable (G.FragmentSpread a)
|
||
instance (Cacheable (a b), Cacheable b) => Cacheable (G.InlineFragment a b)
|
||
instance (Cacheable (a b), Cacheable b) => Cacheable (G.OperationDefinition a b)
|
||
instance (Cacheable (a b), Cacheable b) => Cacheable (G.Selection a b)
|
||
instance (Cacheable (a b), Cacheable b) => Cacheable (G.TypedOperationDefinition a b)
|
||
|
||
instance Cacheable a => Cacheable (G.Value a)
|
||
|
||
instance Cacheable a => Cacheable (Const a b)
|
||
|
||
deriving instance Cacheable G.Description
|
||
deriving instance Cacheable G.EnumValue
|
||
deriving instance Cacheable a => Cacheable (G.ExecutableDocument a)
|
||
|
||
instance Cacheable G.RootOperationTypeDefinition
|
||
instance Cacheable G.SchemaDefinition
|
||
instance Cacheable G.TypeSystemDefinition
|
||
instance Cacheable G.SchemaDocument
|
||
instance Cacheable G.SchemaIntrospection
|
||
|
||
class GCacheable f where
|
||
gunchanged :: f p -> f p -> Accesses -> Bool
|
||
|
||
instance GCacheable V1 where
|
||
gunchanged a = case a of {}
|
||
{-# INLINE gunchanged #-}
|
||
|
||
instance GCacheable U1 where
|
||
gunchanged U1 U1 _ = True
|
||
{-# INLINE gunchanged #-}
|
||
|
||
instance (Cacheable a) => GCacheable (K1 t a) where
|
||
gunchanged (K1 a) (K1 b) accesses = unchanged accesses a b
|
||
{-# INLINE gunchanged #-}
|
||
|
||
instance (GCacheable f) => GCacheable (M1 t m f) where
|
||
gunchanged (M1 a) (M1 b) = gunchanged a b
|
||
{-# INLINE gunchanged #-}
|
||
|
||
instance (GCacheable f, GCacheable g) => GCacheable (f :*: g) where
|
||
gunchanged (a1 :*: a2) (b1 :*: b2) = liftA2 (&&) (gunchanged a1 b1) (gunchanged a2 b2)
|
||
{-# INLINE gunchanged #-}
|
||
|
||
instance (GCacheable f, GCacheable g) => GCacheable (f :+: g) where
|
||
gunchanged (L1 a) (L1 b) = gunchanged a b
|
||
gunchanged (R1 a) (R1 b) = gunchanged a b
|
||
gunchanged _ _ = const False
|
||
{-# INLINE gunchanged #-}
|