mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
ea5c92acae
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8876 GitOrigin-RevId: abfc18eeef96a1f3593bfe823adab4d161161333
51 lines
1.6 KiB
Haskell
51 lines
1.6 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
|
|
-- | Contains types that can be used by backends to structure updates
|
|
-- to batches of rows in a table
|
|
module Hasura.RQL.IR.Update.Batch
|
|
( UpdateBatch (..),
|
|
updateBatchIsEmpty,
|
|
)
|
|
where
|
|
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.IR.BoolExp
|
|
import Hasura.RQL.Types.Backend
|
|
import Hasura.RQL.Types.BackendType
|
|
|
|
-- | Represents a set of update operations ('_ubOperations') applied to a batch of rows selected
|
|
-- from a table by filtering it with a boolean expression ('_ubWhere').
|
|
--
|
|
-- This type may be used by specific backends as a part their 'UpdateVariant'.
|
|
-- See 'Hasura.Backends.Postgres.Types.Update.PgUpdateVariant' for an example.
|
|
--
|
|
-- The actual operators used to affect changes against columns in '_ubOperations' are abstract
|
|
-- here and are specified by the specific backends based on what they actually support
|
|
data UpdateBatch (b :: BackendType) updateOperators v = UpdateBatch
|
|
{ _ubOperations :: HashMap (Column b) (updateOperators v),
|
|
_ubWhere :: AnnBoolExp b v
|
|
}
|
|
deriving stock (Functor, Foldable, Traversable)
|
|
|
|
deriving stock instance
|
|
( Backend b,
|
|
Show v,
|
|
Show (updateOperators v),
|
|
Show (AnnBoolExp b v)
|
|
) =>
|
|
Show (UpdateBatch b updateOperators v)
|
|
|
|
deriving stock instance
|
|
( Backend b,
|
|
Eq v,
|
|
Eq (updateOperators v),
|
|
Eq (AnnBoolExp b v)
|
|
) =>
|
|
Eq (UpdateBatch b updateOperators v)
|
|
|
|
-- | Are we actually updating anything in the batch?
|
|
updateBatchIsEmpty :: UpdateBatch b updateOperators v -> Bool
|
|
updateBatchIsEmpty UpdateBatch {..} =
|
|
HashMap.null _ubOperations
|