{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Module providing (almost) full support for Postgres query and data
-- manipulation statements. These functions shadow the functions in
-- "Database.Beam.Query" and provide a strict superset of functionality. They
-- map 1-to-1 with the underlying Postgres support.
module Database.Beam.Postgres.Full
  ( -- * Additional @SELECT@ features

    -- ** @SELECT@ Locking clause
    PgWithLocking, PgLockedTables
  , PgSelectLockingStrength(..), PgSelectLockingOptions(..)
  , lockingAllTablesFor_, lockingFor_

  , locked_, lockAll_, withLocks_

  -- ** Lateral joins
  , lateral_

  -- * @INSERT@ and @INSERT RETURNING@
  , insert, insertReturning
  , insertDefaults
  , runPgInsertReturningList

  , PgInsertReturning(..)

  -- ** Specifying conflict actions

  , PgInsertOnConflict(..)

  , onConflictDefault, onConflict
  , conflictingConstraint
  , BeamHasInsertOnConflict(..)
  , onConflictUpdateAll
  , onConflictUpdateInstead

  -- * @UPDATE RETURNING@
  , PgUpdateReturning(..)
  , runPgUpdateReturningList
  , updateReturning

  -- * @DELETE RETURNING@
  , PgDeleteReturning(..)
  , runPgDeleteReturningList
  , deleteReturning

  -- * Generalized @RETURNING@
  , 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

-- * @SELECT@

-- | An explicit lock against some tables. You can create a value of this type using the 'locked_'
-- function. You can combine these values monoidally to combine multiple locks for use with the
-- 'withLocks_' function.
newtype PgLockedTables s = PgLockedTables [ T.Text ]
  deriving (b -> PgLockedTables s -> PgLockedTables s
NonEmpty (PgLockedTables s) -> PgLockedTables s
PgLockedTables s -> PgLockedTables s -> PgLockedTables s
(PgLockedTables s -> PgLockedTables s -> PgLockedTables s)
-> (NonEmpty (PgLockedTables s) -> PgLockedTables s)
-> (forall b.
    Integral b =>
    b -> PgLockedTables s -> PgLockedTables s)
-> Semigroup (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 :: 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, Semigroup (PgLockedTables s)
PgLockedTables s
Semigroup (PgLockedTables s)
-> PgLockedTables s
-> (PgLockedTables s -> PgLockedTables s -> PgLockedTables s)
-> ([PgLockedTables s] -> PgLockedTables s)
-> Monoid (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
$cp1Monoid :: forall s. Semigroup (PgLockedTables s)
Monoid)

-- | Combines the result of a query along with a set of locked tables. Used as a
-- return value for the 'lockingFor_' function.
data PgWithLocking s a = PgWithLocking (PgLockedTables s) a
instance ProjectibleWithPredicate c be res a => ProjectibleWithPredicate c be res (PgWithLocking s a) where
  project' :: 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) =
    PgLockedTables s -> a -> PgWithLocking s a
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking PgLockedTables s
tbls (a -> PgWithLocking s a) -> m a -> m (PgWithLocking s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy c
-> Proxy (be, res)
-> (forall context.
    c context =>
    Proxy context -> Proxy be -> res -> m res)
-> a
-> m a
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' :: 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 =
    PgLockedTables s -> a -> PgWithLocking s a
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking PgLockedTables s
forall a. Monoid a => a
mempty (a -> PgWithLocking s a) -> m a -> m (PgWithLocking s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy c
-> Proxy (be, res)
-> (forall context.
    c context =>
    Proxy context -> Proxy be -> m res)
-> m a
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

-- | Use with 'lockingFor_' to lock all tables mentioned in the query
lockAll_ :: a -> PgWithLocking s a
lockAll_ :: a -> PgWithLocking s a
lockAll_ = PgLockedTables s -> a -> PgWithLocking s a
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking PgLockedTables s
forall a. Monoid a => a
mempty

-- | Return and lock the given tables. Typically used as an infix operator. See the
-- <https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres/ the user guide> for usage
-- examples
withLocks_ :: a -> PgLockedTables s -> PgWithLocking s a
withLocks_ :: a -> PgLockedTables s -> PgWithLocking s a
withLocks_ = (PgLockedTables s -> a -> PgWithLocking s a)
-> a -> PgLockedTables s -> PgWithLocking s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip PgLockedTables s -> a -> PgWithLocking s a
forall s a. PgLockedTables s -> a -> PgWithLocking s a
PgWithLocking

-- | Join with a table while locking it explicitly. Provides a 'PgLockedTables' value that can be
-- used with 'withLocks_' to explicitly lock a table during a @SELECT@ statement
locked_ :: (Beamable tbl, Database Postgres db)
        => DatabaseEntity Postgres db (TableEntity tbl)
        -> Q Postgres db s (PgLockedTables s, tbl (QExpr Postgres s))
locked_ :: 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 (QExpr Postgres s)
joined) <- QM Postgres db s (Text, tbl (QExpr Postgres s))
-> Q Postgres db s (Text, tbl (QExpr Postgres s))
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QF Postgres db s (Text, tbl (QExpr Postgres s))
-> QM Postgres db s (Text, tbl (QExpr Postgres s))
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Text -> Text -> BeamSqlBackendFromSyntax Postgres)
-> (Text -> tbl (QExpr Postgres s))
-> (tbl (QExpr Postgres s)
    -> Maybe
         (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)))
-> ((Text, tbl (QExpr Postgres s))
    -> (Text, tbl (QExpr Postgres s)))
-> QF Postgres db s (Text, tbl (QExpr Postgres s))
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
_ -> Sql92FromTableSourceSyntax PgFromSyntax
-> Maybe (Text, Maybe [Text]) -> PgFromSyntax
forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (Sql92TableSourceTableNameSyntax PgTableSourceSyntax
-> PgTableSourceSyntax
forall tblSource.
IsSql92TableSourceSyntax tblSource =>
Sql92TableSourceTableNameSyntax tblSource -> tblSource
tableNamed (Maybe Text -> Text -> PgTableNameSyntax
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (DatabaseEntityDescriptor Postgres (TableEntity tbl) -> Maybe Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt) (DatabaseEntityDescriptor Postgres (TableEntity tbl) -> Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))) (Maybe (Text, Maybe [Text]) -> PgFromSyntax)
-> (Text -> Maybe (Text, Maybe [Text])) -> Text -> PgFromSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                        (Text, Maybe [Text]) -> Maybe (Text, Maybe [Text])
forall a. a -> Maybe a
Just ((Text, Maybe [Text]) -> Maybe (Text, Maybe [Text]))
-> (Text -> (Text, Maybe [Text]))
-> Text
-> Maybe (Text, Maybe [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,Maybe [Text]
forall a. Maybe a
Nothing))
                                 (TableSettings tbl -> Text -> tbl (QExpr Postgres s)
forall be (table :: (* -> *) -> *) ctxt s.
(BeamSqlBackend be, Beamable table) =>
TableSettings table -> Text -> table (QGenExpr ctxt be s)
tableFieldsToExpressions (DatabaseEntityDescriptor Postgres (TableEntity tbl)
-> TableSettings tbl
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))
                                 (\tbl (QExpr Postgres s)
_ -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
forall a. Maybe a
Nothing) (Text, tbl (QExpr Postgres s)) -> (Text, tbl (QExpr Postgres s))
forall a. a -> a
id))
  (PgLockedTables s, tbl (QExpr Postgres s))
-> Q Postgres db s (PgLockedTables s, tbl (QExpr Postgres s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> PgLockedTables s
forall s. [Text] -> PgLockedTables s
PgLockedTables [Text
nm], tbl (QExpr Postgres s)
joined)

-- | Lock some tables during the execution of a query. This is rather complicated, and there are
-- several usage examples in
-- <https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres/ the user guide>
--
-- The Postgres locking clause is rather complex, and beam currently does not check several
-- pre-conditions. It is assumed you kinda know what you're doing.
--
-- Things which postgres doesn't like, but beam will do
--
-- * Using aggregates within a query that has a locking clause
-- * Using @UNION@, @INTERSECT@, or @EXCEPT@
--
--   See <https://www.postgresql.org/docs/10/static/sql-select.html#SQL-FOR-UPDATE-SHARE here> for
--   more details.
--
-- This function accepts a locking strength (@UPDATE@, @SHARE@, @KEY SHARE@, etc), an optional
-- locking option (@NOWAIT@ or @SKIP LOCKED@), and a query whose rows to lock. The query should
-- return its result wrapped in 'PgWithLocking', via the `withLocks_` or `lockAll_` function.
--
-- If you want to use the most common behavior (lock all rows in every table mentioned), the
-- 'lockingAllTablesFor_' function may be what you're after.
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
-> 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) =
  QM Postgres db s (WithRewrittenThread (QNested s) s a)
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QF Postgres db s (WithRewrittenThread (QNested s) s a)
-> QM Postgres db s (WithRewrittenThread (QNested s) s a)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((PgWithLocking (QNested s) a
 -> BeamSqlBackendSelectTableSyntax Postgres
 -> [BeamSqlBackendOrderingSyntax Postgres]
 -> Maybe Integer
 -> Maybe Integer
 -> BeamSqlBackendSelectSyntax Postgres)
-> QM Postgres db (QNested s) (PgWithLocking (QNested s) a)
-> (PgWithLocking (QNested s) a
    -> WithRewrittenThread (QNested s) s a)
-> QF Postgres db s (WithRewrittenThread (QNested s) s a)
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
_) BeamSqlBackendSelectTableSyntax 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 BeamSqlBackendSelectTableSyntax Postgres
PgSelectTableSyntax
tbl [BeamSqlBackendOrderingSyntax Postgres]
[PgOrderingSyntax]
ords Maybe Integer
limit Maybe Integer
offset (PgSelectLockingClauseSyntax -> Maybe PgSelectLockingClauseSyntax
forall a. a -> Maybe a
Just PgSelectLockingClauseSyntax
locking))
                         QM Postgres db (QNested s) (PgWithLocking (QNested s) a)
