{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Database.Beam.Postgres.Full
(
PgWithLocking, PgLockedTables
, PgSelectLockingStrength(..), PgSelectLockingOptions(..)
, lockingAllTablesFor_, lockingFor_
, locked_, lockAll_, withLocks_
, lateral_
, insert, insertReturning
, insertDefaults
, runPgInsertReturningList
, PgInsertReturning(..)
, PgInsertOnConflict(..)
, onConflictDefault, onConflict
, conflictingConstraint
, BeamHasInsertOnConflict(..)
, onConflictUpdateAll
, onConflictUpdateInstead
, PgUpdateReturning(..)
, runPgUpdateReturningList
, updateReturning
, PgDeleteReturning(..)
, runPgDeleteReturningList
, deleteReturning
, PgReturning(..)
) where
import Database.Beam hiding (insert, insertValues)
import Database.Beam.Query.Internal
import Database.Beam.Backend.SQL
import Database.Beam.Backend.SQL.BeamExtensions
import Database.Beam.Schema.Tables
import Database.Beam.Postgres.Types
import Database.Beam.Postgres.Syntax
import Control.Monad.Free.Church
import Data.Proxy (Proxy(..))
import qualified Data.Text as T
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
newtype PgLockedTables s = PgLockedTables [ T.Text ]
deriving (NonEmpty (PgLockedTables s) -> PgLockedTables s
PgLockedTables s -> PgLockedTables s -> PgLockedTables s
forall b. Integral b => b -> PgLockedTables s -> PgLockedTables s
forall s. NonEmpty (PgLockedTables s) -> PgLockedTables s
forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall s b. Integral b => b -> PgLockedTables s -> PgLockedTables s
stimes :: forall b. Integral b => b -> PgLockedTables s -> PgLockedTables s
$cstimes :: forall s b. Integral b => b -> PgLockedTables s -> PgLockedTables s
sconcat :: NonEmpty (PgLockedTables s) -> PgLockedTables s
$csconcat :: forall s. NonEmpty (PgLockedTables s) -> PgLockedTables s
<> :: PgLockedTables s -> PgLockedTables s -> PgLockedTables s
$c<> :: forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
Semigroup, PgLockedTables s
[PgLockedTables s] -> PgLockedTables s
PgLockedTables s -> PgLockedTables s -> PgLockedTables s
forall s. Semigroup (PgLockedTables s)
forall s. PgLockedTables s
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall s. [PgLockedTables s] -> PgLockedTables s
forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
mconcat :: [PgLockedTables s] -> PgLockedTables s
$cmconcat :: forall s. [PgLockedTables s] -> PgLockedTables s
mappend :: PgLockedTables s -> PgLockedTables s -> PgLockedTables s
$cmappend :: forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
mempty :: PgLockedTables s
$cmempty :: forall s. PgLockedTables s
Monoid)
data PgWithLocking s a = PgWithLocking (PgLockedTables s) a
instance ProjectibleWithPredicate c be res a => ProjectibleWithPredicate c be res (PgWithLocking s a) where
project' :: forall (m :: * -> *).
Monad m =>
Proxy c
-> Proxy (be, res)
-> (forall context.
c context =>
Proxy context -> Proxy be -> res -> m res)
-> PgWithLocking s a
-> m (PgWithLocking s a)
project' Proxy c
p Proxy (be, res)
be forall context.
c context =>
Proxy context -> Proxy be -> res -> m res
mutateM (PgWithLocking PgLockedTables s
tbls a
a) =
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking PgLockedTables s
tbls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (contextPredicate :: * -> Constraint) be res a
(m :: * -> *).
(ProjectibleWithPredicate contextPredicate be res a, Monad m) =>
Proxy contextPredicate
-> Proxy (be, res)
-> (forall context.
contextPredicate context =>
Proxy context -> Proxy be -> res -> m res)
-> a
-> m a
project' Proxy c
p Proxy (be, res)
be forall context.
c context =>
Proxy context -> Proxy be -> res -> m res
mutateM a
a
projectSkeleton' :: forall (m :: * -> *).
Monad m =>
Proxy c
-> Proxy (be, res)
-> (forall context.
c context =>
Proxy context -> Proxy be -> m res)
-> m (PgWithLocking s a)
projectSkeleton' Proxy c
ctxt Proxy (be, res)
be forall context. c context => Proxy context -> Proxy be -> m res
mkM =
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (contextPredicate :: * -> Constraint) be res a
(m :: * -> *).
(ProjectibleWithPredicate contextPredicate be res a, Monad m) =>
Proxy contextPredicate
-> Proxy (be, res)
-> (forall context.
contextPredicate context =>
Proxy context -> Proxy be -> m res)
-> m a
projectSkeleton' Proxy c
ctxt Proxy (be, res)
be forall context. c context => Proxy context -> Proxy be -> m res
mkM
lockAll_ :: a -> PgWithLocking s a
lockAll_ :: forall a s. a -> PgWithLocking s a
lockAll_ = forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking forall a. Monoid a => a
mempty
withLocks_ :: a -> PgLockedTables s -> PgWithLocking s a
withLocks_ :: forall a s. a -> PgLockedTables s -> PgWithLocking s a
withLocks_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking
locked_ :: (Beamable tbl, Database Postgres db)
=> DatabaseEntity Postgres db (TableEntity tbl)
-> Q Postgres db s (PgLockedTables s, tbl (QExpr Postgres s))
locked_ :: forall (tbl :: (* -> *) -> *) (db :: (* -> *) -> *) s.
(Beamable tbl, Database Postgres db) =>
DatabaseEntity Postgres db (TableEntity tbl)
-> Q Postgres db s (PgLockedTables s, tbl (QExpr Postgres s))
locked_ (DatabaseEntity DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt) = do
(Text
nm, tbl (QGenExpr QValueContext Postgres s)
joined) <- forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (forall be r next (db :: (* -> *) -> *) s.
Projectible be r =>
(Text -> Text -> BeamSqlBackendFromSyntax be)
-> (Text -> r)
-> (r
-> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))
-> ((Text, r) -> next)
-> QF be db s next
QAll (\Text
_ -> forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (forall tblSource.
IsSql92TableSourceSyntax tblSource =>
Sql92TableSourceTableNameSyntax tblSource -> tblSource
tableNamed (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt) (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,forall a. Maybe a
Nothing))
(forall be (table :: (* -> *) -> *) ctxt s.
(BeamSqlBackend be, Beamable table) =>
TableSettings table -> Text -> table (QGenExpr ctxt be s)
tableFieldsToExpressions (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))
(\tbl (QGenExpr QValueContext Postgres s)
_ -> forall a. Maybe a
Nothing) forall a. a -> a
id))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s. [Text] -> PgLockedTables s
PgLockedTables [Text
nm], tbl (QGenExpr QValueContext Postgres s)
joined)
lockingFor_ :: forall a db s
. ( Database Postgres db, Projectible Postgres a, ThreadRewritable (QNested s) a )
=> PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) (PgWithLocking (QNested s) a)
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
lockingFor_ :: forall a (db :: (* -> *) -> *) s.
(Database Postgres db, Projectible Postgres a,
ThreadRewritable (QNested s) a) =>
PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) (PgWithLocking (QNested s) a)
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
lockingFor_ PgSelectLockingStrength
lockStrength Maybe PgSelectLockingOptions
mLockOptions (Q QM Postgres db (QNested s) (PgWithLocking (QNested s) a)
q) =
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (forall be r (db :: (* -> *) -> *) s next.
Projectible be r =>
(r
-> BeamSqlBackendSelectTableSyntax be
-> [BeamSqlBackendOrderingSyntax be]
-> Maybe Integer
-> Maybe Integer
-> BeamSqlBackendSelectSyntax be)
-> QM be db (QNested s) r -> (r -> next) -> QF be db s next
QForceSelect (\(PgWithLocking (PgLockedTables [Text]
tblNms) a
_) Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))
tbl [BeamSqlBackendOrderingSyntax Postgres]
ords Maybe Integer
limit Maybe Integer
offset ->
let locking :: PgSelectLockingClauseSyntax
locking = PgSelectLockingStrength
-> [Text]
-> Maybe PgSelectLockingOptions
-> PgSelectLockingClauseSyntax
PgSelectLockingClauseSyntax PgSelectLockingStrength
lockStrength [Text]
tblNms Maybe PgSelectLockingOptions
mLockOptions
in PgSelectTableSyntax
-> [PgOrderingSyntax]
-> Maybe Integer
-> Maybe Integer
-> Maybe PgSelectLockingClauseSyntax
-> PgSelectSyntax
pgSelectStmt Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))
tbl [BeamSqlBackendOrderingSyntax Postgres]
ords Maybe Integer
limit Maybe Integer
offset (forall a. a -> Maybe a
Just PgSelectLockingClauseSyntax
locking))
QM Postgres db (QNested s) (PgWithLocking (QNested s) a)
q (\(PgWithLocking PgLockedTables (QNested s)
_ a
a) -> forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall {k} (t :: k). Proxy t
Proxy @s) a
a)))
lockingAllTablesFor_ :: ( Database Postgres db, Projectible Postgres a, ThreadRewritable (QNested s) a )
=> PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) a
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
lockingAllTablesFor_ :: forall (db :: (* -> *) -> *) a s.
(Database Postgres db, Projectible Postgres a,
ThreadRewritable (QNested s) a) =>
PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) a
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
lockingAllTablesFor_ PgSelectLockingStrength
lockStrength Maybe PgSelectLockingOptions
mLockOptions Q Postgres db (QNested s) a
q =
forall a (db :: (* -> *) -> *) s.
(Database Postgres db, Projectible Postgres a,
ThreadRewritable (QNested s) a) =>
PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) (PgWithLocking (QNested s) a)
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
lockingFor_ PgSelectLockingStrength
lockStrength Maybe PgSelectLockingOptions
mLockOptions (forall a s. a -> PgWithLocking s a
lockAll_ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Postgres db (QNested s) a
q)
insertDefaults :: SqlInsertValues Postgres tbl
insertDefaults :: forall tbl. SqlInsertValues Postgres tbl
insertDefaults = forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (PgSyntax -> PgInsertValuesSyntax
PgInsertValuesSyntax (ByteString -> PgSyntax
emit ByteString
"DEFAULT VALUES"))
insert :: DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> SqlInsert Postgres table
insert :: forall (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> SqlInsert Postgres table
insert tbl :: DatabaseEntity Postgres db (TableEntity table)
tbl@(DatabaseEntity dt :: DatabaseEntityDescriptor Postgres (TableEntity table)
dt@(DatabaseTable {})) SqlInsertValues Postgres (table (QExpr Postgres s))
values PgInsertOnConflict table
onConflict_ =
case forall a (be :: (* -> *) -> *) (table :: (* -> *) -> *) s.
Projectible Postgres a =>
DatabaseEntity Postgres be (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgInsertReturning (QExprToIdentity a)
insertReturning DatabaseEntity Postgres db (TableEntity table)
tbl SqlInsertValues Postgres (table (QExpr Postgres s))
values PgInsertOnConflict table
onConflict_
(forall a. Maybe a
Nothing :: Maybe (table (QExpr Postgres PostgresInaccessible) -> QExpr Postgres PostgresInaccessible Int)) of
PgInsertReturning PgSyntax
a ->
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity table)
dt) (PgSyntax -> PgInsertSyntax
PgInsertSyntax PgSyntax
a)
PgInsertReturning
(QExprToIdentity (QExpr Postgres PostgresInaccessible Int))
PgInsertReturningEmpty ->
forall be (table :: (* -> *) -> *). SqlInsert be table
SqlInsertNoRows
data PgInsertReturning a
= PgInsertReturning PgSyntax
| PgInsertReturningEmpty
insertReturning :: Projectible Postgres a
=> DatabaseEntity Postgres be (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgInsertReturning (QExprToIdentity a)
insertReturning :: forall a (be :: (* -> *) -> *) (table :: (* -> *) -> *) s.
Projectible Postgres a =>
DatabaseEntity Postgres be (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgInsertReturning (QExprToIdentity a)
insertReturning DatabaseEntity Postgres be (TableEntity table)
_ SqlInsertValues Postgres (table (QExpr Postgres s))
SqlInsertValuesEmpty PgInsertOnConflict table
_ Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
_ = forall a. PgInsertReturning a
PgInsertReturningEmpty
insertReturning (DatabaseEntity tbl :: DatabaseEntityDescriptor Postgres (TableEntity table)
tbl@(DatabaseTable {}))
(SqlInsertValues (PgInsertValuesSyntax PgSyntax
insertValues_))
(PgInsertOnConflict table (QField QInternal) -> PgInsertOnConflictSyntax
mkOnConflict)
Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
mMkProjection =
forall a. PgSyntax -> PgInsertReturning a
PgInsertReturning forall a b. (a -> b) -> a -> b
$
ByteString -> PgSyntax
emit ByteString
"INSERT INTO " forall a. Semigroup a => a -> a -> a
<> PgTableNameSyntax -> PgSyntax
fromPgTableName (forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity table)
tbl) (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity table)
tbl)) forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
"(" forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' Columnar (TableField table) a
f) -> Text -> PgSyntax
pgQuotedIdentifier (forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
f)) TableSettings table
tblSettings) forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
") " forall a. Semigroup a => a -> a -> a
<>
PgSyntax
insertValues_ forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" " forall a. Semigroup a => a -> a -> a
<> PgInsertOnConflictSyntax -> PgSyntax
fromPgInsertOnConflict (table (QField QInternal) -> PgInsertOnConflictSyntax
mkOnConflict table (QField QInternal)
tblFields) forall a. Semigroup a => a -> a -> a
<>
(case Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
mMkProjection of
Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
Nothing -> forall a. Monoid a => a
mempty
Just table (QExpr Postgres PostgresInaccessible) -> a
mkProjection ->
ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (table (QExpr Postgres PostgresInaccessible) -> a
mkProjection table (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t")))
where
tblQ :: table (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
f))))) TableSettings table
tblSettings
tblFields :: table (QField QInternal)
tblFields = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall s ty. Bool -> Text -> Text -> QField s ty
QField Bool
True (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity table)
tbl) (forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
f))) TableSettings table
tblSettings
tblSettings :: TableSettings table
tblSettings = forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity table)
tbl
runPgInsertReturningList
:: ( MonadBeam be m
, BeamSqlBackendSyntax be ~ PgCommandSyntax
, FromBackendRow be a
)
=> PgInsertReturning a
-> m [a]
runPgInsertReturningList :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackendSyntax be ~ PgCommandSyntax,
FromBackendRow be a) =>
PgInsertReturning a -> m [a]
runPgInsertReturningList = \case
PgInsertReturning a
PgInsertReturningEmpty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
PgInsertReturning PgSyntax
syntax -> forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax
newtype PgInsertOnConflict (tbl :: (* -> *) -> *) =
PgInsertOnConflict (tbl (QField QInternal) -> PgInsertOnConflictSyntax)
lateral_ :: forall s a b db
. ( ThreadRewritable s a, ThreadRewritable (QNested s) b, Projectible Postgres b )
=> a -> (WithRewrittenThread s (QNested s) a -> Q Postgres db (QNested s) b)
-> Q Postgres db s (WithRewrittenThread (QNested s) s b)
lateral_ :: forall s a b (db :: (* -> *) -> *).
(ThreadRewritable s a, ThreadRewritable (QNested s) b,
Projectible Postgres b) =>
a
-> (WithRewrittenThread s (QNested s) a
-> Q Postgres db (QNested s) b)
-> Q Postgres db s (WithRewrittenThread (QNested s) s b)
lateral_ a
using WithRewrittenThread s (QNested s) a -> Q Postgres db (QNested s) b
mkSubquery = do
let Q QM Postgres db (QNested s) b
subquery = WithRewrittenThread s (QNested s) a -> Q Postgres db (QNested s) b
mkSubquery (forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall {k} (t :: k). Proxy t
Proxy @(QNested s)) a
using)
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (forall be r (db :: (* -> *) -> *) s next.
Projectible be r =>
QM be db (QNested s) r
-> Text
-> (BeamSqlBackendFromSyntax be
-> BeamSqlBackendFromSyntax be
-> Maybe (BeamSqlBackendExpressionSyntax be)
-> BeamSqlBackendFromSyntax be)
-> (r
-> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))
-> (r -> next)
-> QF be db s next
QArbitraryJoin QM Postgres db (QNested s) b
subquery
Text
"lat_"
(\Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
a Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
b Maybe (BeamSqlBackendExpressionSyntax Postgres)
on' ->
case Maybe (BeamSqlBackendExpressionSyntax Postgres)
on' of
Maybe (BeamSqlBackendExpressionSyntax Postgres)
Nothing ->
PgSyntax -> PgFromSyntax
PgFromSyntax forall a b. (a -> b) -> a -> b
$
PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
a forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" CROSS JOIN LATERAL " forall a. Semigroup a => a -> a -> a
<> PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
b
Just BeamSqlBackendExpressionSyntax Postgres
on'' ->
PgSyntax -> PgFromSyntax
PgFromSyntax forall a b. (a -> b) -> a -> b
$
PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
a forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" JOIN LATERAL " forall a. Semigroup a => a -> a -> a
<> PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
(Sql92SelectSelectTableSyntax
(Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
b forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" ON " forall a. Semigroup a => a -> a -> a
<> PgExpressionSyntax -> PgSyntax
fromPgExpression BeamSqlBackendExpressionSyntax Postgres
on'')
(\b
_ -> forall a. Maybe a
Nothing)
(forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall {k} (t :: k). Proxy t
Proxy @s))))
onConflictDefault :: PgInsertOnConflict tbl
onConflictDefault :: forall (tbl :: (* -> *) -> *). PgInsertOnConflict tbl
onConflictDefault = forall (tbl :: (* -> *) -> *).
(tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
PgInsertOnConflict (\tbl (QField QInternal)
_ -> PgSyntax -> PgInsertOnConflictSyntax
PgInsertOnConflictSyntax forall a. Monoid a => a
mempty)
onConflict :: Beamable tbl
=> SqlConflictTarget Postgres tbl
-> SqlConflictAction Postgres tbl
-> PgInsertOnConflict tbl
onConflict :: forall (tbl :: (* -> *) -> *).
Beamable tbl =>
SqlConflictTarget Postgres tbl
-> SqlConflictAction Postgres tbl -> PgInsertOnConflict tbl
onConflict (PgInsertOnConflictTarget tbl (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax
tgt) (PgConflictAction tbl (QField QInternal) -> PgConflictActionSyntax
update_) =
forall (tbl :: (* -> *) -> *).
(tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
PgInsertOnConflict forall a b. (a -> b) -> a -> b
$ \tbl (QField QInternal)
tbl ->
let exprTbl :: tbl (QExpr Postgres QInternal)
exprTbl = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField Bool
_ Text
_ Text
nm)) ->
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField Text
nm))))
tbl (QField QInternal)
tbl
in PgSyntax -> PgInsertOnConflictSyntax
PgInsertOnConflictSyntax forall a b. (a -> b) -> a -> b
$
ByteString -> PgSyntax
emit ByteString
"ON CONFLICT " forall a. Semigroup a => a -> a -> a
<> PgInsertOnConflictTargetSyntax -> PgSyntax
fromPgInsertOnConflictTarget (tbl (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax
tgt tbl (QExpr Postgres QInternal)
exprTbl)
forall a. Semigroup a => a -> a -> a
<> PgConflictActionSyntax -> PgSyntax
fromPgConflictAction (tbl (QField QInternal) -> PgConflictActionSyntax
update_ tbl (QField QInternal)
tbl)
conflictingConstraint :: T.Text -> SqlConflictTarget Postgres tbl
conflictingConstraint :: forall (tbl :: (* -> *) -> *).
Text -> SqlConflictTarget Postgres tbl
conflictingConstraint Text
nm =
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
-> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget forall a b. (a -> b) -> a -> b
$ \tbl (QExpr Postgres QInternal)
_ ->
PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax forall a b. (a -> b) -> a -> b
$
ByteString -> PgSyntax
emit ByteString
"ON CONSTRAINT " forall a. Semigroup a => a -> a -> a
<> Text -> PgSyntax
pgQuotedIdentifier Text
nm forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" "
data PgUpdateReturning a
= PgUpdateReturning PgSyntax
| PgUpdateReturningEmpty
updateReturning :: Projectible Postgres a
=> DatabaseEntity Postgres be (TableEntity table)
-> (forall s. table (QField s) -> QAssignment Postgres s)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgUpdateReturning (QExprToIdentity a)
updateReturning :: forall a (be :: (* -> *) -> *) (table :: (* -> *) -> *).
Projectible Postgres a =>
DatabaseEntity Postgres be (TableEntity table)
-> (forall s. table (QField s) -> QAssignment Postgres s)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgUpdateReturning (QExprToIdentity a)
updateReturning table :: DatabaseEntity Postgres be (TableEntity table)
table@(DatabaseEntity (DatabaseTable { dbTableSettings :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings = TableSettings table
tblSettings }))
forall s. table (QField s) -> QAssignment Postgres s
mkAssignments
forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere
table (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
case forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> (forall s. table (QField s) -> QAssignment be s)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
update DatabaseEntity Postgres be (TableEntity table)
table forall s. table (QField s) -> QAssignment Postgres s
mkAssignments forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere of
SqlUpdate TableSettings table
_ BeamSqlBackendUpdateSyntax Postgres
pgUpdate ->
forall a. PgSyntax -> PgUpdateReturning a
PgUpdateReturning forall a b. (a -> b) -> a -> b
$
PgUpdateSyntax -> PgSyntax
fromPgUpdate BeamSqlBackendUpdateSyntax Postgres
pgUpdate forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (table (QExpr Postgres PostgresInaccessible) -> a
mkProjection table (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t"))
SqlUpdate Postgres table
SqlIdentityUpdate -> forall a. PgUpdateReturning a
PgUpdateReturningEmpty
where
tblQ :: table (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
f)))))) TableSettings table
tblSettings
runPgUpdateReturningList
:: ( MonadBeam be m
, BeamSqlBackendSyntax be ~ PgCommandSyntax
, FromBackendRow be a
)
=> PgUpdateReturning a
-> m [a]
runPgUpdateReturningList :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackendSyntax be ~ PgCommandSyntax,
FromBackendRow be a) =>
PgUpdateReturning a -> m [a]
runPgUpdateReturningList = \case
PgUpdateReturning a
PgUpdateReturningEmpty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
PgUpdateReturning PgSyntax
syntax -> forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax
newtype PgDeleteReturning a = PgDeleteReturning PgSyntax
deleteReturning :: Projectible Postgres a
=> DatabaseEntity Postgres be (TableEntity table)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgDeleteReturning (QExprToIdentity a)
deleteReturning :: forall a (be :: (* -> *) -> *) (table :: (* -> *) -> *).
Projectible Postgres a =>
DatabaseEntity Postgres be (TableEntity table)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> (table (QExpr Postgres PostgresInaccessible) -> a)
-> PgDeleteReturning (QExprToIdentity a)
deleteReturning table :: DatabaseEntity Postgres be (TableEntity table)
table@(DatabaseEntity (DatabaseTable { dbTableSettings :: forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings = TableSettings table
tblSettings }))
forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere
table (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
forall a. PgSyntax -> PgDeleteReturning a
PgDeleteReturning forall a b. (a -> b) -> a -> b
$
PgDeleteSyntax -> PgSyntax
fromPgDelete BeamSqlBackendDeleteSyntax Postgres
pgDelete forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (table (QExpr Postgres PostgresInaccessible) -> a
mkProjection table (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t"))
where
SqlDelete TableSettings table
_ BeamSqlBackendDeleteSyntax Postgres
pgDelete = forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
BeamSqlBackend be =>
DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete DatabaseEntity Postgres be (TableEntity table)
table forall a b. (a -> b) -> a -> b
$ \forall s'. table (QExpr Postgres s')
t -> forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere forall s'. table (QExpr Postgres s')
t
tblQ :: table (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
f)))))) TableSettings table
tblSettings
runPgDeleteReturningList
:: ( MonadBeam be m
, BeamSqlBackendSyntax be ~ PgCommandSyntax
, FromBackendRow be a
)
=> PgDeleteReturning a
-> m [a]
runPgDeleteReturningList :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackendSyntax be ~ PgCommandSyntax,
FromBackendRow be a) =>
PgDeleteReturning a -> m [a]
runPgDeleteReturningList (PgDeleteReturning PgSyntax
syntax) = forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax
class PgReturning cmd where
type PgReturningType cmd :: * -> *
returning :: (Beamable tbl, Projectible Postgres a)
=> cmd Postgres tbl -> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType cmd (QExprToIdentity a)
instance PgReturning SqlInsert where
type PgReturningType SqlInsert = PgInsertReturning
returning :: forall (tbl :: (* -> *) -> *) a.
(Beamable tbl, Projectible Postgres a) =>
SqlInsert Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlInsert (QExprToIdentity a)
returning SqlInsert Postgres tbl
SqlInsertNoRows tbl (QExpr Postgres PostgresInaccessible) -> a
_ = forall a. PgInsertReturning a
PgInsertReturningEmpty
returning (SqlInsert TableSettings tbl
tblSettings (PgInsertSyntax PgSyntax
syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
forall a. PgSyntax -> PgInsertReturning a
PgInsertReturning forall a b. (a -> b) -> a -> b
$
PgSyntax
syntax forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection tbl (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t"))
where
tblQ :: tbl (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField tbl) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
f)) TableSettings tbl
tblSettings
instance PgReturning SqlUpdate where
type PgReturningType SqlUpdate = PgUpdateReturning
returning :: forall (tbl :: (* -> *) -> *) a.
(Beamable tbl, Projectible Postgres a) =>
SqlUpdate Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlUpdate (QExprToIdentity a)
returning SqlUpdate Postgres tbl
SqlIdentityUpdate tbl (QExpr Postgres PostgresInaccessible) -> a
_ = forall a. PgUpdateReturning a
PgUpdateReturningEmpty
returning (SqlUpdate TableSettings tbl
tblSettings (PgUpdateSyntax PgSyntax
syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
forall a. PgSyntax -> PgUpdateReturning a
PgUpdateReturning forall a b. (a -> b) -> a -> b
$
PgSyntax
syntax forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection tbl (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t"))
where
tblQ :: tbl (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField tbl) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
f)) TableSettings tbl
tblSettings
instance PgReturning SqlDelete where
type PgReturningType SqlDelete = PgDeleteReturning
returning :: forall (tbl :: (* -> *) -> *) a.
(Beamable tbl, Projectible Postgres a) =>
SqlDelete Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlDelete (QExprToIdentity a)
returning (SqlDelete TableSettings tbl
tblSettings (PgDeleteSyntax PgSyntax
syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
forall a. PgSyntax -> PgDeleteReturning a
PgDeleteReturning forall a b. (a -> b) -> a -> b
$
PgSyntax
syntax forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") (forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection tbl (QExpr Postgres PostgresInaccessible)
tblQ) Text
"t"))
where
tblQ :: tbl (QExpr Postgres PostgresInaccessible)
tblQ = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField tbl) a
f) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
f)) TableSettings tbl
tblSettings
instance BeamHasInsertOnConflict Postgres where
newtype SqlConflictTarget Postgres table =
PgInsertOnConflictTarget (table (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax)
newtype SqlConflictAction Postgres table =
PgConflictAction (table (QField QInternal) -> PgConflictActionSyntax)
insertOnConflict :: forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) s.
Beamable table =>
DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> SqlConflictTarget Postgres table
-> SqlConflictAction Postgres table
-> SqlInsert Postgres table
insertOnConflict DatabaseEntity Postgres db (TableEntity table)
tbl SqlInsertValues Postgres (table (QExpr Postgres s))
vs SqlConflictTarget Postgres table
target SqlConflictAction Postgres table
action = forall (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> SqlInsert Postgres table
insert DatabaseEntity Postgres db (TableEntity table)
tbl SqlInsertValues Postgres (table (QExpr Postgres s))
vs forall a b. (a -> b) -> a -> b
$ forall (tbl :: (* -> *) -> *).
Beamable tbl =>
SqlConflictTarget Postgres tbl
-> SqlConflictAction Postgres tbl -> PgInsertOnConflict tbl
onConflict SqlConflictTarget Postgres table
target SqlConflictAction Postgres table
action
anyConflict :: forall (table :: (* -> *) -> *). SqlConflictTarget Postgres table
anyConflict = forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
-> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget (\table (QExpr Postgres QInternal)
_ -> PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax forall a. Monoid a => a
mempty)
onConflictDoNothing :: forall (table :: (* -> *) -> *). SqlConflictAction Postgres table
onConflictDoNothing = forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
_ -> PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax (ByteString -> PgSyntax
emit ByteString
"DO NOTHING")
onConflictUpdateSet :: forall (table :: (* -> *) -> *).
Beamable table =>
(forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s)
-> SqlConflictAction Postgres table
onConflictUpdateSet forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s
mkAssignments =
forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
tbl ->
let QAssignment [(BeamSqlBackendFieldNameSyntax Postgres,
BeamSqlBackendExpressionSyntax Postgres)]
assignments = forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s
mkAssignments table (QField QInternal)
tbl table (QExpr Postgres QInternal)
tblExcluded
tblExcluded :: table (QExpr Postgres QInternal)
tblExcluded = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField Bool
_ Text
_ Text
nm)) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
"excluded" Text
nm)))) table (QField QInternal)
tbl
assignmentSyntaxes :: [PgSyntax]
assignmentSyntaxes =
[ PgFieldNameSyntax -> PgSyntax
fromPgFieldName PgFieldNameSyntax
fieldNm forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
"=" forall a. Semigroup a => a -> a -> a
<> PgSyntax -> PgSyntax
pgParens (PgExpressionSyntax -> PgSyntax
fromPgExpression PgExpressionSyntax
expr)
| (PgFieldNameSyntax
fieldNm, PgExpressionSyntax
expr) <- [(BeamSqlBackendFieldNameSyntax Postgres,
BeamSqlBackendExpressionSyntax Postgres)]
assignments ]
in PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax forall a b. (a -> b) -> a -> b
$
ByteString -> PgSyntax
emit ByteString
"DO UPDATE SET " forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") [PgSyntax]
assignmentSyntaxes
onConflictUpdateSetWhere :: forall (table :: (* -> *) -> *).
Beamable table =>
(forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s)
-> (forall s.
table (QField s)
-> table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> SqlConflictAction Postgres table
onConflictUpdateSetWhere forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s
mkAssignments forall s.
table (QField s)
-> table (QExpr Postgres s) -> QExpr Postgres s Bool
where_ =
forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
tbl ->
let QAssignment [(BeamSqlBackendFieldNameSyntax Postgres,
BeamSqlBackendExpressionSyntax Postgres)]
assignments = forall s.
table (QField s)
-> table (QExpr Postgres s) -> QAssignment Postgres s
mkAssignments table (QField QInternal)
tbl table (QExpr Postgres QInternal)
tblExcluded
QExpr WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
where_' = forall s.
table (QField s)
-> table (QExpr Postgres s) -> QExpr Postgres s Bool
where_ table (QField QInternal)
tbl table (QExpr Postgres QInternal)
tblExcluded
tblExcluded :: table (QExpr Postgres QInternal)
tblExcluded = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField Bool
_ Text
_ Text
nm)) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
"excluded" Text
nm)))) table (QField QInternal)
tbl
assignmentSyntaxes :: [PgSyntax]
assignmentSyntaxes =
[ PgFieldNameSyntax -> PgSyntax
fromPgFieldName PgFieldNameSyntax
fieldNm forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
"=" forall a. Semigroup a => a -> a -> a
<> PgSyntax -> PgSyntax
pgParens (PgExpressionSyntax -> PgSyntax
fromPgExpression PgExpressionSyntax
expr)
| (PgFieldNameSyntax
fieldNm, PgExpressionSyntax
expr) <- [(BeamSqlBackendFieldNameSyntax Postgres,
BeamSqlBackendExpressionSyntax Postgres)]
assignments ]
in PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax forall a b. (a -> b) -> a -> b
$
ByteString -> PgSyntax
emit ByteString
"DO UPDATE SET " forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") [PgSyntax]
assignmentSyntaxes forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" WHERE " forall a. Semigroup a => a -> a -> a
<> PgExpressionSyntax -> PgSyntax
fromPgExpression (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
where_' Text
"t")
conflictingFields :: forall proj (table :: (* -> *) -> *).
Projectible Postgres proj =>
(table (QExpr Postgres QInternal) -> proj)
-> SqlConflictTarget Postgres table
conflictingFields table (QExpr Postgres QInternal) -> proj
makeProjection =
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
-> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget forall a b. (a -> b) -> a -> b
$ \table (QExpr Postgres QInternal)
tbl ->
PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax forall a b. (a -> b) -> a -> b
$
PgSyntax -> PgSyntax
pgParens (PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression forall a b. (a -> b) -> a -> b
$
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres) (table (QExpr Postgres QInternal) -> proj
makeProjection table (QExpr Postgres QInternal)
tbl) Text
"t") forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
" "
conflictingFieldsWhere :: forall proj (table :: (* -> *) -> *).
Projectible Postgres proj =>
(table (QExpr Postgres QInternal) -> proj)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> SqlConflictTarget Postgres table
conflictingFieldsWhere table (QExpr Postgres QInternal) -> proj
makeProjection forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
makeWhere =
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
-> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget forall a b. (a -> b) -> a -> b
$ \table (QExpr Postgres QInternal)
tbl ->
PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax forall a b. (a -> b) -> a -> b
$
PgSyntax -> PgSyntax
pgParens (PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (forall {k} (t :: k). Proxy t
Proxy @Postgres)
(table (QExpr Postgres QInternal) -> proj
makeProjection table (QExpr Postgres QInternal)
tbl) Text
"t")) forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
" WHERE " forall a. Semigroup a => a -> a -> a
<>
PgSyntax -> PgSyntax
pgParens (let QExpr WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
mkE = forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
makeWhere table (QExpr Postgres QInternal)
tbl
PgExpressionSyntax PgSyntax
e = WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
mkE Text
"t"
in PgSyntax
e) forall a. Semigroup a => a -> a -> a
<>
ByteString -> PgSyntax
emit ByteString
" "