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

-- | 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_

  -- ** Inner WITH queries
  , pgSelectWith

  -- ** 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.Backend.SQL
import           Database.Beam.Backend.SQL.BeamExtensions
import qualified Database.Beam.Query.CTE as CTE
import           Database.Beam.Query.Internal
import           Database.Beam.Schema.Tables

import           Database.Beam.Postgres.Types
import           Database.Beam.Postgres.Syntax

import           Control.Monad.Free.Church
import           Control.Monad.State.Strict (evalState)
import           Control.Monad.Writer (runWriterT)

import           Data.Kind (Type)
import           Data.Proxy (Proxy(..))
import qualified Data.Text as T

-- * @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 (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
$c<> :: forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
<> :: PgLockedTables s -> PgLockedTables s -> PgLockedTables s
$csconcat :: forall s. NonEmpty (PgLockedTables s) -> PgLockedTables s
sconcat :: NonEmpty (PgLockedTables s) -> PgLockedTables s
$cstimes :: forall s b. Integral b => b -> PgLockedTables s -> PgLockedTables s
stimes :: forall b. Integral b => b -> 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
$cmempty :: forall s. PgLockedTables s
mempty :: PgLockedTables s
$cmappend :: forall s. PgLockedTables s -> PgLockedTables s -> PgLockedTables s
mappend :: PgLockedTables s -> PgLockedTables s -> PgLockedTables s
$cmconcat :: forall s. [PgLockedTables s] -> PgLockedTables s
mconcat :: [PgLockedTables s] -> 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' :: 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) =
    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 (m :: * -> *).
Monad m =>
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 Proxy context -> Proxy be -> res -> m res
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 =
    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 (m :: * -> *).
Monad m =>
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 Proxy context -> Proxy be -> m res
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_ :: forall a s. 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_ :: forall a s. 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_ :: 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) <- QM Postgres db s (Text, tbl (QGenExpr QValueContext Postgres s))
-> Q Postgres db s (Text, tbl (QGenExpr QValueContext Postgres s))
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QF Postgres db s (Text, tbl (QGenExpr QValueContext Postgres s))
-> QM Postgres db s (Text, tbl (QGenExpr QValueContext Postgres s))
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Text
 -> Text
 -> Sql92SelectTableFromSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
-> (Text -> tbl (QGenExpr QValueContext Postgres s))
-> (tbl (QGenExpr QValueContext Postgres s)
    -> Maybe
         (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)))
-> ((Text, tbl (QGenExpr QValueContext Postgres s))
    -> (Text, tbl (QGenExpr QValueContext Postgres s)))