q (\(PgWithLocking PgLockedTables (QNested s)
_ a
a) -> Proxy s -> a -> WithRewrittenThread (QNested s) s a
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (Proxy s
forall k (t :: k). Proxy t
Proxy @s) a
a)))

-- | Like 'lockingFor_', but does not require an explicit set of locked tables. This produces an
-- empty @FOR .. OF@ clause.
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_ :: 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 =
  PgSelectLockingStrength
-> Maybe PgSelectLockingOptions
-> Q Postgres db (QNested s) (PgWithLocking (QNested s) a)
-> Q Postgres db s (WithRewrittenThread (QNested s) s a)
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 (a -> PgWithLocking (QNested s) a
forall a s. a -> PgWithLocking s a
lockAll_ (a -> PgWithLocking (QNested s) a)
-> Q Postgres db (QNested s) a
-> Q Postgres db (QNested s) (PgWithLocking (QNested s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Postgres db (QNested s) a
q)

-- * @INSERT@

-- | The Postgres @DEFAULT VALUES@ clause for the @INSERT@ command.
insertDefaults :: SqlInsertValues Postgres tbl
insertDefaults :: SqlInsertValues Postgres tbl
insertDefaults = BeamSqlBackendInsertValuesSyntax Postgres
-> SqlInsertValues Postgres tbl
forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (PgSyntax -> PgInsertValuesSyntax
PgInsertValuesSyntax (ByteString -> PgSyntax
emit ByteString
"DEFAULT VALUES"))

-- | A @beam-postgres@-specific version of 'Database.Beam.Query.insert', which
-- provides fuller support for the much richer Postgres @INSERT@ syntax. This
-- allows you to specify @ON CONFLICT@ actions. For even more complete support,
-- see 'insertReturning'.
insert :: DatabaseEntity Postgres db (TableEntity table)
       -> SqlInsertValues Postgres (table (QExpr Postgres s)) -- TODO arbitrary projectibles
       -> PgInsertOnConflict table
       -> SqlInsert Postgres table
insert :: 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 DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> Maybe
     (table (QExpr Postgres PostgresInaccessible)
      -> QExpr Postgres PostgresInaccessible Int)
-> PgInsertReturning
     (QExprToIdentity (QExpr Postgres PostgresInaccessible Int))
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
forall (table :: (* -> *) -> *).
Maybe
  (table (QExpr Postgres PostgresInaccessible)
   -> QExpr Postgres PostgresInaccessible Int)
Nothing :: Maybe (table (QExpr Postgres PostgresInaccessible) -> QExpr Postgres PostgresInaccessible Int)) of
    PgInsertReturning PgSyntax
a ->
      TableSettings table
-> BeamSqlBackendInsertSyntax Postgres -> SqlInsert Postgres table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (DatabaseEntityDescriptor Postgres (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity table)
dt) (PgSyntax -> PgInsertSyntax
PgInsertSyntax PgSyntax
a)
    PgInsertReturning
  (QExprToIdentity (QExpr Postgres PostgresInaccessible Int))
PgInsertReturningEmpty ->
      SqlInsert Postgres table
forall be (table :: (* -> *) -> *). SqlInsert be table
SqlInsertNoRows

-- | The most general kind of @INSERT@ that postgres can perform
data PgInsertReturning a
  = PgInsertReturning PgSyntax
  | PgInsertReturningEmpty

-- | The full Postgres @INSERT@ syntax, supporting conflict actions and the
-- @RETURNING CLAUSE@. See 'PgInsertOnConflict' for how to specify a conflict
-- action or provide 'onConflictDefault' to preserve the behavior without any
-- @ON CONFLICT@ clause. The last argument takes a newly inserted row and
-- returns the expression to be returned as part of the @RETURNING@ clause. For
-- a backend-agnostic version of this functionality see
-- 'MonadBeamInsertReturning'. Use 'runInsertReturning' to get the results.
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 :: 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)
_ = PgInsertReturning (QExprToIdentity a)
forall a. PgInsertReturning a
PgInsertReturningEmpty
insertReturning (DatabaseEntity tbl :: DatabaseEntityDescriptor Postgres (TableEntity table)
tbl@(DatabaseTable {}))
                (SqlInsertValues (PgInsertValuesSyntax insertValues_))
                (PgInsertOnConflict table (QField QInternal) -> PgInsertOnConflictSyntax
mkOnConflict)
                Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
