{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Database.Beam.Query
    ( -- * Query type
      module Database.Beam.Query.Types

    -- ** Query expression contexts
    -- | A context is a type-level value that signifies where an expression can
    --   be used. For example, 'QExpr' corresponds to 'QGenExpr's that result in
    --   values. In reality, 'QExpr' is really 'QGenExpr' parameterized over the
    --   'QValueContext'. Similarly, 'QAgg' represents expressions that contain
    --   aggregates, but it is just 'QGenExpr' parameterized over
    --   'QAggregateContext'
    , QAggregateContext, QGroupingContext, QValueContext
    , QWindowingContext, QWindowFrameContext

    , QGenExprTable, QExprTable

    , QAssignment, QField, QFieldAssignment

    , QBaseScope


    , module Database.Beam.Query.Combinators
    , module Database.Beam.Query.Extensions

    , module Database.Beam.Query.Relationships

    , module Database.Beam.Query.CTE

    , module Database.Beam.Query.Extract

    -- * Operators
    , module Database.Beam.Query.Operator

    -- ** ANSI SQL Booleans
    , isTrue_, isNotTrue_
    , isFalse_, isNotFalse_
    , isUnknown_, isNotUnknown_
    , unknownAs_, sqlBool_
    , possiblyNullBool_
    , fromPossiblyNullBool_

    -- ** Unquantified comparison operators
    , HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)
    , HasTableEquality
    , SqlEq(..), SqlOrd(..), SqlIn(..)
    , HasSqlInTable(..)

    -- ** Quantified Comparison Operators #quantified-comparison-operator#
    , SqlEqQuantified(..), SqlOrdQuantified(..)
    , QQuantified
    , anyOf_, allOf_, anyIn_, allIn_
    , between_

    , module Database.Beam.Query.Aggregate

    , module Database.Beam.Query.CustomSQL

    , module Database.Beam.Query.DataTypes

    -- * SQL Command construction and execution
    -- ** @SELECT@
    , SqlSelect(..)
    , select, selectWith, lookup_
    , runSelectReturningList
    , runSelectReturningOne
    , dumpSqlSelect

    -- ** @INSERT@
    , SqlInsert(..)
    , insert, insertOnly
    , runInsert

    , SqlInsertValues(..)
    , insertExpressions
    , insertValues
    , insertFrom
    , insertData

    -- ** @UPDATE@
    , SqlUpdate(..)
    , update, save
    , update', save'
    , updateTable, updateTable'
    , set, setFieldsTo
    , toNewValue, toOldValue, toUpdatedValue
    , toUpdatedValueMaybe
    , updateRow, updateTableRow
    , updateRow', updateTableRow'
    , runUpdate

    -- ** @DELETE@
    , SqlDelete(..)
    , delete
    , runDelete ) where

import Prelude hiding (lookup)

import Database.Beam.Query.Aggregate
import Database.Beam.Query.Combinators
import Database.Beam.Query.CTE ( With, ReusableQ, selecting, reuse )
import qualified Database.Beam.Query.CTE as CTE
import Database.Beam.Query.CustomSQL
import Database.Beam.Query.DataTypes
import Database.Beam.Query.Extensions
import Database.Beam.Query.Extract
import Database.Beam.Query.Internal
import Database.Beam.Query.Operator
import Database.Beam.Query.Ord
import Database.Beam.Query.Relationships
import Database.Beam.Query.Types (QGenExpr) -- hide QGenExpr constructor
import Database.Beam.Query.Types hiding (QGenExpr)

import Database.Beam.Backend.SQL
import Database.Beam.Backend.SQL.Builder
import Database.Beam.Schema.Tables

import Control.Monad.Identity
import Control.Monad.Writer
import Control.Monad.State.Strict

import Data.Kind (Type)
import Data.Functor.Const (Const(..))
import Data.Text (Text)
import Data.Proxy

import Lens.Micro ((^.))

-- * Query

data QBaseScope

-- | A version of the table where each field is a 'QGenExpr'
type QGenExprTable ctxt be s tbl = tbl (QGenExpr ctxt be s)

type QExprTable be s tbl = QGenExprTable QValueContext be s tbl

-- * SELECT

-- | Represents a select statement in the given backend, returning
-- rows of type 'a'.
newtype SqlSelect be a
    = SqlSelect (BeamSqlBackendSelectSyntax be)

-- | Build a 'SqlSelect' for the given 'Q'.
select :: forall be db res
        . ( BeamSqlBackend be, HasQBuilder be, Projectible be res )
       => Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select :: Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select Q be db QBaseScope res
q =
  BeamSqlBackendSelectSyntax be -> SqlSelect be (QExprToIdentity res)
forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect (TablePrefix
-> Q be db QBaseScope res -> BeamSqlBackendSelectSyntax be
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be
buildSqlQuery TablePrefix
"t" Q be db QBaseScope res
q)

-- | Create a 'SqlSelect' for a query which may have common table
-- expressions. See the documentation of 'With' for more details.
selectWith :: forall be db res
            . ( BeamSqlBackend be, BeamSql99CommonTableExpressionBackend be
              , HasQBuilder be, Projectible be res )
           => With be db (Q be db QBaseScope res) -> SqlSelect be (QExprToIdentity res)
selectWith :: With be db (Q be db QBaseScope res)
-> SqlSelect be (QExprToIdentity res)
selectWith (CTE.With WriterT
  (Recursiveness be, [BeamSql99BackendCTESyntax be])
  (State Int)
  (Q be db QBaseScope res)
mkQ) =
    let (Q be db QBaseScope res
q, (Recursiveness be
recursiveness, [BeamSql99BackendCTESyntax be]
ctes)) = State
  Int
  (Q be db QBaseScope res,
   (Recursiveness be, [BeamSql99BackendCTESyntax be]))
-> Int
-> (Q be db QBaseScope res,
    (Recursiveness be, [BeamSql99BackendCTESyntax be]))
forall s a. State s a -> s -> a
evalState (WriterT
  (Recursiveness be, [BeamSql99BackendCTESyntax be])
  (State Int)
  (Q be db QBaseScope res)
-> State
     Int
     (Q be db QBaseScope res,
      (Recursiveness be, [BeamSql99BackendCTESyntax be]))
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT
  (Recursiveness be, [BeamSql99BackendCTESyntax be])
  (State Int)
  (Q be db QBaseScope res)
mkQ) Int
0
    in case Recursiveness be
recursiveness of
         Recursiveness be
CTE.Nonrecursive -> BeamSqlBackendSelectSyntax be -> SqlSelect be (QExprToIdentity res)
forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect ([BeamSql99BackendCTESyntax be]
-> BeamSqlBackendSelectSyntax be -> BeamSqlBackendSelectSyntax be
forall syntax.
IsSql99CommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withSyntax [BeamSql99BackendCTESyntax be]
ctes
                                                   (TablePrefix
-> Q be db QBaseScope res -> BeamSqlBackendSelectSyntax be
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be
buildSqlQuery TablePrefix
"t" Q be db QBaseScope res
q))
         Recursiveness be
CTE.Recursive    -> BeamSqlBackendSelectSyntax be -> SqlSelect be (QExprToIdentity res)
forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect ([BeamSql99BackendCTESyntax be]
-> BeamSqlBackendSelectSyntax be -> BeamSqlBackendSelectSyntax be
forall syntax.
IsSql99RecursiveCommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withRecursiveSyntax [BeamSql99BackendCTESyntax be]
ctes
                                                            (TablePrefix
-> Q be db QBaseScope res -> BeamSqlBackendSelectSyntax be
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be
buildSqlQuery TablePrefix
"t" Q be db QBaseScope res
q))