-> QF Postgres db s (Text, tbl (QGenExpr QValueContext 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
  (Sql92SelectTableFromSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
-> Maybe (Text, Maybe [Text])
-> Sql92SelectTableFromSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (Sql92TableSourceTableNameSyntax
  (Sql92FromTableSourceSyntax
     (Sql92SelectTableFromSyntax
        (Sql92SelectSelectTableSyntax
           (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))))
-> Sql92FromTableSourceSyntax
     (Sql92SelectTableFromSyntax
        (Sql92SelectSelectTableSyntax
           (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
forall tblSource.
IsSql92TableSourceSyntax tblSource =>
Sql92TableSourceTableNameSyntax tblSource -> tblSource
tableNamed (Maybe Text
-> Text
-> Sql92TableSourceTableNameSyntax
     (Sql92FromTableSourceSyntax
        (Sql92SelectTableFromSyntax
           (Sql92SelectSelectTableSyntax
              (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))))
forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName (DatabaseEntityDescriptor Postgres (TableEntity tbl) -> Maybe Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt) (DatabaseEntityDescriptor Postgres (TableEntity tbl) -> Text
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Text
dbTableCurrentName DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))) (Maybe (Text, Maybe [Text])
 -> Sql92SelectTableFromSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
-> (Text -> Maybe (Text, Maybe [Text]))
-> Text
-> Sql92SelectTableFromSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
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 (QGenExpr QValueContext 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 (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor Postgres (TableEntity tbl)
dt))
                                 (\tbl (QGenExpr QValueContext Postgres s)
_ -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
forall a. Maybe a
Nothing) (Text, tbl (QGenExpr QValueContext Postgres s))
-> (Text, tbl (QGenExpr QValueContext Postgres s))
forall a. a -> a
id))
  (PgLockedTables s, tbl (QGenExpr QValueContext Postgres s))
-> Q Postgres
     db
     s
     (PgLockedTables s, tbl (QGenExpr QValueContext Postgres s))
forall a. a -> Q Postgres db s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> PgLockedTables s
forall s. [Text] -> PgLockedTables s
PgLockedTables [Text
nm], tbl (QGenExpr QValueContext 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_ :: 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) =
  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
 -> Sql92SelectSelectTableSyntax
      (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))
 -> [BeamSqlBackendOrderingSyntax Postgres]
 -> Maybe Integer
 -> Maybe Integer
 -> Sql92SelectSyntax (BeamSqlBackendSyntax 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
_) 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))
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'. Proxy s' -> a -> WithRewrittenThread (QNested s) s' a
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall t. Proxy t
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_ :: 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 =
  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 :: forall tbl. 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 :: 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 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_
         (Maybe
  (table (QExpr Postgres PostgresInaccessible)
   -> QExpr Postgres PostgresInaccessible Int)
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 (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 ->
      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 :: 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)
_ = PgInsertReturning (QExprToIdentity 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 =
  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 (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> Maybe Text
dbTableSchema DatabaseEntityDescriptor Postgres (TableEntity table)
tbl) (DatabaseEntityDescriptor Postgres (TableEntity table) -> Text
forall (tbl :: (* -> *) -> *) be.
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 (forall t. Proxy t
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 (tbl :: (* -> *) -> *) be.
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 (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 -> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  PgInsertReturning PgSyntax
syntax -> BeamSqlBackendSyntax be -> m [a]
forall x. FromBackendRow be x => BeamSqlBackendSyntax be -> m [x]
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 :: (Type -> Type) -> Type) =
    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_ :: 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 (Proxy (QNested s) -> a -> WithRewrittenThread s (QNested s) a
forall s'. Proxy s' -> a -> WithRewrittenThread s s' a
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall t. Proxy t
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
-> Text
-> (Sql92SelectTableFromSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
    -> Sql92SelectTableFromSyntax
         (Sql92SelectSelectTableSyntax
            (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
    -> Maybe (BeamSqlBackendExpressionSyntax Postgres)
    -> Sql92SelectTableFromSyntax
         (Sql92SelectSelectTableSyntax
            (Sql92SelectSyntax (BeamSqlBackendSyntax 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
-> 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 (PgSyntax -> PgFromSyntax) -> PgSyntax -> PgFromSyntax
forall a b. (a -> b) -> a -> b
$
                                  PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
  (Sql92SelectSelectTableSyntax
     (Sql92SelectSyntax (BeamSqlBackendSyntax 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 Sql92SelectTableFromSyntax
  (Sql92SelectSelectTableSyntax
     (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
PgFromSyntax
b
                                Just BeamSqlBackendExpressionSyntax Postgres
on'' ->
                                  PgSyntax -> PgFromSyntax
PgFromSyntax (PgSyntax -> PgFromSyntax) -> PgSyntax -> PgFromSyntax
forall a b. (a -> b) -> a -> b
$
                                  PgFromSyntax -> PgSyntax
fromPgFrom Sql92SelectTableFromSyntax
  (Sql92SelectSelectTableSyntax
     (Sql92SelectSyntax (BeamSqlBackendSyntax 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 Sql92SelectTableFromSyntax
  (Sql92SelectSelectTableSyntax
     (Sql92SelectSyntax (BeamSqlBackendSyntax 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))
Maybe (WithExprContext PgExpressionSyntax)
forall a. Maybe a
Nothing)
                           (Proxy s -> b -> WithRewrittenThread (QNested s) s b
forall s'. Proxy s' -> b -> WithRewrittenThread (QNested s) s' b
forall s a s'.
ThreadRewritable s a =>
Proxy s' -> a -> WithRewrittenThread s s' a
rewriteThread (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @s))))

-- | The SQL standard only allows CTE expressions (WITH expressions)
-- at the top-level. Postgres allows you to embed these within a
-- subquery.
--
-- For example,
--
-- @
-- SELECT a.column1, b.column2 FROM (WITH RECURSIVE ... ) a JOIN b
-- @
--
-- @beam-core@ offers 'selectWith' to produce a top-level 'SqlSelect'
-- but these cannot be turned into 'Q' objects for use within joins.
--
-- The 'pgSelectWith' function is more flexible and indeed
-- 'selectWith' for @beam-postgres@ is equivalent to se
pgSelectWith :: forall db s res
              . Projectible Postgres res
             => With Postgres db (Q Postgres db s res) -> Q Postgres db s res
pgSelectWith :: forall (db :: (* -> *) -> *) s res.
Projectible Postgres res =>
With Postgres db (Q Postgres db s res) -> Q Postgres db s res
pgSelectWith (CTE.With WriterT
  (Recursiveness Postgres, [BeamSql99BackendCTESyntax Postgres])
  (State Int)
  (Q Postgres db s res)
mkQ) =
    let (Q Postgres db s res
q, (Recursiveness Postgres
recursiveness, [PgCommonTableExpressionSyntax]
ctes)) = State
  Int
  (Q Postgres db s res,
   (Recursiveness Postgres, [PgCommonTableExpressionSyntax]))
-> Int
-> (Q Postgres db s res,
    (Recursiveness Postgres, [PgCommonTableExpressionSyntax]))
forall s a. State s a -> s -> a
evalState (WriterT
  (Recursiveness Postgres, [PgCommonTableExpressionSyntax])
  (State Int)
  (Q Postgres db s res)
-> State
     Int
     (Q Postgres db s res,
      (Recursiveness Postgres, [PgCommonTableExpressionSyntax]))
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
  (Recursiveness Postgres, [BeamSql99BackendCTESyntax Postgres])
  (State Int)
  (Q Postgres db s res)
WriterT
  (Recursiveness Postgres, [PgCommonTableExpressionSyntax])
  (State Int)
  (Q Postgres db s res)
mkQ) Int
0
        fromSyntax :: Text -> PgSelectSyntax
fromSyntax Text
tblPfx =
            case Recursiveness Postgres
recursiveness of
              Recursiveness Postgres
CTE.Nonrecursive -> [Sql99SelectCTESyntax PgSelectSyntax]
-> PgSelectSyntax -> PgSelectSyntax
forall syntax.
IsSql99CommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withSyntax [Sql99SelectCTESyntax PgSelectSyntax]
[PgCommonTableExpressionSyntax]
ctes (Text
-> Q Postgres db s res
-> Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
Text -> Q be db s a -> BeamSqlBackendSelectSyntax be
forall a (db :: (* -> *) -> *) s.
Projectible Postgres a =>
Text
-> Q Postgres db s a
-> Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)
buildSqlQuery Text
tblPfx Q Postgres db s res
q)
              Recursiveness Postgres
CTE.Recursive -> [Sql99SelectCTESyntax PgSelectSyntax]
-> PgSelectSyntax -> PgSelectSyntax
forall syntax.
IsSql99RecursiveCommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withRecursiveSyntax [Sql99SelectCTESyntax PgSelectSyntax]
[PgCommonTableExpressionSyntax]
ctes (Text
-> Q Postgres db s res
-> Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
Text -> Q be db s a -> BeamSqlBackendSelectSyntax be
forall a (db :: (* -> *) -> *) s.
Projectible Postgres a =>
Text
-> Q Postgres db s a
-> Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)
buildSqlQuery Text
tblPfx Q Postgres db s res
q)
    in QM Postgres db s res -> Q Postgres db s res
forall be (db :: (* -> *) -> *) s a. QM be db s a -> Q be db s a
Q (QF Postgres db s res -> QM Postgres db s res
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF ((Text
 -> Text
 -> Sql92SelectTableFromSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
-> (Text -> res)
-> (res
    -> Maybe
         (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)))
-> ((Text, res) -> res)
-> QF Postgres db s res
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
tblPfx Text
tName ->
                           let (res
_, [Text]
names) = forall be res.
(BeamSqlBackend be, Projectible be res) =>
(Text -> BeamSqlBackendFieldNameSyntax be) -> (res, [Text])
mkFieldNames @Postgres @res (Text -> Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
tName)
                           in Sql92FromTableSourceSyntax
  (Sql92SelectTableFromSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres))))
-> Maybe (Text, Maybe [Text])
-> Sql92SelectTableFromSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax Postgres)))
forall from.
IsSql92FromSyntax from =>
Sql92FromTableSourceSyntax from
-> Maybe (Text, Maybe [Text]) -> from
fromTable (PgSyntax -> PgTableSourceSyntax
PgTableSourceSyntax (PgSyntax -> PgTableSourceSyntax)
-> PgSyntax -> PgTableSourceSyntax
forall a b. (a -> b) -> a -> b
$
                                         [PgSyntax] -> PgSyntax
forall a. Monoid a => [a] -> a
mconcat [ ByteString -> PgSyntax
emit ByteString
"(", PgSelectSyntax -> PgSyntax
fromPgSelect (Text -> PgSelectSyntax
fromSyntax Text
tblPfx), ByteString -> PgSyntax
emit ByteString
")" ])
                                        ((Text, Maybe [Text]) -> Maybe (Text, Maybe [Text])
forall a. a -> Maybe a
Just (Text
tName, [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
names)))
                      (\Text
tName ->
                           let (res
projection, [Text]
_) = forall be res.
(BeamSqlBackend be, Projectible be res) =>
(Text -> BeamSqlBackendFieldNameSyntax be) -> (res, [Text])
mkFieldNames @Postgres @res (Text -> Text -> PgFieldNameSyntax
forall fn. IsSql92FieldNameSyntax fn => Text -> Text -> fn
qualifiedField Text
tName)
                           in res
projection)
                      (\res
_ -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
forall a. Maybe a
Nothing)
                      (Text, res) -> res
forall a b. (a, b) -> b
snd))

-- | By default, Postgres will throw an error when a conflict is detected. This
-- preserves that functionality.
onConflictDefault :: PgInsertOnConflict tbl
onConflictDefault :: forall (tbl :: (* -> *) -> *). 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 :: 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_) =
  (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 Bool
_ Text
_ Text
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 :: forall (tbl :: (* -> *) -> *).
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 :: 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 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 table (QField s) -> QAssignment Postgres s
forall s. table (QField s) -> QAssignment Postgres s
mkAssignments table (QExpr Postgres s) -> QExpr Postgres s Bool
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 (forall t. Proxy t
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 -> WithExprContext PgExpressionSyntax
forall a. a -> Text -> a
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 :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackendSyntax be ~ PgCommandSyntax,
 FromBackendRow be a) =>
PgUpdateReturning a -> m [a]
runPgUpdateReturningList = \case
  PgUpdateReturning a
PgUpdateReturningEmpty -> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  PgUpdateReturning PgSyntax
syntax -> BeamSqlBackendSyntax be -> m [a]
forall x. FromBackendRow be x => BeamSqlBackendSyntax be -> m [x]
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 :: 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 =
  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 (forall t. Proxy t
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.
  (forall s'. table (QExpr Postgres s')) -> QExpr Postgres s Bool)
 -> SqlDelete Postgres table)
-> (forall s.
    (forall s'. table (QExpr Postgres s')) -> QExpr Postgres s Bool)
-> SqlDelete Postgres table
forall a b. (a -> b) -> a -> b
$ \forall s'. table (QExpr Postgres s')
t -> table (QExpr Postgres s) -> QExpr Postgres s Bool
forall s. table (QExpr Postgres s) -> QExpr Postgres s Bool
mkWhere table (QExpr Postgres s)
forall s'. table (QExpr Postgres s')
t
    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 -> WithExprContext PgExpressionSyntax
forall a. a -> Text -> a
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 :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackendSyntax be ~ PgCommandSyntax,
 FromBackendRow be a) =>
PgDeleteReturning a -> m [a]
runPgDeleteReturningList (PgDeleteReturning PgSyntax
syntax) = BeamSqlBackendSyntax be -> m [a]
forall x. FromBackendRow be x => BeamSqlBackendSyntax be -> m [x]
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 :: Type -> Type

  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
_ = PgReturningType SqlInsert (QExprToIdentity a)
PgInsertReturning (QExprToIdentity a)
forall a. PgInsertReturning a
PgInsertReturningEmpty
  returning (SqlInsert TableSettings tbl
tblSettings (PgInsertSyntax PgSyntax
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 (forall t. Proxy t
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' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> (Columnar (TableField tbl) a
    -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendExpressionSyntax Postgres
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall a. a -> Text -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamSqlBackendExpressionSyntax Postgres
 -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> (TableField tbl a -> BeamSqlBackendExpressionSyntax Postgres)
-> TableField tbl a
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendFieldNameSyntax Postgres
-> BeamSqlBackendExpressionSyntax Postgres
PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> BeamSqlBackendExpressionSyntax Postgres
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 (Columnar (TableField tbl) a
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
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
_ = PgReturningType SqlUpdate (QExprToIdentity a)
PgUpdateReturning (QExprToIdentity a)
forall a. PgUpdateReturning a
PgUpdateReturningEmpty
  returning (SqlUpdate TableSettings tbl
tblSettings (PgUpdateSyntax PgSyntax
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 (forall t. Proxy t
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' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> (Columnar (TableField tbl) a
    -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendExpressionSyntax Postgres
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall a. a -> Text -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamSqlBackendExpressionSyntax Postgres
 -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> (TableField tbl a -> BeamSqlBackendExpressionSyntax Postgres)
-> TableField tbl a
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendFieldNameSyntax Postgres
-> BeamSqlBackendExpressionSyntax Postgres
PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> BeamSqlBackendExpressionSyntax Postgres
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 (Columnar (TableField tbl) a
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
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 =
    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 (forall t. Proxy t
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' (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> QGenExpr QValueContext Postgres PostgresInaccessible a
WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall context be s t.
(Text -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> (Columnar (TableField tbl) a
    -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendExpressionSyntax Postgres
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall a. a -> Text -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BeamSqlBackendExpressionSyntax Postgres
 -> WithExprContext (BeamSqlBackendExpressionSyntax Postgres))
-> (TableField tbl a -> BeamSqlBackendExpressionSyntax Postgres)
-> TableField tbl a
-> WithExprContext (BeamSqlBackendExpressionSyntax Postgres)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamSqlBackendFieldNameSyntax Postgres
-> BeamSqlBackendExpressionSyntax Postgres
PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (PgFieldNameSyntax -> BeamSqlBackendExpressionSyntax Postgres)
-> (TableField tbl a -> PgFieldNameSyntax)
-> TableField tbl a
-> BeamSqlBackendExpressionSyntax Postgres
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 (Columnar (TableField tbl) a
 -> Columnar (QExpr Postgres PostgresInaccessible) a)
-> Columnar (TableField tbl) a
-> Columnar (QExpr Postgres PostgresInaccessible) a
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 = 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 :: forall (table :: (* -> *) -> *). 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 :: forall (table :: (* -> *) -> *). 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 (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 =
    (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 Bool
_ Text
_ Text
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 (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_ =
    (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 Bool
_ Text
_ Text
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 :: forall proj (table :: (* -> *) -> *).
Projectible Postgres proj =>
(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 (forall t. Proxy t
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 :: 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 =
    (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 (forall t. Proxy t
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
" "