mMkProjection =
  PgSyntax -> PgInsertReturning (QExprToIdentity a)
forall a. PgSyntax -> PgInsertReturning a
PgInsertReturning (PgSyntax -> PgInsertReturning (QExprToIdentity a))
-> PgSyntax -> PgInsertReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
  ByteString -> PgSyntax
emit ByteString
"INSERT INTO " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgTableNameSyntax -> PgSyntax
fromPgTableName (Maybe Text -> Text -> PgTableNameSyntax
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (DatabaseEntityDescriptor Postgres (TableEntity table) -> Maybe Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity table)
tbl) (DatabaseEntityDescriptor Postgres (TableEntity table) -> Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity table)
tbl)) PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> PgSyntax
emit ByteString
"(" PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((forall a. Columnar' (TableField table) a -> PgSyntax)
-> table (TableField table) -> [PgSyntax]
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 (TableField table a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
TableField table a
f)) table (TableField table)
tblSettings) PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
") " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
  PgSyntax
insertValues_ PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgInsertOnConflictSyntax -> PgSyntax
fromPgInsertOnConflict (table (QField QInternal) -> PgInsertOnConflictSyntax
mkOnConflict table (QField QInternal)
tblFields) PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
  (case Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
mMkProjection of
     Maybe (table (QExpr Postgres PostgresInaccessible) -> a)
Nothing -> PgSyntax
forall a. Monoid a => a
mempty
     Just table (QExpr Postgres PostgresInaccessible) -> a
mkProjection ->
         ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
         PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 a.
 Columnar' (TableField table) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> table (TableField table)
-> table (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (TableField table a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
TableField table a
f))))) table (TableField table)
tblSettings
     tblFields :: table (QField QInternal)
tblFields = (forall a.
 Columnar' (TableField table) a -> Columnar' (QField QInternal) a)
-> table (TableField table) -> table (QField QInternal)
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) -> Columnar (QField QInternal) a -> Columnar' (QField QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Bool -> Text -> Text -> QField QInternal a
forall s ty. Bool -> Text -> Text -> QField s ty
QField Bool
True (DatabaseEntityDescriptor Postgres (TableEntity table) -> Text
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity table)
tbl) (TableField table a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
TableField table a
f))) table (TableField table)
tblSettings

     tblSettings :: table (TableField table)
tblSettings = DatabaseEntityDescriptor Postgres (TableEntity table)
-> table (TableField table)
forall be (tbl :: (* -> *) -> *).
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 :: PgInsertReturning a -> m [a]
runPgInsertReturningList = \case
  PgInsertReturning a
PgInsertReturningEmpty -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  PgInsertReturning PgSyntax
syntax -> BeamSqlBackendSyntax be -> m [a]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (BeamSqlBackendSyntax be -> m [a])
-> BeamSqlBackendSyntax be -> m [a]
forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax

-- ** @ON CONFLICT@ clause