-- | Convenience function to generate a 'SqlSelect' that looks up a table row
--   given a primary key.
lookup_ :: ( Database be db, Table table

           , BeamSqlBackend be, HasQBuilder be
           , SqlValableTable be (PrimaryKey table)
           , HasTableEquality be (PrimaryKey table)
           )
        => DatabaseEntity be db (TableEntity table)
        -> PrimaryKey table Identity
        -> SqlSelect be (table Identity)
lookup_ :: DatabaseEntity be db (TableEntity table)
-> PrimaryKey table Identity -> SqlSelect be (table Identity)
lookup_ DatabaseEntity be db (TableEntity table)
tbl PrimaryKey table Identity
tblKey =
  Q be db QBaseScope (table (QExpr be QBaseScope))
-> SqlSelect be (QExprToIdentity (table (QExpr be QBaseScope)))
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select (Q be db QBaseScope (table (QExpr be QBaseScope))
 -> SqlSelect be (QExprToIdentity (table (QExpr be QBaseScope))))
-> Q be db QBaseScope (table (QExpr be QBaseScope))
-> SqlSelect be (QExprToIdentity (table (QExpr be QBaseScope)))
forall a b. (a -> b) -> a -> b
$
  (table (QExpr be QBaseScope) -> QExpr be QBaseScope Bool)
-> Q be db QBaseScope (table (QExpr be QBaseScope))
-> Q be db QBaseScope (table (QExpr be QBaseScope))
forall r be (db :: (* -> *) -> *) s.
BeamSqlBackend be =>
(r -> QExpr be s Bool) -> Q be db s r -> Q be db s r
filter_ (\table (QExpr be QBaseScope)
t -> table (QExpr be QBaseScope)
-> PrimaryKey table (QExpr be QBaseScope)
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table (QExpr be QBaseScope)
t PrimaryKey table (QExpr be QBaseScope)
-> PrimaryKey table (QExpr be QBaseScope)
-> QExpr be QBaseScope Bool
forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. HaskellLiteralForQExpr (PrimaryKey table (QExpr be QBaseScope))
-> PrimaryKey table (QExpr be QBaseScope)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ PrimaryKey table Identity
HaskellLiteralForQExpr (PrimaryKey table (QExpr be QBaseScope))
tblKey) (Q be db QBaseScope (table (QExpr be QBaseScope))
 -> Q be db QBaseScope (table (QExpr be QBaseScope)))
-> Q be db QBaseScope (table (QExpr be QBaseScope))
-> Q be db QBaseScope (table (QExpr be QBaseScope))
forall a b. (a -> b) -> a -> b
$
  DatabaseEntity be db (TableEntity table)
-> Q be db QBaseScope (table (QExpr be QBaseScope))
forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(Database be db, BeamSqlBackend be) =>
DatabaseEntity be db (TableEntity table)
-> Q be db s (table (QExpr be s))
all_ DatabaseEntity be db (TableEntity table)
tbl

-- | Run a 'SqlSelect' in a 'MonadBeam' and get the results as a list
runSelectReturningList ::
  (MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
  SqlSelect be a -> m [ a ]
runSelectReturningList :: SqlSelect be a -> m [a]
runSelectReturningList (SqlSelect BeamSqlBackendSelectSyntax be
s) =
  BeamSqlBackendSyntax be -> m [a]
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (BeamSqlBackendSelectSyntax be -> BeamSqlBackendSyntax be
forall cmd. IsSql92Syntax cmd => Sql92SelectSyntax cmd -> cmd
selectCmd BeamSqlBackendSelectSyntax be
s)

-- | Run a 'SqlSelect' in a 'MonadBeam' and get the unique result, if there is
--   one. Both no results as well as more than one result cause this to return
--   'Nothing'.
runSelectReturningOne ::
  (MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
  SqlSelect be a -> m (Maybe a)
runSelectReturningOne :: SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect BeamSqlBackendSelectSyntax be
s) =
  BeamSqlBackendSyntax be -> m (Maybe a)
forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m (Maybe x)
runReturningOne (BeamSqlBackendSelectSyntax be -> BeamSqlBackendSyntax be
forall cmd. IsSql92Syntax cmd => Sql92SelectSyntax cmd -> cmd
selectCmd BeamSqlBackendSelectSyntax be
s)

-- | Use a special debug syntax to print out an ANSI Standard @SELECT@ statement
--   that may be generated for a given 'Q'.
dumpSqlSelect :: Projectible (MockSqlBackend SqlSyntaxBuilder) res
              => Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res -> IO ()
dumpSqlSelect :: Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res -> IO ()
dumpSqlSelect Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res
q =
    let SqlSelect BeamSqlBackendSelectSyntax (MockSqlBackend SqlSyntaxBuilder)
s = Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res
-> SqlSelect
     (MockSqlBackend SqlSyntaxBuilder) (QExprToIdentity res)
forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res
q
    in String -> IO ()
putStrLn (SqlSyntaxBuilder -> String
renderSql BeamSqlBackendSelectSyntax (MockSqlBackend SqlSyntaxBuilder)
SqlSyntaxBuilder
s)

-- * INSERT

-- | Represents a SQL @INSERT@ command that has not yet been run
data SqlInsert be (table :: (Type -> Type) -> Type)
  = SqlInsert !(TableSettings table) !(BeamSqlBackendInsertSyntax be)
  | SqlInsertNoRows

-- | Generate a 'SqlInsert' over only certain fields of a table
insertOnly :: ( BeamSqlBackend be, ProjectibleWithPredicate AnyType () Text (QExprToField r) )
           => DatabaseEntity be db (TableEntity table)
              -- ^ Table to insert into
           -> (table (QField s) -> QExprToField r)
           -> SqlInsertValues be r
              -- ^ Values to insert. See 'insertValues', 'insertExpressions', 'insertData', and 'insertFrom' for possibilities.
           -> SqlInsert be table
insertOnly :: DatabaseEntity be db (TableEntity table)
-> (table (QField s) -> QExprToField r)
-> SqlInsertValues be r
-> SqlInsert be table
insertOnly DatabaseEntity be db (TableEntity table)
_ table (QField s) -> QExprToField r
_ SqlInsertValues be r
SqlInsertValuesEmpty = SqlInsert be table
forall be (table :: (* -> *) -> *). SqlInsert be table
SqlInsertNoRows
insertOnly (DatabaseEntity dt :: DatabaseEntityDescriptor be (TableEntity table)
dt@(DatabaseTable {})) table (QField s) -> QExprToField r
mkProj (SqlInsertValues BeamSqlBackendInsertValuesSyntax be
vs) =
    TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt) (Sql92InsertTableNameSyntax (BeamSqlBackendInsertSyntax be)
-> [TablePrefix]
-> BeamSqlBackendInsertValuesSyntax be
-> BeamSqlBackendInsertSyntax be
forall insert.
IsSql92InsertSyntax insert =>
Sql92InsertTableNameSyntax insert
-> [TablePrefix] -> Sql92InsertValuesSyntax insert -> insert
insertStmt (DatabaseEntityDescriptor be (TableEntity table)
-> Sql92InsertTableNameSyntax (BeamSqlBackendInsertSyntax be)
forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt) [TablePrefix]
proj BeamSqlBackendInsertValuesSyntax be
vs)
  where
    tblFields :: table (QField s)
