{-# 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(..)
    , inQuery_

    -- ** 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
    , runSelectReturningFirst
    , 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 :: 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
q =
  forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect (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 :: 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 (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)) = forall s a. State s a -> s -> a
evalState (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 -> forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect (forall syntax.
IsSql99CommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withSyntax [BeamSql99BackendCTESyntax be]
ctes
                                                   (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    -> forall be a. BeamSqlBackendSelectSyntax be -> SqlSelect be a
SqlSelect (forall syntax.
IsSql99RecursiveCommonTableExpressionSelectSyntax syntax =>
[Sql99SelectCTESyntax syntax] -> syntax -> syntax
withRecursiveSyntax [BeamSql99BackendCTESyntax be]
ctes
                                                            (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_ :: forall be (db :: (* -> *) -> *) (table :: (* -> *) -> *).
(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)
tbl PrimaryKey table Identity
tblKey =
  forall be (db :: (* -> *) -> *) res.
(BeamSqlBackend be, HasQBuilder be, Projectible be res) =>
Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res)
select forall a b. (a -> b) -> a -> b
$
  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 -> forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
pk table (QExpr be QBaseScope)
t forall (expr :: * -> *) a. SqlEq expr a => a -> a -> expr Bool
==. forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ PrimaryKey table Identity
tblKey) forall a b. (a -> b) -> a -> b
$
  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 :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m [a]
runSelectReturningList (SqlSelect BeamSqlBackendSelectSyntax be
s) =
  forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m [x]
runReturningList (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 :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningOne (SqlSelect BeamSqlBackendSelectSyntax be
s) =
  forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m (Maybe x)
runReturningOne (forall cmd. IsSql92Syntax cmd => Sql92SelectSyntax cmd -> cmd
selectCmd BeamSqlBackendSelectSyntax be
s)

-- | Run a 'SqlSelect' in a 'MonadBeam' and get the first result, if there is
--   one.
--   This is not guaranteed to automatically limit the query to one result.
runSelectReturningFirst ::
  (MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
  SqlSelect be a -> m (Maybe a)
runSelectReturningFirst :: forall be (m :: * -> *) a.
(MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>
SqlSelect be a -> m (Maybe a)
runSelectReturningFirst (SqlSelect BeamSqlBackendSelectSyntax be
s) =
  forall be (m :: * -> *) x.
(MonadBeam be m, FromBackendRow be x) =>
BeamSqlBackendSyntax be -> m (Maybe x)
runReturningFirst (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 :: forall res (db :: (* -> *) -> *).
Projectible (MockSqlBackend SqlSyntaxBuilder) res =>
Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res -> IO ()
dumpSqlSelect Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res
q =
    let SqlSelect BeamSqlBackendSelectSyntax (MockSqlBackend SqlSyntaxBuilder)
s = 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)
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 :: 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)
_ table (QField s) -> QExprToField r
_ SqlInsertValues be r
SqlInsertValuesEmpty = 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) =
    forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendInsertSyntax be -> SqlInsert be table
SqlInsert (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt) (forall insert.
IsSql92InsertSyntax insert =>
Sql92InsertTableNameSyntax insert
-> [TablePrefix] -> Sql92InsertValuesSyntax insert -> insert
insertStmt (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 (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
fd) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall s ty. Bool -> TablePrefix -> TablePrefix -> QField s ty
QField Bool
False (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TablePrefix
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt) (Columnar (TableField table) a
fd forall s a. s -> Getting a s a -> a
^. forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName)))
                              (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
    proj :: [TablePrefix]
proj = forall w a. Writer w a -> w
execWriter (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' (forall {k} (t :: k). Proxy t
Proxy @AnyType) (forall {k} (t :: k). Proxy t
Proxy @((), Text))
                                (\Proxy context
_ Proxy ()
_ TablePrefix
f -> forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TablePrefix
f] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 :: forall be (table :: (* -> *) -> *) s (db :: (* -> *) -> *).
(BeamSqlBackend be,
 ProjectibleWithPredicate
   AnyType () TablePrefix (table (QField s))) =>
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 = 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 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 :: forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlInsert be table -> m ()
runInsert SqlInsert be table
SqlInsertNoRows = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runInsert (SqlInsert TableSettings table
_ BeamSqlBackendInsertSyntax be
i) = forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (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 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')]
tbls =
  case [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
sqlExprs of
    [] -> forall be proj. SqlInsertValues be proj
SqlInsertValuesEmpty
    [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
_  -> forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
[[Sql92InsertValuesExpressionSyntax insertValues]] -> insertValues
insertSqlExpressions [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
sqlExprs)
    where
      sqlExprs :: [[Sql92UpdateExpressionSyntax
    (Sql92UpdateSyntax (BeamSqlBackendSyntax be))]]
sqlExprs = forall a b. (a -> b) -> [a] -> [b]
map forall s'.
table (QExpr be s')
-> [Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be)))]
mkSqlExprs forall s'. [table (QExpr be s')]
tbls

      mkSqlExprs :: forall s'. table (QExpr be s') -> [ BeamSqlBackendExpressionSyntax be ]
      mkSqlExprs :: forall s'.
table (QExpr be s')
-> [Sql92SelectTableExpressionSyntax
      (Sql92SelectSelectTableSyntax
         (Sql92SelectSyntax (BeamSqlBackendSyntax be)))]
mkSqlExprs = forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (QExpr TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
x)) -> TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax 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 :: forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table,
 FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table) =>
[table Identity] -> SqlInsertValues be (table (QExpr be s))
insertValues [table Identity]
x = forall be (table :: (* -> *) -> *) s.
(BeamSqlBackend be, Beamable table) =>
(forall s'. [table (QExpr be s')])
-> SqlInsertValues be (table (QExpr be s))
insertExpressions (forall a b. (a -> b) -> [a] -> [b]
map 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 :: forall be r.
(Projectible be r, BeamSqlBackend be) =>
[r] -> SqlInsertValues be r
insertData [r]
rows =
  case [r]
rows of
    [] -> forall be proj. SqlInsertValues be proj
SqlInsertValuesEmpty
    [r]
_  -> forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
[[Sql92InsertValuesExpressionSyntax insertValues]] -> insertValues
insertSqlExpressions (forall a b. (a -> b) -> [a] -> [b]
map (\r
row -> forall be a.
Projectible be a =>
Proxy be
-> a -> WithExprContext [BeamSqlBackendExpressionSyntax be]
project (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 :: forall be r (db :: (* -> *) -> *).
(BeamSqlBackend be, HasQBuilder be, Projectible be r) =>
Q be db QBaseScope r -> SqlInsertValues be r
insertFrom Q be db QBaseScope r
s = forall be proj.
BeamSqlBackendInsertValuesSyntax be -> SqlInsertValues be proj
SqlInsertValues (forall insertValues.
IsSql92InsertValuesSyntax insertValues =>
Sql92InsertValuesSelectSyntax insertValues -> insertValues
insertFromSql (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 :: 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 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,
  Sql92SelectTableExpressionSyntax
    (Sql92SelectSelectTableSyntax
       (Sql92SelectSyntax (BeamSqlBackendSyntax be))))]
assignments of
    [] -> forall be (table :: (* -> *) -> *). SqlUpdate be table
SqlIdentityUpdate
    [(BeamSqlBackendFieldNameSyntax be,
  Sql92SelectTableExpressionSyntax
    (Sql92SelectSelectTableSyntax
       (Sql92SelectSyntax (BeamSqlBackendSyntax be))))]
_  -> forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendUpdateSyntax be -> SqlUpdate be table
SqlUpdate (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
                    (forall update.
IsSql92UpdateSyntax update =>
Sql92UpdateTableNameSyntax update
-> [(Sql92UpdateFieldNameSyntax update,
     Sql92UpdateExpressionSyntax update)]
-> Maybe (Sql92UpdateExpressionSyntax update)
-> update
updateStmt (forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt)
                       [(BeamSqlBackendFieldNameSyntax be,
  Sql92SelectTableExpressionSyntax
    (Sql92SelectSelectTableSyntax
       (Sql92SelectSyntax (BeamSqlBackendSyntax be))))]
assignments (forall a. a -> Maybe a
Just (TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
where_ TablePrefix
"t")))
  where
    QAssignment [(BeamSqlBackendFieldNameSyntax be,
  Sql92SelectTableExpressionSyntax
    (Sql92SelectSelectTableSyntax
       (Sql92SelectSyntax (BeamSqlBackendSyntax be))))]
assignments = forall s. table (QField s) -> QAssignment be s
mkAssignments table (QField Any)
tblFields
    QExpr TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
where_ = forall s. table (QExpr be s) -> QExpr be s bool
mkWhere table (QExpr be Any)
tblFieldExprs

    tblFields :: table (QField Any)
tblFields = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' Columnar (TableField table) a
fd) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall s ty. Bool -> TablePrefix -> TablePrefix -> QField s ty
QField Bool
False (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TablePrefix
dbTableCurrentName DatabaseEntityDescriptor be (TableEntity table)
dt) (Columnar (TableField table) a
fd forall s a. s -> Getting a s a -> a
^. forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName)))
                              (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
    tblFieldExprs :: table (QExpr be Any)
tblFieldExprs = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\(Columnar' (QField Bool
_ TablePrefix
_ TablePrefix
nm)) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (forall fn. IsSql92FieldNameSyntax fn => 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 :: 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 = 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 @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' :: 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' = 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 @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 :: forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Table table,
 HasTableEquality be (PrimaryKey table),
 SqlValableTable be (PrimaryKey table)) =>
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 =
  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 (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_ (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (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' :: forall be (table :: (* -> *) -> *) (db :: (* -> *) -> *).
(BeamSqlBackend be, Table table,
 HasTableEquality be (PrimaryKey table),
 SqlValableTable be (PrimaryKey table)) =>
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 =
  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 (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_' (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (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 :: 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
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 :: forall s. table (QField s) -> QAssignment be s
mkAssignments table (QField s)
tblFields =
        let tblExprs :: table (QExpr be s)
tblExprs = 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) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall be s ty. BeamSqlBackend be => QField s ty -> QExpr be s ty
current_ Columnar (QField s) a
fd)) table (QField s)
tblFields
        in forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$
           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' Columnar (QField s) a
field :: Columnar' (QField s) a)
               c :: Columnar' (QFieldAssignment be table) a
c@(Columnar' (QFieldAssignment forall s. table (QExpr be s) -> Maybe (QExpr be s a)
mkAssignment)) ->
                case forall s. table (QExpr be s) -> Maybe (QExpr be s a)
mkAssignment table (QExpr be s)
tblExprs of
                  Maybe (QExpr be s a)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Columnar' (QFieldAssignment be table) a
c
                  Just QExpr be s a
newValue -> do
                    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Columnar (QField s) a
field forall be s lhs rhs.
SqlUpdatable be s lhs rhs =>
lhs -> rhs -> QAssignment be s
<-. QExpr be s a
newValue)
                    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 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 :: 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 = 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
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' :: 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' = 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
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 :: 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
row table (QFieldAssignment be table)
assignments =
  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 (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_ (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (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' :: 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
row table (QFieldAssignment be table)
assignments =
  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 (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_' (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ (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 :: forall (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Beamable table =>
table (QFieldAssignment be table')
set = forall (table :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
Beamable table =>
(forall a. Columnar' f a -> Columnar' g a) -> table f -> table g
changeBeamRep (\Columnar' Ignored a
_ -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall be (tbl :: (* -> *) -> *) a.
(forall s. tbl (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be tbl a
QFieldAssignment (\table' (QExpr be s)
_ -> forall a. Maybe a
Nothing))) (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 (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Table table =>
(forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo forall s. table (QExpr be s)
tbl =

  forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
  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 Int
columnIx))
                   (Columnar' (QExpr TablePrefix -> BeamSqlBackendExpressionSyntax be
newValue)) ->
                    if Int
columnIx forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
primaryKeyIndices
                    then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' forall be (table :: (* -> *) -> *) a. QFieldAssignment be table a
toOldValue
                    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall be a (table :: (* -> *) -> *).
(forall s. QExpr be s a) -> QFieldAssignment be table a
toNewValue (forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr TablePrefix -> BeamSqlBackendExpressionSyntax be
newValue)))
                 table (Const Int)
indexedTable forall s. table (QExpr be s)
tbl

  where
    indexedTable :: table (Const Int)
    indexedTable :: table (Const Int)
indexedTable =
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState Int
0 forall a b. (a -> b) -> a -> b
$
      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 <- forall s (m :: * -> *). MonadState s m => m s
get
                         forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
n forall a. Num a => a -> a -> a
+ Int
1)
                         forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall {k} a (b :: k). a -> Const a b
Const Int
n)))
        (forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table) (forall (table :: (* -> *) -> *).
Beamable table =>
TableSkeleton table
tblSkeleton :: TableSkeleton table)

    primaryKeyIndices :: [ Int ]
    primaryKeyIndices :: [Int]
primaryKeyIndices = forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' (Const Int
ix)) -> Int
ix) (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 be a (table :: (* -> *) -> *).
(forall s. QExpr be s a) -> QFieldAssignment be table a
toNewValue forall s. QExpr be s a
newVal = forall (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> QExpr be s a)
-> QFieldAssignment be table a
toUpdatedValue (\table (QExpr be s)
_ -> forall s. QExpr be s a
newVal)

-- | Use with 'set' to not modify the field
toOldValue :: QFieldAssignment be table a
toOldValue :: forall be (table :: (* -> *) -> *) a. QFieldAssignment be table a
toOldValue = forall (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe (\table (QExpr be s)
_ -> 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 (table :: (* -> *) -> *) be a.
(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 (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (table :: (* -> *) -> *) be a.
(forall s. table (QExpr be s) -> Maybe (QExpr be s a))
-> QFieldAssignment be table a
toUpdatedValueMaybe = 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 :: 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 Identity -> SqlUpdate be table
save DatabaseEntity be db (TableEntity table)
tbl table Identity
v =
  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 (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Table table =>
(forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ table Identity
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' :: 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 Identity -> SqlUpdate be table
save' DatabaseEntity be db (TableEntity table)
tbl table Identity
v =
  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 (table :: (* -> *) -> *) be (table' :: (* -> *) -> *).
Table table =>
(forall s. table (QExpr be s))
-> table (QFieldAssignment be table')
setFieldsTo (forall a. SqlValable a => HaskellLiteralForQExpr a -> a
val_ table Identity
v))

-- | Run a 'SqlUpdate' in a 'MonadBeam'.
runUpdate :: (BeamSqlBackend be, MonadBeam be m)
          => SqlUpdate be tbl -> m ()
runUpdate :: forall be (m :: * -> *) (tbl :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlUpdate be tbl -> m ()
runUpdate (SqlUpdate TableSettings tbl
_ BeamSqlBackendUpdateSyntax be
u) = forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (forall cmd. IsSql92Syntax cmd => Sql92UpdateSyntax cmd -> cmd
updateCmd BeamSqlBackendUpdateSyntax be
u)
runUpdate SqlUpdate be tbl
SqlIdentityUpdate = 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 :: 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 dt :: DatabaseEntityDescriptor be (TableEntity table)
dt@(DatabaseTable {})) forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool
mkWhere =
  forall be (table :: (* -> *) -> *).
TableSettings table
-> BeamSqlBackendDeleteSyntax be -> SqlDelete be table
SqlDelete (forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity table)
dt)
            (forall delete.
IsSql92DeleteSyntax delete =>
Sql92DeleteTableNameSyntax delete
-> Maybe TablePrefix
-> Maybe (Sql92DeleteExpressionSyntax delete)
-> delete
deleteStmt (forall name be (tbl :: (* -> *) -> *).
IsSql92TableNameSyntax name =>
DatabaseEntityDescriptor be (TableEntity tbl) -> name
tableNameFromEntity DatabaseEntityDescriptor be (TableEntity table)
dt) Maybe TablePrefix
alias (forall a. a -> Maybe a
Just (TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
where_ TablePrefix
"t")))
  where
    supportsAlias :: Bool
supportsAlias = forall delete. IsSql92DeleteSyntax delete => Proxy delete -> Bool
deleteSupportsAlias (forall {k} (t :: k). Proxy t
Proxy @(BeamSqlBackendDeleteSyntax be))

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

    QExpr TablePrefix
-> Sql92SelectTableExpressionSyntax
     (Sql92SelectSelectTableSyntax
        (Sql92SelectSyntax (BeamSqlBackendSyntax be)))
where_ = forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool
mkWhere (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) -> forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (forall context be s t.
(TablePrefix -> BeamSqlBackendExpressionSyntax be)
-> QGenExpr context be s t
QExpr (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall expr.
IsSql92ExpressionSyntax expr =>
Sql92ExpressionFieldNameSyntax expr -> expr
fieldE (TablePrefix
-> Sql92ExpressionFieldNameSyntax
     (Sql92UpdateExpressionSyntax
        (Sql92UpdateSyntax (BeamSqlBackendSyntax be)))
mkField (Columnar (TableField table) a
fd forall s a. s -> Getting a s a -> a
^. forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) TablePrefix
fieldName))))))
                             (forall (tbl :: (* -> *) -> *) be.
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 :: forall be (m :: * -> *) (table :: (* -> *) -> *).
(BeamSqlBackend be, MonadBeam be m) =>
SqlDelete be table -> m ()
runDelete (SqlDelete TableSettings table
_ BeamSqlBackendDeleteSyntax be
d) = forall be (m :: * -> *).
MonadBeam be m =>
BeamSqlBackendSyntax be -> m ()
runNoReturn (forall cmd. IsSql92Syntax cmd => Sql92DeleteSyntax cmd -> cmd
deleteCmd BeamSqlBackendDeleteSyntax be
d)