-- | What to do when an @INSERT@ statement inserts a row into the table @tbl@
-- that violates a constraint.
newtype PgInsertOnConflict (tbl :: (* -> *) -> *) =
    PgInsertOnConflict (tbl (QField QInternal) -> PgInsertOnConflictSyntax)

-- | Postgres @LATERAL JOIN@ support
--
-- Allows the use of variables introduced on the left side of a @JOIN@ to be used on the right hand
-- side.
--
-- Because of the default scoping rules, we can't use the typical monadic bind (@>>=@) operator to
-- create this join.
--
-- Instead, 'lateral_'  takes two  arguments. The first  is the  left hand side  of the  @JOIN@. The
-- second is a function that  takes the result of the first join and  uses those variables to create
-- the right hand side.
--
-- For example, to join table A with a subquery that returns the first three rows in B which matches
-- a column in A, ordered by another column in B:
--
-- > lateral_ (_tableA database) $ \tblA ->
-- >   limit_ 3 $
-- >   ordering_ (\(_, b) -> asc_ (_bField2 b)) $ do
-- >     b <- _tableB database
-- >     guard_ (_bField1 b ==. _aField1 a)
-- >     pure (a, b0
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
-> (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 (Proxy (QNested s) -> a -> WithRewrittenThread s (QNested s) a
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (Proxy (QNested s)
forall k (t :: k). Proxy t
Proxy @(QNested s)) a
using)
  QM Postgres db s (WithRewrittenThread (QNested s) s b)
-> Q Postgres db s (WithRewrittenThread (QNested s) s b)
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QF Postgres db s (WithRewrittenThread (QNested s) s b)
-> QM Postgres db s (WithRewrittenThread (QNested s) s b)
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (QM Postgres db (QNested s) b
-> (BeamSqlBackendFromSyntax Postgres
    -> BeamSqlBackendFromSyntax Postgres
    -> Maybe (BeamSqlBackendExpressionSyntax Postgres)
    -> BeamSqlBackendFromSyntax Postgres)
-> (b
    -> Maybe
         (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)))
-> (b -> WithRewrittenThread (QNested s) s b)
-> QF Postgres db s (WithRewrittenThread (QNested s) s b)
forall be r (db :: (* -> *) -> *) s next.
Projectible be r =>
QM be db (QNested s) r
-> (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
                           (\BeamSqlBackendFromSyntax Postgres
a BeamSqlBackendFromSyntax Postgres
b Maybe (BeamSqlBackendExpressionSyntax Postgres)
on' ->
                              case Maybe (BeamSqlBackendExpressionSyntax Postgres)
on' of
                                Maybe (BeamSqlBackendExpressionSyntax Postgres)
Nothing ->
                                  PgSyntax -> PgFromSyntax
PgFromSyntax (PgSyntax -> PgFromSyntax) -> PgSyntax -> PgFromSyntax
forall a b. (a -> b) -> a -> b
$
                                  PgFromSyntax -> PgSyntax
fromPgFrom BeamSqlBackendFromSyntax Postgres
PgFromSyntax
a PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" CROSS JOIN LATERAL " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgFromSyntax -> PgSyntax
fromPgFrom BeamSqlBackendFromSyntax Postgres
PgFromSyntax
b
                                Just BeamSqlBackendExpressionSyntax Postgres
on'' ->
                                  PgSyntax -> PgFromSyntax
PgFromSyntax (PgSyntax -> PgFromSyntax) -> PgSyntax -> PgFromSyntax
forall a b. (a -> b) -> a -> b
$
                                  PgFromSyntax -> PgSyntax
fromPgFrom BeamSqlBackendFromSyntax Postgres
PgFromSyntax
a PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" JOIN LATERAL " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgFromSyntax -> PgSyntax
fromPgFrom BeamSqlBackendFromSyntax Postgres
PgFromSyntax
b PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" ON " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgExpressionSyntax -> PgSyntax
fromPgExpression BeamSqlBackendExpressionSyntax Postgres
PgExpressionSyntax
on'')
                           (\b
_ -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
forall a. Maybe a
Nothing)
                           (Proxy s -> b -> WithRewrittenThread (QNested s) s b
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (Proxy s
forall k (t :: k). Proxy t
Proxy @s))))

-- | By default, Postgres will throw an error when a conflict is detected. This
-- preserves that functionality.
onConflictDefault :: PgInsertOnConflict tbl
onConflictDefault :: PgInsertOnConflict tbl
onConflictDefault = (tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
forall (tbl :: (* -> *) -> *).
(tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
PgInsertOnConflict (\tbl (QField QInternal)
_ -> PgSyntax -> PgInsertOnConflictSyntax
PgInsertOnConflictSyntax PgSyntax
forall a. Monoid a => a
mempty)

-- | Tells postgres what to do on an @INSERT@ conflict. The first argument is
-- the type of conflict to provide an action for. For example, to only provide
-- an action for certain fields, use 'conflictingFields'. Or to only provide an
-- action over certain fields where a particular condition is met, use
-- 'conflictingFields'. If you have a particular constraint violation in mind,
-- use 'conflictingConstraint'. To perform an action on any conflict, use
-- 'anyConflict'.
--
-- See the
-- <https://www.postgresql.org/docs/current/static/sql-insert.html Postgres documentation>.
onConflict :: Beamable tbl
           => SqlConflictTarget Postgres tbl
           -> SqlConflictAction Postgres tbl
           -> PgInsertOnConflict tbl
onConflict :: SqlConflictTarget Postgres tbl
-> SqlConflictAction Postgres tbl -> PgInsertOnConflict tbl
onConflict (PgInsertOnConflictTarget tgt) (PgConflictAction update_) =
  (tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
forall (tbl :: (* -> *) -> *).
(tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
PgInsertOnConflict ((tbl (QField QInternal) -> PgInsertOnConflictSyntax)
 -> PgInsertOnConflict tbl)
-> (tbl (QField QInternal) -> PgInsertOnConflictSyntax)
-> PgInsertOnConflict tbl
forall a b. (a -> b) -> a -> b
$ \tbl (QField QInternal)
tbl ->
  let exprTbl :: tbl (QExpr Postgres QInternal)
exprTbl = (forall a.
 Columnar' (QField QInternal) a
 -> Columnar' (QExpr Postgres QInternal) a)
-> tbl (QField QInternal) -> tbl (QExpr Postgres QInternal)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField _ _ nm)) ->
                                 Columnar (QExpr Postgres QInternal) a
-> Columnar' (QExpr Postgres QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres QInternal a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField Text
nm))))
                              tbl (QField QInternal)