tblFields = (forall a.
 Columnar' (TableField table) a -> Columnar' (QField s) a)
-> TableSettings table -> table (QField s)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
fd) -> Columnar (QField s) a -> Columnar' (QField s) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Bool -> TablePrefix -> TablePrefix -> QField s a
forall s ty. Bool -> TablePrefix -> TablePrefix -> QField s ty
QField Bool
False (DatabaseEntityDescriptor be (TableEntity table) -> TablePrefix
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TablePrefix
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt) (TableField table a
Columnar (TableField table) a
fd TableField table a
-> Getting TablePrefix (TableField table a) TablePrefix
-> TablePrefix
forall s a. s -> Getting a s a -> a
^. Getting TablePrefix (TableField table a) TablePrefix
forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName)))
                              (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
    proj :: [TablePrefix]
proj = Writer [TablePrefix] (QExprToField r) -> [TablePrefix]
forall w a. Writer w a -> w
execWriter (Proxy AnyType
-> Proxy ((), TablePrefix)
-> (forall context.
    AnyType context =>
    Proxy context
    -> Proxy ()
    -> TablePrefix
    -> WriterT [TablePrefix] Identity TablePrefix)
-> QExprToField r
-> Writer [TablePrefix] (QExprToField r)
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 AnyType
forall k (t :: k). Proxy t
Proxy @AnyType) (Proxy ((), TablePrefix)
forall k (t :: k). Proxy t
Proxy @((), Text))
                                (\Proxy context
_ Proxy ()
_ TablePrefix
f -> [TablePrefix] -> WriterT [TablePrefix] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TablePrefix
f] WriterT [TablePrefix] Identity ()
-> WriterT [TablePrefix] Identity TablePrefix
-> WriterT [TablePrefix] Identity TablePrefix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TablePrefix -> WriterT [TablePrefix] Identity TablePrefix
forall (f :: * -> *) a. Applicative f => a -> f a
pure TablePrefix
f)
                                (table (QField s) -> QExprToField r
mkProj table (QField s)
tblFields))

-- | Generate a 'SqlInsert' given a table and a source of values.
insert :: ( BeamSqlBackend be, ProjectibleWithPredicate AnyType () Text (table (QField s)) )
       => DatabaseEntity be db (TableEntity table)
          -- ^ Table to insert into
       -> SqlInsertValues be (table (QExpr be s))
          -- ^ Values to insert. See 'insertValues', 'insertExpressions', and 'insertFrom' for possibilities.
       -> SqlInsert be table
insert :: DatabaseEntity be db (TableEntity table)
-> SqlInsertValues be (table (QExpr be s)) -> SqlInsert be table
insert DatabaseEntity be db (TableEntity table)
tbl SqlInsertValues be (table (QExpr be s))
values = DatabaseEntity be db (TableEntity table)
-> (table (QField s) -> QExprToField (table (QExpr be s)))
-> SqlInsertValues be (table (QExpr be s))
-> SqlInsert be table
forall be r (db :: (* -> *) -> *) (table :: (* -> *) -> *) s.
(BeamSqlBackend be,
 ProjectibleWithPredicate
   AnyType () TablePrefix (QExprToField r)) =>
DatabaseEntity be db (TableEntity table)
-> (table (QField s) -> QExprToField r)
-> SqlInsertValues be r
-> SqlInsert be table
insertOnly DatabaseEntity be db (TableEntity table)
tbl table (QField s) -> QExprToField (table (QExpr be s))
forall a. a -> a
id SqlInsertValues be (table (QExpr be s))
values

-- | Run a 'SqlInsert' in a 'MonadBeam'
runInsert :: (BeamSqlBackend be, MonadBeam be m)
          => SqlInsert be table -> m ()
runInsert :: SqlInsert be table -> m ()
runInsert SqlInsert be table
SqlInsertNoRows = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runInsert (SqlInsert TableSettings table
_ BeamSqlBackendInsertSyntax be
i) = BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (BeamSqlBackendInsertSyntax be -> BeamSqlBackendSyntax be
forall cmd. IsSql92Syntax cmd => Sql92InsertSyntax cmd -> cmd
insertCmd BeamSqlBackendInsertSyntax be
i)

-- | Represents a source of values that can be inserted into a table shaped like
--   'tbl'.
data SqlInsertValues be proj
    = SqlInsertValues (BeamSqlBackendInsertValuesSyntax be)
    | SqlInsertValuesEmpty

-- | Build a 'SqlInsertValues' from series of expressions in tables
insertExpressions :: forall be table s
                   . ( BeamSqlBackend be, Beamable table )
                  => (forall s'. [ table (QExpr be s') ])
                  -> SqlInsertValues be (table (QExpr be s))