tbl
  in PgSyntax -> PgInsertOnConflictSyntax
PgInsertOnConflictSyntax (PgSyntax -> PgInsertOnConflictSyntax)
-> PgSyntax -> PgInsertOnConflictSyntax
forall a b. (a -> b) -> a -> b
$
     ByteString -> PgSyntax
emit ByteString
"ON CONFLICT " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgInsertOnConflictTargetSyntax -> PgSyntax
fromPgInsertOnConflictTarget (tbl (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax
tgt tbl (QExpr Postgres QInternal)
exprTbl)
                         PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgConflictActionSyntax -> PgSyntax
fromPgConflictAction (tbl (QField QInternal) -> PgConflictActionSyntax
update_ tbl (QField QInternal)
tbl)

-- | Perform the action only if the given named constraint is violated
conflictingConstraint :: T.Text -> SqlConflictTarget Postgres tbl
conflictingConstraint :: Text -> SqlConflictTarget Postgres tbl
conflictingConstraint Text
nm =
  (tbl (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres tbl
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget ((tbl (QExpr Postgres QInternal) -> PgInsertOnConflictTargetSyntax)
 -> SqlConflictTarget Postgres tbl)
-> (tbl (QExpr Postgres QInternal)
    -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres tbl
forall a b. (a -> b) -> a -> b
$ \tbl (QExpr Postgres QInternal)
_ ->
  PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax (PgSyntax -> PgInsertOnConflictTargetSyntax)
-> PgSyntax -> PgInsertOnConflictTargetSyntax
forall a b. (a -> b) -> a -> b
$
  ByteString -> PgSyntax
emit ByteString
"ON CONSTRAINT " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> Text -> PgSyntax
pgQuotedIdentifier Text
nm PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" "

-- * @UPDATE@

-- | The most general kind of @UPDATE@ that postgres can perform
--
-- You can build this from a 'SqlUpdate' by using 'returning'
--
-- > update tbl where `returning` projection
--
-- Run the result with 'runPgUpdateReturningList'
data PgUpdateReturning a
  = PgUpdateReturning PgSyntax
  | PgUpdateReturningEmpty

-- | Postgres @UPDATE ... RETURNING@ statement support. The last
-- argument takes the newly inserted row and returns the values to be
-- returned. Use 'runUpdateReturning' to get the results.
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 :: 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 = 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 DatabaseEntity Postgres be (TableEntity table)
-> (forall s. table (QField s) -> QAssignment Postgres s)
-> (forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool)
-> SqlUpdate Postgres table
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 ->
      PgSyntax -> PgUpdateReturning (QExprToIdentity a)
forall a. PgSyntax -> PgUpdateReturning a
PgUpdateReturning (PgSyntax -> PgUpdateReturning (QExprToIdentity a))
-> PgSyntax -> PgUpdateReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
      PgUpdateSyntax -> PgSyntax
fromPgUpdate BeamSqlBackendUpdateSyntax Postgres
PgUpdateSyntax
pgUpdate PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
      ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
      PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 -> PgUpdateReturning (QExprToIdentity a)
forall a. PgUpdateReturning a
PgUpdateReturningEmpty
  where
    tblQ :: table (QExpr Postgres PostgresInaccessible)
tblQ = (forall a.
 Columnar' (TableField table) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> TableSettings table
-> table (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (PgExpressionSyntax -> Text -> PgExpressionSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (TableField table a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
TableField table a
f)))))) TableSettings table
tblSettings

runPgUpdateReturningList
  :: ( MonadBeam be m
     , BeamSqlBackendSyntax be ~ PgCommandSyntax
     , FromBackendRow be a
     )
  => PgUpdateReturning a
  -> m [a]
runPgUpdateReturningList :: PgUpdateReturning a -> m [a]
runPgUpdateReturningList = \case
  PgUpdateReturning a
PgUpdateReturningEmpty -> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  PgUpdateReturning PgSyntax
syntax -> BeamSqlBackendSyntax be -> m [a]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (BeamSqlBackendSyntax be -> m [a])
-> BeamSqlBackendSyntax be -> m [a]
forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax

-- * @DELETE@

-- | The most general kind of @DELETE@ that postgres can perform
--
-- You can build this from a 'SqlDelete' by using 'returning'
--
-- > delete tbl where `returning` projection
--
-- Run the result with 'runPgDeleteReturningList'
newtype PgDeleteReturning a = PgDeleteReturning PgSyntax

-- | Postgres @DELETE ... RETURNING@ statement support. The last
-- argument takes the newly inserted row and returns the values to be
-- returned. Use 'runDeleteReturning' to get the results.
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 :: 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 = tblSettings }))
                forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere
                table (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
  PgSyntax -> PgDeleteReturning (QExprToIdentity a)
forall a. PgSyntax -> PgDeleteReturning a
PgDeleteReturning (PgSyntax -> PgDeleteReturning (QExprToIdentity a))
-> PgSyntax -> PgDeleteReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
  PgDeleteSyntax -> PgSyntax
fromPgDelete BeamSqlBackendDeleteSyntax Postgres
PgDeleteSyntax
pgDelete PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
  PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 = DatabaseEntity Postgres be (TableEntity table)
-> (forall s.
    (forall s'. table (QExpr Postgres s')) -> QExpr Postgres s Bool)
-> SqlDelete Postgres table
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 s. table (QExpr Postgres s) -> QExpr Postgres s Bool
forall s.
(forall s'. table (QExpr Postgres s')) -> QExpr Postgres s Bool
mkWhere
    tblQ :: table (QExpr Postgres PostgresInaccessible)
tblQ = (forall a.
 Columnar' (TableField table) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> TableSettings table
-> table (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (PgExpressionSyntax -> Text -> PgExpressionSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (TableField table a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName Columnar (TableField table) a
TableField table a
f)))))) TableSettings table
tblSettings

runPgDeleteReturningList
  :: ( MonadBeam be m
     , BeamSqlBackendSyntax be ~ PgCommandSyntax
     , FromBackendRow be a
     )
  => PgDeleteReturning a
  -> m [a]
runPgDeleteReturningList :: PgDeleteReturning a -> m [a]
runPgDeleteReturningList (PgDeleteReturning PgSyntax
syntax) = BeamSqlBackendSyntax be -> m [a]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (BeamSqlBackendSyntax be -> m [a])
-> BeamSqlBackendSyntax be -> m [a]
forall a b. (a -> b) -> a -> b
$ PgCommandType -> PgSyntax -> PgCommandSyntax
PgCommandSyntax PgCommandType
PgCommandTypeDataUpdateReturning PgSyntax
syntax

-- * General @RETURNING@ support

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 :: SqlInsert Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlInsert (QExprToIdentity a)
returning SqlInsert Postgres tbl
SqlInsertNoRows tbl (QExpr Postgres PostgresInaccessible) -> a
_ = PgReturningType SqlInsert (QExprToIdentity a)
forall a. PgInsertReturning a
PgInsertReturningEmpty
  returning (SqlInsert TableSettings tbl
tblSettings (PgInsertSyntax syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
    PgSyntax -> PgInsertReturning (QExprToIdentity a)
forall a. PgSyntax -> PgInsertReturning a
PgInsertReturning (PgSyntax -> PgInsertReturning (QExprToIdentity a))
-> PgSyntax -> PgInsertReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
    PgSyntax
syntax PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 a.
 Columnar' (TableField tbl) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> TableSettings tbl -> tbl (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> PgExpressionSyntax)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr ((Text -> PgExpressionSyntax)
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> (TableField tbl a -> Text -> PgExpressionSyntax)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgExpressionSyntax -> Text -> PgExpressionSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PgExpressionSyntax -> Text -> PgExpressionSyntax)
-> (TableField tbl a -> PgExpressionSyntax)
-> TableField tbl a
-> Text
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgFieldNameSyntax -> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> PgExpressionSyntax)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (Text -> PgFieldNameSyntax)
-> (TableField tbl a -> Text)
-> TableField tbl a
-> PgFieldNameSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableField tbl a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName (TableField tbl a
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
TableField tbl a
f)) TableSettings tbl
tblSettings

instance PgReturning SqlUpdate where
  type PgReturningType SqlUpdate = PgUpdateReturning

  returning :: SqlUpdate Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlUpdate (QExprToIdentity a)
returning SqlUpdate Postgres tbl
SqlIdentityUpdate tbl (QExpr Postgres PostgresInaccessible) -> a
_ = PgReturningType SqlUpdate (QExprToIdentity a)
forall a. PgUpdateReturning a
PgUpdateReturningEmpty
  returning (SqlUpdate TableSettings tbl
tblSettings (PgUpdateSyntax syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
    PgSyntax -> PgUpdateReturning (QExprToIdentity a)
forall a. PgSyntax -> PgUpdateReturning a
PgUpdateReturning (PgSyntax -> PgUpdateReturning (QExprToIdentity a))
-> PgSyntax -> PgUpdateReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
    PgSyntax
syntax PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 a.
 Columnar' (TableField tbl) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> TableSettings tbl -> tbl (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> PgExpressionSyntax)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr ((Text -> PgExpressionSyntax)
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> (TableField tbl a -> Text -> PgExpressionSyntax)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgExpressionSyntax -> Text -> PgExpressionSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PgExpressionSyntax -> Text -> PgExpressionSyntax)
-> (TableField tbl a -> PgExpressionSyntax)
-> TableField tbl a
-> Text
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgFieldNameSyntax -> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> PgExpressionSyntax)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (Text -> PgFieldNameSyntax)
-> (TableField tbl a -> Text)
-> TableField tbl a
-> PgFieldNameSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableField tbl a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName (TableField tbl a
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
TableField tbl a
f)) TableSettings tbl
tblSettings

instance PgReturning SqlDelete where
  type PgReturningType SqlDelete = PgDeleteReturning

  returning :: SqlDelete Postgres tbl
-> (tbl (QExpr Postgres PostgresInaccessible) -> a)
-> PgReturningType SqlDelete (QExprToIdentity a)
returning (SqlDelete TableSettings tbl
tblSettings (PgDeleteSyntax syntax)) tbl (QExpr Postgres PostgresInaccessible) -> a
mkProjection =
    PgSyntax -> PgDeleteReturning (QExprToIdentity a)
forall a. PgSyntax -> PgDeleteReturning a
PgDeleteReturning (PgSyntax -> PgDeleteReturning (QExprToIdentity a))
-> PgSyntax -> PgDeleteReturning (QExprToIdentity a)
forall a b. (a -> b) -> a -> b
$
    PgSyntax