insertExpressions :: (forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
insertExpressions forall s'. [table (QExpr be s')]
tbls =
  case [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
sqlExprs of
    [] -> SqlInsertValues be (table (QExpr be s))
forall be proj. SqlInsertValues be proj
SqlInsertValuesEmpty
    [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
_  -> BeamSqlBackendInsertValuesSyntax be
-> SqlInsertValues be (table (QExpr be s))
forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues ([[Sql92InsertValuesExpressionSyntax
    (BeamSqlBackendInsertValuesSyntax be)]]
-> BeamSqlBackendInsertValuesSyntax be
forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
[[Sql92InsertValuesExpressionSyntax insertValues]] -> insertValues
insertSqlExpressions [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
[[Sql92InsertValuesExpressionSyntax
    (BeamSqlBackendInsertValuesSyntax be)]]
sqlExprs)
    where
      sqlExprs :: [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
sqlExprs = (table (QExpr be Any)
 -> [Sql92UpdateExpressionSyntax
       (Sql92UpdateSyntax (BeamSqlBackendSyntax be))])
-> [table (QExpr be Any)]
-> [[Sql92UpdateExpressionSyntax
       (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
forall a b. (a -> b) -> [a] -> [b]
map table (QExpr be Any)
-> [Sql92UpdateExpressionSyntax
      (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]
forall s'.
table (QExpr be s') -> [BeamSqlBackendExpressionSyntax be]
mkSqlExprs [table (QExpr be Any)]
forall s'. [table (QExpr be s')]
tbls

      mkSqlExprs :: forall s'. table (QExpr be s') -> [ BeamSqlBackendExpressionSyntax be ]
      mkSqlExprs :: table (QExpr be s') -> [BeamSqlBackendExpressionSyntax be]
mkSqlExprs = (forall a.
 Columnar' (QExpr be s') a
 -> Sql92UpdateExpressionSyntax
      (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> table (QExpr be s')
-> [Sql92UpdateExpressionSyntax
      (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]
forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (QExpr x)) -> TablePrefix -> BeamSqlBackendExpressionSyntax be
x TablePrefix
"t")

-- | Build a 'SqlInsertValues' from concrete table values
insertValues :: forall be table s
              . ( BeamSqlBackend be, Beamable table
                , FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table )
             => [ table Identity ]
             -> SqlInsertValues be (table (QExpr be s))
insertValues :: [table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [table Identity]
x = (forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table) =>
(forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
insertExpressions ((table Identity -> table (QExpr be s'))
-> [table Identity] -> [table (QExpr be s')]
forall a b. (a -> b) -> [a] -> [b]
map table Identity -> table (QExpr be s')
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ [table Identity]
x :: forall s'. [table (QExpr be s') ])

-- | Build a 'SqlInsertValues' from arbitrarily shaped data containing expressions
insertData :: forall be r
            . ( Projectible be r, BeamSqlBackend be )
           => [ r ] -> SqlInsertValues be r
insertData :: [r] -> SqlInsertValues be r
insertData [r]
rows =
  case [r]
rows of
    [] -> SqlInsertValues be r
forall be proj. SqlInsertValues be proj
SqlInsertValuesEmpty
    [r]
_  -> BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be r
forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues ([[Sql92InsertValuesExpressionSyntax
    (BeamSqlBackendInsertValuesSyntax be)]]
-> BeamSqlBackendInsertValuesSyntax be
forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
[[Sql92InsertValuesExpressionSyntax insertValues]] -> insertValues
insertSqlExpressions ((r
 -> [Sql92UpdateExpressionSyntax
       (Sql92UpdateSyntax (BeamSqlBackendSyntax be))])
-> [r]
-> [[Sql92UpdateExpressionSyntax
       (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
forall a b. (a -> b) -> [a] -> [b]
map (\r
row -> Proxy be
-> r -> WithExprContext [BeamSqlBackendExpressionSyntax be]
forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (Proxy be
forall k (t :: k). Proxy t
Proxy @be) r
row TablePrefix
"t") [r]
rows))

-- | Build a 'SqlInsertValues' from a 'SqlSelect' that returns the same table
insertFrom :: ( BeamSqlBackend be, HasQBuilder be
              , Projectible be r )
           => Q be db QBaseScope r
           -> SqlInsertValues be r
insertFrom :: Q be db QBaseScope r -> SqlInsertValues be r
insertFrom Q be db QBaseScope r
s = BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be r
forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (Sql92InsertValuesSelectSyntax (BeamSqlBackendInsertValuesSyntax be)
-> BeamSqlBackendInsertValuesSyntax be
forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
Sql92InsertValuesSelectSyntax insertValues -> insertValues
insertFromSql (TablePrefix
-> Q be db QBaseScope r -> BeamSqlBackendSelectSyntax be
forall be a (db :: (* -> *) -> *) s.
(HasQBuilder be, Projectible be a) =>
TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be
buildSqlQuery TablePrefix
"t" Q be db QBaseScope r
s))

-- * UPDATE

-- | Represents a SQL @UPDATE@ statement for the given @table@.
data SqlUpdate be (table :: (Type -> Type) -> Type)
  = SqlUpdate !(TableSettings table) !(BeamSqlBackendUpdateSyntax be)
  | SqlIdentityUpdate -- An update with no assignments

-- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to
--   build a @WHERE@ clause.
--
--   An internal implementation for 'update' and 'update'' functions.
--   Allows to choose boolean type in the @WHERE@ clause.
updateImpl :: forall bool table db be
            . ( BeamSqlBackend be, Beamable table )
           => DatabaseEntity be db (TableEntity table)
              -- ^ The table to insert into
           -> (forall s. table (QField s) -> QAssignment be s)
              -- ^ A sequence of assignments to make.
           -> (forall s. table (QExpr be s) -> QExpr be s bool)
              -- ^ Build a @WHERE@ clause given a table containing expressions
           -> SqlUpdate be table
updateImpl :: 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
updateImpl (DatabaseEntity dt :: DatabaseEntityDescriptor be (TableEntity table)
dt@(DatabaseTable {})) forall s. table (QField s) -> QAssignment be s
mkAssignments forall s. table (QExpr be s) -> QExpr be s bool
mkWhere =
  case [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
assignments of
    [] -> SqlUpdate be table
forall be (table :: (* -> *) -> *). SqlUpdate be table
SqlIdentityUpdate
    [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
_  -> TableSettings table
-> BeamSqlBackendUpdateSyntax be -> SqlUpdate be table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendUpdateSyntax be -> SqlUpdate be table
SqlUpdate (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
                    (Sql92UpdateTableNameSyntax (BeamSqlBackendUpdateSyntax be)
-> [(Sql92UpdateFieldNameSyntax (BeamSqlBackendUpdateSyntax be),
     Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be))]
-> Maybe
     (Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be))
-> BeamSqlBackendUpdateSyntax be
forall update.
IsSql92UpdateSyntax update =>
Sql92UpdateTableNameSyntax update
-> [(Sql92UpdateFieldNameSyntax update,
     Sql92UpdateExpressionSyntax update)]
-> Maybe (Sql92UpdateExpressionSyntax update)
-> update
updateStmt (DatabaseEntityDescriptor be (TableEntity table)
-> Sql92UpdateTableNameSyntax (BeamSqlBackendUpdateSyntax be)
forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt)
                       [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
[(Sql92UpdateFieldNameSyntax (BeamSqlBackendUpdateSyntax be),
  Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be))]
assignments (Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be)
-> Maybe
     (Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be))
forall a. a -> Maybe a
Just (TablePrefix -> BeamSqlBackendExpressionSyntax be
where_ TablePrefix
"t")))
  where
    QAssignment [(BeamSqlBackendFieldNameSyntax be,
  BeamSqlBackendExpressionSyntax be)]
assignments = table (QField Any) -> QAssignment be Any
forall s. table (QField s) -> QAssignment be s
mkAssignments table (QField Any)
tblFields
    QExpr TablePrefix -> BeamSqlBackendExpressionSyntax be
where_ = table (QExpr be Any) -> QGenExpr QValueContext be Any bool
forall s. table (QExpr be s) -> QExpr be s bool
mkWhere table (QExpr be Any)
tblFieldExprs

    tblFields :: table (QField Any)
tblFields = (forall a.
 Columnar' (TableField table) a -> Columnar' (QField Any) a)
-> TableSettings table -> table (QField Any)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
fd) -> Columnar (QField Any) a -> Columnar' (QField Any) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Bool -> TablePrefix -> TablePrefix -> QField Any a
forall s ty. Bool -> TablePrefix -> TablePrefix -> QField s ty
QField Bool
False (DatabaseEntityDescriptor be (TableEntity table) -> TablePrefix
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TablePrefix
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt) (TableField table a
Columnar (TableField table) a
fd TableField table a
-> Getting TablePrefix (TableField table a) TablePrefix
-> TablePrefix
forall s a. s -> Getting a s a -> a
^. Getting TablePrefix (TableField table a) TablePrefix
forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName)))
                              (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
    tblFieldExprs :: table (QExpr be Any)
tblFieldExprs = (forall a. Columnar' (QField Any) a -> Columnar' (QExpr be Any) a)
-> table (QField Any) -> table (QExpr be Any)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar (QExpr be Any) a -> Columnar' (QExpr be Any) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr QValueContext be Any a
forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be)
-> TablePrefix
-> Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sql92ExpressionFieldNameSyntax
  (Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be))
-> Sql92UpdateExpressionSyntax (BeamSqlBackendUpdateSyntax be)
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
forall fn. IsSql92FieldNameSyntax fn => TablePrefix -> fn
unqualifiedField TablePrefix
nm))))) table (QField Any)
tblFields

-- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to
--   build a @WHERE@ clause.
--
--   Use 'update'' for comparisons with 'SqlBool'.
--
--   See the '(<-.)' operator for ways to build assignments. The argument to the
--   second argument is a the table parameterized over 'QField', which
--   represents the left hand side of assignments. Sometimes, you'd like to also
--   get the current value of a particular column. You can use the 'current_'
--   function to convert a 'QField' to a 'QExpr'.
update :: ( BeamSqlBackend be, Beamable table )
       => DatabaseEntity be db (TableEntity table)
          -- ^ The table to insert into
       -> (forall s. table (QField s) -> QAssignment be s)
          -- ^ A sequence of assignments to make.
       -> (forall s. table (QExpr be s) -> QExpr be s Bool)
          -- ^ Build a @WHERE@ clause given a table containing expressions
       -> SqlUpdate be table
update :: 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 = forall bool (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(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
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(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
updateImpl @Bool

-- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to
--   build a @WHERE@ clause.
--
--   Uses a 'SqlBool' comparison. Use 'update' for comparisons with 'Bool'.
--
--   See the '(<-.)' operator for ways to build assignments. The argument to the
--   second argument is a the table parameterized over 'QField', which
--   represents the left hand side of assignments. Sometimes, you'd like to also
--   get the current value of a particular column. You can use the 'current_'
--   function to convert a 'QField' to a 'QExpr'.
update' :: ( BeamSqlBackend be, Beamable table )
        => DatabaseEntity be db (TableEntity table)
           -- ^ The table to insert into
        -> (forall s. table (QField s) -> QAssignment be s)
           -- ^ A sequence of assignments to make.
        -> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
           -- ^ Build a @WHERE@ clause given a table containing expressions
        -> SqlUpdate be table
update' :: DatabaseEntity be db (TableEntity table)
-> (forall s. table (QField s) -> QAssignment be s)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be table
update' = forall bool (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(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
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(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 SqlBool)
-> SqlUpdate be table
updateImpl @SqlBool

-- | A specialization of 'update' that matches the given (already existing) row.
--
--   Use 'updateRow'' for an internal 'SqlBool' comparison.
updateRow :: ( BeamSqlBackend be, Table table
             , HasTableEquality be (PrimaryKey table)
             , SqlValableTable be (PrimaryKey table) )
          => DatabaseEntity be db (TableEntity table)
             -- ^ The table to insert into
          -> table Identity
             -- ^ The row to update
          -> (forall s. table (QField s) -> QAssignment be s)
             -- ^ A sequence of assignments to make.
          -> SqlUpdate be table
updateRow :: DatabaseEntity be db (TableEntity table)
-> table Identity
-> (forall s. table (QField s) -> QAssignment be s)
-> SqlUpdate be table
updateRow DatabaseEntity be db (TableEntity table)
tbl table Identity
row forall s. table (QField s) -> QAssignment be s
assignments =
  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
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 be db (TableEntity table)
tbl forall s. table (QField s) -> QAssignment be s
assignments (PrimaryKey table (QGenExpr QValueContext be s)
-> table (QGenExpr QValueContext be s)
-> QGenExpr QValueContext be s Bool
forall (t :: (* -> *) -> *) be ctxt s.
(Table t, BeamSqlBackend be, HasTableEquality be (PrimaryKey t)) =>
PrimaryKey t (QGenExpr ctxt be s)
-> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s Bool
references_ (HaskellLiteralForQExpr
  (PrimaryKey table (QGenExpr QValueContext be s))
-> PrimaryKey table (QGenExpr QValueContext be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (table Identity -> PrimaryKey table Identity
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table Identity
row)))

-- | A specialization of 'update'' that matches the given (already existing) row.
--
--   Use 'updateRow' for an internal 'Bool' comparison.
updateRow' :: ( BeamSqlBackend be, Table table
              , HasTableEquality be (PrimaryKey table)
              , SqlValableTable be (PrimaryKey table) )
           => DatabaseEntity be db (TableEntity table)
              -- ^ The table to insert into
           -> table Identity
              -- ^ The row to update
           -> (forall s. table (QField s) -> QAssignment be s)
              -- ^ A sequence of assignments to make.
           -> SqlUpdate be table
updateRow' :: DatabaseEntity be db (TableEntity table)
-> table Identity
-> (forall s. table (QField s) -> QAssignment be s)
-> SqlUpdate be table
updateRow' DatabaseEntity be db (TableEntity table)
tbl table Identity
row forall s. table (QField s) -> QAssignment be s
assignments =
  DatabaseEntity be db (TableEntity table)
-> (forall s. table (QField s) -> QAssignment be s)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be 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 SqlBool)
-> SqlUpdate be table
update' DatabaseEntity be db (TableEntity table)
tbl forall s. table (QField s) -> QAssignment be s
assignments (PrimaryKey table (QGenExpr QValueContext be s)
-> table (QGenExpr QValueContext be s)
-> QGenExpr QValueContext be s SqlBool
forall (t :: (* -> *) -> *) be ctxt s.
(Table t, BeamSqlBackend be, HasTableEquality be (PrimaryKey t)) =>
PrimaryKey t (QGenExpr ctxt be s)
-> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s SqlBool
references_' (HaskellLiteralForQExpr
  (PrimaryKey table (QGenExpr QValueContext be s))
-> PrimaryKey table (QGenExpr QValueContext be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (table Identity -> PrimaryKey table Identity
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table Identity
row)))

-- | A specialization of 'update' that is more convenient for normal tables.
--
--   An internal implementation of 'updateTable' and 'updateTable'' functions.
--   Allows choosing between 'Bool' and 'SqlBool'.
updateTableImpl :: forall bool table db be
                 . ( BeamSqlBackend be, Beamable table )
                => DatabaseEntity be db (TableEntity table)
                   -- ^ The table to update
                -> table (QFieldAssignment be table)
                   -- ^ Updates to be made (use 'set' to construct an empty field)
                -> (forall s. table (QExpr be s) -> QExpr be s bool)
                -> SqlUpdate be table
updateTableImpl :: DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s bool)
-> SqlUpdate be table
updateTableImpl DatabaseEntity be db (TableEntity table)
tblEntity table (QFieldAssignment be table)
assignments forall s. table (QExpr be s) -> QExpr be s bool
mkWhere =
  let mkAssignments :: forall s. table (QField s) -> QAssignment be s
      mkAssignments :: table (QField s) -> QAssignment be s
mkAssignments table (QField s)
tblFields =
        let tblExprs :: table (QExpr be s)
tblExprs = (forall a. Columnar' (QField s) a -> Columnar' (QExpr be s) a)
-> table (QField s) -> table (QExpr be s)
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (QField s) a
fd) -> Columnar (QExpr be s) a -> Columnar' (QExpr be s) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (QField s a -> QExpr be s a
forall be s ty. BeamSqlBackend be => QField s ty -> QExpr be s ty
current_ Columnar (QField s) a
QField s a
fd)) table (QField s)
tblFields
        in Writer (QAssignment be s) (table (QFieldAssignment be table))
-> QAssignment be s
forall w a. Writer w a -> w
execWriter (Writer (QAssignment be s) (table (QFieldAssignment be table))
 -> QAssignment be s)
-> Writer (QAssignment be s) (table (QFieldAssignment be table))
-> QAssignment be s
forall a b. (a -> b) -> a -> b
$
           (forall a.
 Columnar' (QField s) a
 -> Columnar' (QFieldAssignment be table) a
 -> WriterT
      (QAssignment be s)
      Identity
      (Columnar' (QFieldAssignment be table) a))
-> table (QField s)
-> table (QFieldAssignment be table)
-> Writer (QAssignment be s) (table (QFieldAssignment be table))
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM
             (\(Columnar' field :: Columnar' (QField s) a)
               c :: Columnar' (QFieldAssignment be table) a
c@(Columnar' (QFieldAssignment mkAssignment)) ->
                case table (QExpr be s) -> Maybe (QExpr be s a)
forall s. table (QExpr be s) -> Maybe (QExpr be s a)
mkAssignment table (QExpr be s)
tblExprs of
                  Maybe (QExpr be s a)
Nothing -> Columnar' (QFieldAssignment be table) a
-> WriterT
     (QAssignment be s)
     Identity
     (Columnar' (QFieldAssignment be table) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columnar' (QFieldAssignment be table) a
c
                  Just QExpr be s a
newValue -> do
                    QAssignment be s -> WriterT (QAssignment be s) Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Columnar (QField s) a
QField s a
field QField s a -> QExpr be s a -> QAssignment be s
forall be s lhs rhs.
SqlUpdatable be s lhs rhs =>
lhs -> rhs -> QAssignment be s
<-. QExpr be s a
newValue)
                    Columnar' (QFieldAssignment be table) a
-> WriterT
     (QAssignment be s)
     Identity
     (Columnar' (QFieldAssignment be table) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columnar' (QFieldAssignment be table) a
c)
             table (QField s)
tblFields table (QFieldAssignment be table)
assignments

  in 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
forall bool (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(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
updateImpl DatabaseEntity be db (TableEntity table)
tblEntity forall s. table (QField s) -> QAssignment be s
mkAssignments forall s. table (QExpr be s) -> QExpr be s bool
mkWhere

-- | A specialization of 'update' that is more convenient for normal tables.
--
--   Use 'updateTable'' for comparisons with 'SqlBool'.
updateTable :: forall table db be
             . ( BeamSqlBackend be, Beamable table )
            => DatabaseEntity be db (TableEntity table)
               -- ^ The table to update
            -> table (QFieldAssignment be table)
               -- ^ Updates to be made (use 'set' to construct an empty field)
            -> (forall s. table (QExpr be s) -> QExpr be s Bool)
            -> SqlUpdate be table
updateTable :: DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
updateTable = forall bool (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s bool)
-> SqlUpdate be table
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
updateTableImpl @Bool

-- | A specialization of 'update'' that is more convenient for normal tables.
--
--   Use 'updateTable' for comparisons with 'Bool'.
updateTable' :: forall table db be
              . ( BeamSqlBackend be, Beamable table )
             => DatabaseEntity be db (TableEntity table)
                -- ^ The table to update
             -> table (QFieldAssignment be table)
                -- ^ Updates to be made (use 'set' to construct an empty field)
             -> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
             -> SqlUpdate be table
updateTable' :: DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be table
updateTable' = forall bool (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s bool)
-> SqlUpdate be table
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be table
updateTableImpl @SqlBool

-- | Convenience form of 'updateTable' that generates a @WHERE@ clause
-- that matches only the already existing entity.
--
-- Use 'updateTableRow'' for an internal 'SqlBool' comparison.
updateTableRow :: ( BeamSqlBackend be, Table table
                  , HasTableEquality be (PrimaryKey table)
                  , SqlValableTable be (PrimaryKey table) )
               => DatabaseEntity be db (TableEntity table)
                  -- ^ The table to update
               -> table Identity
                  -- ^ The row to update
               -> table (QFieldAssignment be table)
                  -- ^ Updates to be made (use 'set' to construct an empty field)
               -> SqlUpdate be table
updateTableRow :: DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
updateTableRow DatabaseEntity be db (TableEntity table)
tbl table Identity
row table (QFieldAssignment be table)
assignments =
  DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s Bool)
-> SqlUpdate be table
updateTable DatabaseEntity be db (TableEntity table)
tbl table (QFieldAssignment be table)
assignments (PrimaryKey table (QGenExpr QValueContext be s)
-> table (QGenExpr QValueContext be s)
-> QGenExpr QValueContext be s Bool
forall (t :: (* -> *) -> *) be ctxt s.
(Table t, BeamSqlBackend be, HasTableEquality be (PrimaryKey t)) =>
PrimaryKey t (QGenExpr ctxt be s)
-> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s Bool
references_ (HaskellLiteralForQExpr
  (PrimaryKey table (QGenExpr QValueContext be s))
-> PrimaryKey table (QGenExpr QValueContext be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (table Identity -> PrimaryKey table Identity
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table Identity
row)))

-- | Convenience form of 'updateTable'' that generates a @WHERE@ clause
-- that matches only the already existing entity.
--
-- Uses 'update'' with a 'SqlBool' comparison.
-- Use 'updateTableRow' for an internal 'Bool' comparison.
updateTableRow' :: ( BeamSqlBackend be, Table table
                   , HasTableEquality be (PrimaryKey table)
                   , SqlValableTable be (PrimaryKey table) )
                => DatabaseEntity be db (TableEntity table)
                   -- ^ The table to update
                -> table Identity
                   -- ^ The row to update
                -> table (QFieldAssignment be table)
                   -- ^ Updates to be made (use 'set' to construct an empty field)
                -> SqlUpdate be table
updateTableRow' :: DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
updateTableRow' DatabaseEntity be db (TableEntity table)
tbl table Identity
row table (QFieldAssignment be table)
assignments =
  DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be table
forall (table :: (* -> *) -> *) (db :: (* -> *) -> *) be.
(BeamSqlBackend be, Beamable table) =>
DatabaseEntity be db (TableEntity table)
-> table (QFieldAssignment be table)
-> (forall s. table (QExpr be s) -> QExpr be s SqlBool)
-> SqlUpdate be table
updateTable' DatabaseEntity be db (TableEntity table)
tbl table (QFieldAssignment be table)
assignments (PrimaryKey table (QGenExpr QValueContext be s)
-> table (QGenExpr QValueContext be s)
-> QGenExpr QValueContext be s SqlBool
forall (t :: (* -> *) -> *) be ctxt s.
(Table t, BeamSqlBackend be, HasTableEquality be (PrimaryKey t)) =>
PrimaryKey t (QGenExpr ctxt be s)
-> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s SqlBool
references_' (HaskellLiteralForQExpr
  (PrimaryKey table (QGenExpr QValueContext be s))
-> PrimaryKey table (QGenExpr QValueContext be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (table Identity -> PrimaryKey table Identity
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table Identity
row)))

set :: forall table be table'. Beamable table => table (QFieldAssignment be table')
set :: table (QFieldAssignment be table')
set = (forall a.
 Columnar' Ignored a -> Columnar' (QFieldAssignment be table') a)
-> table Ignored -> table (QFieldAssignment be table')
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\Columnar' Ignored a
_ -> Columnar (QFieldAssignment be table') a
-> Columnar' (QFieldAssignment be table') a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((forall s. table' (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table' a
forall be (tbl :: (* -> *) -> *) a.
(forall s. tbl (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be tbl a
QFieldAssignment (\table' (QExpr be s)
_ -> Maybe (QExpr be s a)
forall a. Maybe a
Nothing))) (table Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table)

setFieldsTo :: forall table be table'
             . Table table => (forall s. table (QExpr be s)) -> table (QFieldAssignment be table')
setFieldsTo :: (forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo forall s. table (QExpr be s)
tbl =

  Identity (table (QFieldAssignment be table'))
-> table (QFieldAssignment be table')
forall a. Identity a -> a
runIdentity (Identity (table (QFieldAssignment be table'))
 -> table (QFieldAssignment be table'))
-> Identity (table (QFieldAssignment be table'))
-> table (QFieldAssignment be table')
forall a b. (a -> b) -> a -> b
$
  (forall a.
 Columnar' (Const Int) a
 -> Columnar' (QExpr be Any) a
 -> Identity (Columnar' (QFieldAssignment be table') a))
-> table (Const Int)
-> table (QExpr be Any)
-> Identity (table (QFieldAssignment be table'))
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' (Const columnIx))
                   (Columnar' (QExpr newValue)) ->
                    if Int
columnIx Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
primaryKeyIndices
                    then Columnar' (QFieldAssignment be table') a
-> Identity (Columnar' (QFieldAssignment be table') a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar' (QFieldAssignment be table') a
 -> Identity (Columnar' (QFieldAssignment be table') a))
-> Columnar' (QFieldAssignment be table') a
-> Identity (Columnar' (QFieldAssignment be table') a)
forall a b. (a -> b) -> a -> b
$ Columnar (QFieldAssignment be table') a
-> Columnar' (QFieldAssignment be table') a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' Columnar (QFieldAssignment be table') a
forall be (table :: (* -> *) -> *) a. QFieldAssignment be table a
toOldValue
                    else Columnar' (QFieldAssignment be table') a
-> Identity (Columnar' (QFieldAssignment be table') a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar' (QFieldAssignment be table') a
 -> Identity (Columnar' (QFieldAssignment be table') a))
-> Columnar' (QFieldAssignment be table') a
-> Identity (Columnar' (QFieldAssignment be table') a)
forall a b. (a -> b) -> a -> b
$ Columnar (QFieldAssignment be table') a
-> Columnar' (QFieldAssignment be table') a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((forall s. QExpr be s a) -> QFieldAssignment be table' a
forall be a (table :: (* -> *) -> *).
(forall s. QExpr be s a) -> QFieldAssignment be table a
toNewValue ((TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr QValueContext be s a
forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr TablePrefix -> BeamSqlBackendExpressionSyntax be
newValue)))
                 table (Const Int)
indexedTable table (QExpr be Any)
forall s. table (QExpr be s)
tbl

  where
    indexedTable :: table (Const Int)
    indexedTable :: table (Const Int)
indexedTable =
      (State Int (table (Const Int)) -> Int -> table (Const Int))
-> Int -> State Int (table (Const Int)) -> table (Const Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (table (Const Int)) -> Int -> table (Const Int)
forall s a. State s a -> s -> a
evalState Int
0 (State Int (table (Const Int)) -> table (Const Int))
-> State Int (table (Const Int)) -> table (Const Int)
forall a b. (a -> b) -> a -> b
$
      (forall a.
 Columnar' Ignored a
 -> Columnar' Ignored a
 -> StateT Int Identity (Columnar' (Const Int) a))
-> table Ignored -> table Ignored -> State Int (table (Const Int))
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
       (g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\Columnar' Ignored a
_ Columnar' Ignored a
_ -> do
                         Int
n <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
get
                         Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                         Columnar' (Const Int) a
-> StateT Int Identity (Columnar' (Const Int) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Columnar (Const Int) a -> Columnar' (Const Int) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (Int -> Const Int a
forall k a (b :: k). a -> Const a b
Const Int
n)))
        (table Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table) (table Ignored
forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table)

    primaryKeyIndices :: [ Int ]
    primaryKeyIndices :: [Int]
primaryKeyIndices = (forall a. Columnar' (Const Int) a -> Int)
-> PrimaryKey table (Const Int) -> [Int]
forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (Const ix)) -> Int
ix) (table (Const Int) -> PrimaryKey table (Const Int)
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey table (Const Int)
indexedTable)

-- | Use with 'set' to set a field to an explicit new value that does
-- not depend on any other value
toNewValue :: (forall s. QExpr be s a) -> QFieldAssignment be table a
toNewValue :: (forall s. QExpr be s a) -> QFieldAssignment be table a
toNewValue forall s. QExpr be s a
newVal = (forall s. table (QExpr be s) -> QExpr be s a)
-> QFieldAssignment be table a
forall (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> QExpr be s a)
-> QFieldAssignment be table a
toUpdatedValue (\table (QExpr be s)
_ -> QExpr be s a
forall s. QExpr be s a
newVal)

-- | Use with 'set' to not modify the field
toOldValue :: QFieldAssignment be table a
toOldValue :: QFieldAssignment be table a
toOldValue = (forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
forall (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe (\table (QExpr be s)
_ -> Maybe (QExpr be s a)
forall a. Maybe a
Nothing)

-- | Use with 'set' to set a field to a new value that is calculated
-- based on one or more fields from the existing row
toUpdatedValue :: (forall s. table (QExpr be s) -> QExpr be s a) -> QFieldAssignment be table a
toUpdatedValue :: (forall s. table (QExpr be s) -> QExpr be s a)
-> QFieldAssignment be table a
toUpdatedValue forall s. table (QExpr be s) -> QExpr be s a
mkNewVal = (forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
forall (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe (QExpr be s a -> Maybe (QExpr be s a)
forall a. a -> Maybe a
Just (QExpr be s a -> Maybe (QExpr be s a))
-> (table (QExpr be s) -> QExpr be s a)
-> table (QExpr be s)
-> Maybe (QExpr be s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> table (QExpr be s) -> QExpr be s a
forall s. table (QExpr be s) -> QExpr be s a
mkNewVal)

-- | Use with 'set' to optionally set a fiield to a new value,
-- calculated based on one or more fields from the existing row
toUpdatedValueMaybe :: (forall s. table (QExpr be s) -> Maybe (QExpr be s a)) -> QFieldAssignment be table a
toUpdatedValueMaybe :: (forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe = (forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
forall be (tbl :: (* -> *) -> *) a.
(forall s. tbl (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be tbl a
QFieldAssignment

-- | Generate a 'SqlUpdate' that will update the given table row with the given value.
--
--   The SQL @UPDATE@ that is generated will set every non-primary key field for
--   the row where each primary key field is exactly what is given.
--
--   Note: This is a pure SQL @UPDATE@ command. This does not upsert or merge values.
--
--   Use 'save'' for an internal 'SqlBool' comparison.
save :: forall table be db.
        ( Table table
        , BeamSqlBackend be

        , SqlValableTable be (PrimaryKey table)
        , SqlValableTable be table

        , HasTableEquality be (PrimaryKey table)
        )
     => DatabaseEntity be db (TableEntity table)
        -- ^ Table to update
     -> table Identity
        -- ^ Value to set to
     -> SqlUpdate be table
save :: DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save DatabaseEntity be db (TableEntity table)
tbl table Identity
v =
  DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Table table,
 HasTableEquality be (PrimaryKey table),
 SqlValableTable be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
updateTableRow DatabaseEntity be db (TableEntity table)
tbl table Identity
v
    ((forall s. table (QExpr be s)) -> table (QFieldAssignment be table)
forall (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Table table =>
(forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo (HaskellLiteralForQExpr (table (QExpr be s)) -> table (QExpr be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ table Identity
HaskellLiteralForQExpr (table (QExpr be s))
v))

-- | Generate a 'SqlUpdate' that will update the given table row with the given value.
-- This is a variant using 'update'' and a 'SqlBool' comparison.
--
--   The SQL @UPDATE@ that is generated will set every non-primary key field for
--   the row where each primary key field is exactly what is given.
--
--   Note: This is a pure SQL @UPDATE@ command. This does not upsert or merge values.
--
--   Use 'save' for an internal 'Bool' comparison.
save' :: forall table be db.
         ( Table table
         , BeamSqlBackend be

         , SqlValableTable be (PrimaryKey table)
         , SqlValableTable be table

         , HasTableEquality be (PrimaryKey table)
         )
      => DatabaseEntity be db (TableEntity table)
         -- ^ Table to update
      -> table Identity
         -- ^ Value to set to
      -> SqlUpdate be table
save' :: DatabaseEntity be db (TableEntity table)
-> table Identity -> SqlUpdate be table
save' DatabaseEntity be db (TableEntity table)
tbl table Identity
v =
  DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Table table,
 HasTableEquality be (PrimaryKey table),
 SqlValableTable be (PrimaryKey table)) =>
DatabaseEntity be db (TableEntity table)
-> table Identity
-> table (QFieldAssignment be table)
-> SqlUpdate be table
updateTableRow' DatabaseEntity be db (TableEntity table)
tbl table Identity
v
    ((forall s. table (QExpr be s)) -> table (QFieldAssignment be table)
forall (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Table table =>
(forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo (HaskellLiteralForQExpr (table (QExpr be s)) -> table (QExpr be s)
forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ table Identity
HaskellLiteralForQExpr (table (QExpr be s))
v))

-- | Run a 'SqlUpdate' in a 'MonadBeam'.
runUpdate :: (BeamSqlBackend be, MonadBeam be m)
          => SqlUpdate be tbl -> m ()
runUpdate :: SqlUpdate be tbl -> m ()
runUpdate (SqlUpdate TableSettings tbl
_ BeamSqlBackendUpdateSyntax be
u) = BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (BeamSqlBackendUpdateSyntax be -> BeamSqlBackendSyntax be
forall cmd. IsSql92Syntax cmd => Sql92UpdateSyntax cmd -> cmd
updateCmd BeamSqlBackendUpdateSyntax be
u)
runUpdate SqlUpdate be tbl
SqlIdentityUpdate = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- * DELETE

-- | Represents a SQL @DELETE@ statement for the given @table@
data SqlDelete be (table :: (Type -> Type) -> Type)
  = SqlDelete !(TableSettings table) !(BeamSqlBackendDeleteSyntax be)

-- | Build a 'SqlDelete' from a table and a way to build a @WHERE@ clause
delete :: forall be db table
        . BeamSqlBackend be
       => DatabaseEntity be db (TableEntity table)
          -- ^ Table to delete from
       -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
          -- ^ Build a @WHERE@ clause given a table containing expressions
       -> SqlDelete be table
delete :: DatabaseEntity be db (TableEntity table)
-> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)
-> SqlDelete be table
delete (DatabaseEntity dt :: DatabaseEntityDescriptor be (TableEntity table)
dt@(DatabaseTable {})) forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool
mkWhere =
  TableSettings table
-> BeamSqlBackendDeleteSyntax be -> SqlDelete be table
forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendDeleteSyntax be -> SqlDelete be table
SqlDelete (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
            (Sql92DeleteTableNameSyntax (BeamSqlBackendDeleteSyntax be)
-> Maybe TablePrefix
-> Maybe
     (Sql92DeleteExpressionSyntax (BeamSqlBackendDeleteSyntax be))
-> BeamSqlBackendDeleteSyntax be
forall delete.
IsSql92DeleteSyntax delete =>
Sql92DeleteTableNameSyntax delete
-> Maybe TablePrefix
-> Maybe (Sql92DeleteExpressionSyntax delete)
-> delete
deleteStmt (DatabaseEntityDescriptor be (TableEntity table)
-> Sql92DeleteTableNameSyntax (BeamSqlBackendDeleteSyntax be)
forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt) Maybe TablePrefix
alias (Sql92UpdateExpressionSyntax
  (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
-> Maybe
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
forall a. a -> Maybe a
Just (TablePrefix -> BeamSqlBackendExpressionSyntax be
where_ TablePrefix
"t")))
  where
    supportsAlias :: Bool
supportsAlias = Proxy (BeamSqlBackendDeleteSyntax be) -> Bool
forall delete. IsSql92DeleteSyntax delete => Proxy delete -> Bool
deleteSupportsAlias (Proxy (BeamSqlBackendDeleteSyntax be)
forall k (t :: k). Proxy t
Proxy @(BeamSqlBackendDeleteSyntax be))

    tgtName :: TablePrefix
tgtName = TablePrefix
"delete_target"
    alias :: Maybe TablePrefix
alias = if Bool
supportsAlias then TablePrefix -> Maybe TablePrefix
forall a. a -> Maybe a
Just TablePrefix
tgtName else Maybe TablePrefix
forall a. Maybe a
Nothing
    mkField :: TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
mkField = if Bool
supportsAlias then TablePrefix
-> TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
forall fn.
IsSql92FieldNameSyntax fn =>
TablePrefix -> TablePrefix -> fn
qualifiedField TablePrefix
tgtName else TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
forall fn. IsSql92FieldNameSyntax fn => TablePrefix -> fn
unqualifiedField

    QExpr TablePrefix -> BeamSqlBackendExpressionSyntax be
where_ = (forall s'. table (QExpr be s'))
-> QGenExpr QValueContext be Any Bool
forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool
mkWhere ((forall a.
 Columnar' (TableField table) a -> Columnar' (QExpr be s') a)
-> TableSettings table -> table (QExpr be s')
forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
fd) -> Columnar (QExpr be s') a -> Columnar' (QExpr be s') a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr QValueContext be s' a
forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (Sql92UpdateExpressionSyntax
  (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
-> TablePrefix
-> Sql92UpdateExpressionSyntax
     (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sql92ExpressionFieldNameSyntax
  (Sql92UpdateExpressionSyntax
     (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
-> Sql92UpdateExpressionSyntax
     (Sql92UpdateSyntax (BeamSqlBackendSyntax be))
forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92InsertValuesExpressionSyntax
        (Sql92InsertValuesSyntax
           (Sql92InsertSyntax (BeamSqlBackendSyntax be))))
mkField (TableField table a
Columnar (TableField table) a
fd TableField table a
-> Getting TablePrefix (TableField table a) TablePrefix
-> TablePrefix
forall s a. s -> Getting a s a -> a
^. Getting TablePrefix (TableField table a) TablePrefix
forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName))))))
                             (DatabaseEntityDescriptor be (TableEntity table)
-> TableSettings table
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt))

-- | Run a 'SqlDelete' in a 'MonadBeam'
runDelete :: (BeamSqlBackend be, MonadBeam be m)
          => SqlDelete be table -> m ()
runDelete :: SqlDelete be table -> m ()
runDelete (SqlDelete TableSettings table
_ BeamSqlBackendDeleteSyntax be
d) = BeamSqlBackendSyntax be -> m ()
forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (BeamSqlBackendDeleteSyntax be -> BeamSqlBackendSyntax be
forall cmd. IsSql92Syntax cmd => Sql92DeleteSyntax cmd -> cmd
deleteCmd BeamSqlBackendDeleteSyntax be
d)