syntax PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" RETURNING " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ((PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
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 a.
 Columnar' (TableField tbl) a
 -> Columnar' (QExpr Postgres PostgresInaccessible) a)
-> TableSettings tbl -> tbl (QExpr Postgres PostgresInaccessible)
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) -> Columnar (QExpr Postgres PostgresInaccessible) a
-> Columnar' (QExpr Postgres PostgresInaccessible) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((Text -> PgExpressionSyntax)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr ((Text -> PgExpressionSyntax)
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> (TableField tbl a -> Text -> PgExpressionSyntax)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgExpressionSyntax -> Text -> PgExpressionSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PgExpressionSyntax -> Text -> PgExpressionSyntax)
-> (TableField tbl a -> PgExpressionSyntax)
-> TableField tbl a
-> Text
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgFieldNameSyntax -> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> PgExpressionSyntax)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> PgExpressionSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> fn
unqualifiedField (Text -> PgFieldNameSyntax)
-> (TableField tbl a -> Text)
-> TableField tbl a
-> PgFieldNameSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableField tbl a -> Text
forall (table :: (* -> *) -> *) ty. TableField table ty -> Text
_fieldName (TableField tbl a
 -> QGenExpr QValueContext Postgres PostgresInaccessible a)
-> TableField tbl a
-> QGenExpr QValueContext Postgres PostgresInaccessible a
forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a
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 :: 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 = DatabaseEntity Postgres db (TableEntity table)
-> SqlInsertValues Postgres (table (QExpr Postgres s))
-> PgInsertOnConflict table
-> SqlInsert Postgres table
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 (PgInsertOnConflict table -> SqlInsert Postgres table)
-> PgInsertOnConflict table -> SqlInsert Postgres table
forall a b. (a -> b) -> a -> b
$ SqlConflictTarget Postgres table
-> SqlConflictAction Postgres table -> PgInsertOnConflict table
forall (tbl :: (* -> *) -> *).
Beamable tbl =>
SqlConflictTarget Postgres tbl
-> SqlConflictAction Postgres tbl -> PgInsertOnConflict tbl
onConflict SqlConflictTarget Postgres table
target SqlConflictAction Postgres table
action

  -- | Perform the conflict action when any constraint or index conflict occurs.
  -- Syntactically, this is the @ON CONFLICT@ clause, without any /conflict target/.
  anyConflict :: SqlConflictTarget Postgres table
anyConflict = (table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget (\table (QExpr Postgres QInternal)
_ -> PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax PgSyntax
forall a. Monoid a => a
mempty)

  -- | The Postgres @DO NOTHING@ action
  onConflictDoNothing :: SqlConflictAction Postgres table
onConflictDoNothing = (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction ((table (QField QInternal) -> PgConflictActionSyntax)
 -> SqlConflictAction Postgres table)
-> (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
_ -> PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax (ByteString -> PgSyntax
emit ByteString
"DO NOTHING")

  -- | The Postgres @DO UPDATE SET@ action, without the @WHERE@ clause. The
  -- argument takes an updatable row (like the one used in 'update') and the
  -- conflicting row. Use 'current_' on the first argument to get the current
  -- value of the row in the database.
  onConflictUpdateSet :: (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 =
    (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction ((table (QField QInternal) -> PgConflictActionSyntax)
 -> SqlConflictAction Postgres table)
-> (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
tbl ->
    let QAssignment [(BeamSqlBackendFieldNameSyntax Postgres,
  BeamSqlBackendExpressionSyntax Postgres)]
assignments = table (QField QInternal)
-> table (QExpr Postgres QInternal)
-> QAssignment Postgres QInternal
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 a.
 Columnar' (QField QInternal) a
 -> Columnar' (QExpr Postgres QInternal) a)
-> table (QField QInternal) -> table (QExpr Postgres QInternal)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar (QExpr Postgres QInternal) a
-> Columnar' (QExpr Postgres QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres QInternal a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
"excluded" Text
nm)))) table (QField QInternal)
tbl

        assignmentSyntaxes :: [PgSyntax]
assignmentSyntaxes =
          [ PgFieldNameSyntax -> PgSyntax
fromPgFieldName PgFieldNameSyntax
fieldNm PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
"=" PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgSyntax -> PgSyntax
pgParens (PgExpressionSyntax -> PgSyntax
fromPgExpression PgExpressionSyntax
expr)
          | (PgFieldNameSyntax
fieldNm, PgExpressionSyntax
expr) <- [(BeamSqlBackendFieldNameSyntax Postgres,
  BeamSqlBackendExpressionSyntax Postgres)]
[(PgFieldNameSyntax, PgExpressionSyntax)]
assignments ]
    in PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax (PgSyntax -> PgConflictActionSyntax)
-> PgSyntax -> PgConflictActionSyntax
forall a b. (a -> b) -> a -> b
$
       ByteString -> PgSyntax
emit ByteString
"DO UPDATE SET " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") [PgSyntax]
assignmentSyntaxes

  -- | The Postgres @DO UPDATE SET@ action, with the @WHERE@ clause. This is like
  -- 'onConflictUpdateSet', but only rows satisfying the given condition are
  -- updated. Sometimes this results in more efficient locking. See the Postgres
  -- <https://www.postgresql.org/docs/current/static/sql-insert.html manual> for
  -- more information.
  onConflictUpdateSetWhere :: (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_ =
    (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall (table :: (* -> *) -> *).
(table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
PgConflictAction ((table (QField QInternal) -> PgConflictActionSyntax)
 -> SqlConflictAction Postgres table)
-> (table (QField QInternal) -> PgConflictActionSyntax)
-> SqlConflictAction Postgres table
forall a b. (a -> b) -> a -> b
$ \table (QField QInternal)
tbl ->
    let QAssignment [(BeamSqlBackendFieldNameSyntax Postgres,
  BeamSqlBackendExpressionSyntax Postgres)]
assignments = table (QField QInternal)
-> table (QExpr Postgres QInternal)
-> QAssignment Postgres QInternal
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_' = table (QField QInternal)
-> table (QExpr Postgres QInternal)
-> QGenExpr QValueContext Postgres QInternal Bool
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 a.
 Columnar' (QField QInternal) a
 -> Columnar' (QExpr Postgres QInternal) a)
-> table (QField QInternal) -> table (QExpr Postgres QInternal)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar (QExpr Postgres QInternal) a
-> Columnar' (QExpr Postgres QInternal) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres QInternal a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (\Text
_ -> Sql92ExpressionFieldNameSyntax PgExpressionSyntax
-> PgExpressionSyntax
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (Text -> Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
"excluded" Text
nm)))) table (QField QInternal)
tbl

        assignmentSyntaxes :: [PgSyntax]
assignmentSyntaxes =
          [ PgFieldNameSyntax -> PgSyntax
fromPgFieldName PgFieldNameSyntax
fieldNm PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
"=" PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgSyntax -> PgSyntax
pgParens (PgExpressionSyntax -> PgSyntax
fromPgExpression PgExpressionSyntax
expr)
          | (PgFieldNameSyntax
fieldNm, PgExpressionSyntax
expr) <- [(BeamSqlBackendFieldNameSyntax Postgres,
  BeamSqlBackendExpressionSyntax Postgres)]
[(PgFieldNameSyntax, PgExpressionSyntax)]
assignments ]
    in PgSyntax -> PgConflictActionSyntax
PgConflictActionSyntax (PgSyntax -> PgConflictActionSyntax)
-> PgSyntax -> PgConflictActionSyntax
forall a b. (a -> b) -> a -> b
$
       ByteString -> PgSyntax
emit ByteString
"DO UPDATE SET " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") [PgSyntax]
assignmentSyntaxes PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> ByteString -> PgSyntax
emit ByteString
" WHERE " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<> PgExpressionSyntax -> PgSyntax
fromPgExpression (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
where_' Text
"t")

  -- | Perform the conflict action only when these fields conflict. The first
  -- argument gets the current row as a table of expressions. Return the conflict
  -- key. For more information, see the @beam-postgres@ manual.
  conflictingFields :: (table (QExpr Postgres QInternal) -> proj)
-> SqlConflictTarget Postgres table
conflictingFields table (QExpr Postgres QInternal) -> proj
makeProjection =
    (table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget ((table (QExpr Postgres QInternal)
  -> PgInsertOnConflictTargetSyntax)
 -> SqlConflictTarget Postgres table)
-> (table (QExpr Postgres QInternal)
    -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
forall a b. (a -> b) -> a -> b
$ \table (QExpr Postgres QInternal)
tbl ->
    PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax (PgSyntax -> PgInsertOnConflictTargetSyntax)
-> PgSyntax -> PgInsertOnConflictTargetSyntax
forall a b. (a -> b) -> a -> b
$
    PgSyntax -> PgSyntax
pgParens (PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ([PgSyntax] -> PgSyntax) -> [PgSyntax] -> PgSyntax
forall a b. (a -> b) -> a -> b
$
              (PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression ([PgExpressionSyntax] -> [PgSyntax])
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> a -> b
$
              Proxy Postgres
-> proj
-> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
forall k (t :: k). Proxy t
Proxy @Postgres) (table (QExpr Postgres QInternal) -> proj
makeProjection table (QExpr Postgres QInternal)
tbl) Text
"t") PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> PgSyntax
emit ByteString
" "

  -- | Like 'conflictingFields', but only perform the action if the condition
  -- given in the second argument is met. See the postgres
  -- <https://www.postgresql.org/docs/current/static/sql-insert.html manual> for
  -- more information.
  conflictingFieldsWhere :: (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 =
    (table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
forall (table :: (* -> *) -> *).
(table (QExpr Postgres QInternal)
 -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
PgInsertOnConflictTarget ((table (QExpr Postgres QInternal)
  -> PgInsertOnConflictTargetSyntax)
 -> SqlConflictTarget Postgres table)
-> (table (QExpr Postgres QInternal)
    -> PgInsertOnConflictTargetSyntax)
-> SqlConflictTarget Postgres table
forall a b. (a -> b) -> a -> b
$ \table (QExpr Postgres QInternal)
tbl ->
    PgSyntax -> PgInsertOnConflictTargetSyntax
PgInsertOnConflictTargetSyntax (PgSyntax -> PgInsertOnConflictTargetSyntax)
-> PgSyntax -> PgInsertOnConflictTargetSyntax
forall a b. (a -> b) -> a -> b
$
    PgSyntax -> PgSyntax
pgParens (PgSyntax -> [PgSyntax] -> PgSyntax
pgSepBy (ByteString -> PgSyntax
emit ByteString
", ") ([PgSyntax] -> PgSyntax) -> [PgSyntax] -> PgSyntax
forall a b. (a -> b) -> a -> b
$
              (PgExpressionSyntax -> PgSyntax)
-> [PgExpressionSyntax] -> [PgSyntax]
forall a b. (a -> b) -> [a] -> [b]
map PgExpressionSyntax -> PgSyntax
fromPgExpression (Proxy Postgres
-> proj
-> WithExprContext [BeamSqlBackendExpressionSyntax Postgres]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy Postgres
forall k (t :: k). Proxy t
Proxy @Postgres)
                                            (table (QExpr Postgres QInternal) -> proj
makeProjection table (QExpr Postgres QInternal)
tbl) Text
"t")) PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> PgSyntax
emit ByteString
" WHERE " PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    PgSyntax -> PgSyntax
pgParens (let QExpr WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
mkE = table (QExpr Postgres QInternal)
-> QGenExpr QValueContext Postgres QInternal Bool
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) PgSyntax -> PgSyntax -> PgSyntax
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> PgSyntax
emit ByteString
" "