{-# OPTIONS_HADDOCK ignore-exports #-}

-- | Responsible for translating and building an MSSQL execution plan for
--   delete mutations.
--
--   This module is used by "Hasura.Backends.MSSQL.Instances.Execute".
module Hasura.Backends.MSSQL.Execute.Insert
  ( executeInsert,
  )
where

import Data.HashMap.Strict qualified as HM
import Database.MSSQL.Transaction qualified as Tx
import Hasura.Backends.MSSQL.Connection
import Hasura.Backends.MSSQL.Execute.QueryTags (withQueryTags)
import Hasura.Backends.MSSQL.FromIr as TSQL
import Hasura.Backends.MSSQL.FromIr.Constants (tempTableNameInserted, tempTableNameValues)
import Hasura.Backends.MSSQL.FromIr.Expression
import Hasura.Backends.MSSQL.FromIr.Insert (toMerge)
import Hasura.Backends.MSSQL.FromIr.Insert qualified as TSQL
import Hasura.Backends.MSSQL.FromIr.MutationResponse
import Hasura.Backends.MSSQL.FromIr.SelectIntoTempTable qualified as TSQL
import Hasura.Backends.MSSQL.Plan
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Backends.MSSQL.ToQuery as TQ
import Hasura.Backends.MSSQL.Types.Insert (BackendInsert (..), IfMatched)
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.SQL.Backend
import Hasura.Session

-- | Execute and insert/upsert mutation against MS SQL Server.
--   See the documentation for 'buildInsertTx' to see how it's done.
executeInsert ::
  (MonadError QErr m, MonadReader QueryTagsComment m) =>
  UserInfo ->
  Options.StringifyNumbers ->
  SourceConfig 'MSSQL ->
  AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL) ->
  m (ExceptT QErr IO EncJSON)
executeInsert :: UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (ExceptT QErr IO EncJSON)
executeInsert UserInfo
userInfo StringifyNumbers
stringifyNum SourceConfig 'MSSQL
sourceConfig AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
annInsert = do
  QueryTagsComment
queryTags <- m QueryTagsComment
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- Convert the leaf values from @'UnpreparedValue' to sql @'Expression'
  AnnotatedInsert 'MSSQL Void Expression
insert <- (UnpreparedValue 'MSSQL -> m Expression)
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (AnnotatedInsert 'MSSQL Void Expression)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MSSQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables) AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
annInsert
  let insertTx :: TxET QErr IO EncJSON
insertTx = TableName
-> Text
-> StringifyNumbers
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr IO EncJSON
buildInsertTx TableName 'MSSQL
TableName
tableName Text
withAlias StringifyNumbers
stringifyNum AnnotatedInsert 'MSSQL Void Expression
insert QueryTagsComment
queryTags
  ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON))
-> ExceptT QErr IO EncJSON -> m (ExceptT QErr IO EncJSON)
forall a b. (a -> b) -> a -> b
$ MSSQLExecCtx -> TxET QErr IO EncJSON -> ExceptT QErr IO EncJSON
MSSQLExecCtx
-> forall (m :: * -> *) a.
   (MonadIO m, MonadBaseControl IO m) =>
   TxET QErr m a -> ExceptT QErr m a
mssqlRunReadWrite (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) TxET QErr IO EncJSON
insertTx
  where
    sessionVariables :: SessionVariables
sessionVariables = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
    tableName :: TableName 'MSSQL
tableName = AnnotatedInsertData 'MSSQL [] (UnpreparedValue 'MSSQL)
-> TableName 'MSSQL
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> TableName b
_aiTableName (AnnotatedInsertData 'MSSQL [] (UnpreparedValue 'MSSQL)
 -> TableName 'MSSQL)
-> AnnotatedInsertData 'MSSQL [] (UnpreparedValue 'MSSQL)
-> TableName 'MSSQL
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> AnnotatedInsertData 'MSSQL [] (UnpreparedValue 'MSSQL)
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
annInsert
    withAlias :: Text
withAlias = Text
"with_alias"

-- | Translates an IR Insert/upsert mutation description to SQL and
-- builds a corresponding transaction to run against MS SQL Server.
--
-- Execution of a MSSQL insert mutation broadly involves two steps.
--
-- > insert_table(objects: [
-- >   {column1: value1, column2: value2},
-- >   {column1: value3, column2: value4}
-- >  ],
-- >  if_matched: {match_columns: [column1], update_columns: [column2]} # Optional field to enable upserting
-- > ){
-- >   affected_rows
-- >   returning {
-- >     column1
-- >     column2
-- >   }
-- > }
--
-- = Step 1: Inserting rows into the table
--
-- a. Create an empty temporary table with name #inserted to store affected rows (for the response)
--
--    > SELECT column1, column2 INTO #inserted FROM some_table WHERE (1 <> 1)
--    > UNION ALL SELECT column1, column2 FROM some_table WHERE (1 <> 1);
--
-- b. If 'if_matched' is found: Use MERGE statment to perform upsert
--
--       b.1 Use #values temporary table to store input object values
--
--          > SELECT column1, column2 INTO #values FROM some_table WHERE (1 <> 1)
--
--       b.2 Insert input object values into the temporary table
--
--          > INSERT INTO #values (column1, column2) VALUES (value1, value2), (value3, value4)
--
--
--       b.3 Generate an SQL Merge statement to perform either update or insert (upsert) to the table
--
--           > MERGE some_table AS [target]
--           > USING (SELECT column1, column2 from #values) AS [source](column1, column2) ON ([target].column1 = [source].column1)
--           > WHEN MATCHED THEN UPDATE SET [column2] = [source].[column2]
--           > WHEN NOT MATCHED THEN INSERT (column1, column2) VALUES ([source].column1, [source].column2)
--           > OUTPUT INSERTED.column1, INSERTED.column2 INTO #inserted(column1, column2)
--
--    __NOTE__: In @MERGE@ statement, we use @SELECT query from a temporary table@ as source but not @VALUES@ expression
--          because, we can't use @DEFAULT@ expression (for missing columns in @objects@ field) in @VALUES@ expression.
--
--    __else__: Generate an SQL Insert statement from the GraphQL insert mutation with OUTPUT expression to fill @#inserted@ temporary table with inserted rows
--
--       > INSERT INTO some_table (column1, column2) OUTPUT INSERTED.column1, INSERTED.column2 INTO #inserted(column1, column2) VALUES (value1, value2), (value3, value4);
--
-- = Step 2: Generation of the mutation response
--
--    An SQL statement is generated and when executed it returns the mutation selection set containing 'affected_rows' and 'returning' field values.
--    The statement is generated with multiple sub select queries explained below:
--
-- a. A SQL Select statement to fetch only inserted rows from temporary table
--
--    > <table_select> := SELECT * FROM #inserted
--
--    The above select statement is referred through a common table expression - @WITH [with_alias] AS (<table_select>)@
--
-- b. The @affected_rows@ field value is obtained by using @COUNT@ aggregation and the @returning@ field selection set is translated to
--    a SQL select statement using 'mkSQLSelect'.
--
--    > <mutation_output_select> :=
--    >   SELECT (SELECT COUNT(*) FROM [with_alias]) AS [affected_rows], (select_from_returning) AS [returning]
--    >   FOR JSON PATH, INCLUDE_NULL_VALUES, WITHOUT_ARRAY_WRAPPER
--
-- c. Evaluate the check constraint using @CASE@ expression. We use @SUM@ aggregation to check if any inserted row has failed the check constraint.
--
--   > <check_constraint_select> :=
--   >   SELECT SUM([check_sub_query].[check_evaluation])
--   >   FROM
--   >     ( SELECT
--   >         (CASE WHEN <check_boolean_expression> THEN 0 ELSE 1 END) AS [check_evaluation]
--   >       FROM
--   >         [with_alias]
--   >     ) AS [check_sub_query]
--
-- d. The final select statement look like
--
--    > WITH "with_alias" AS (<table_select>)
--    > SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
--
--    When executed, the above statement returns a single row with mutation response as a string value and check constraint result as an integer value.
buildInsertTx ::
  TSQL.TableName ->
  Text ->
  Options.StringifyNumbers ->
  AnnotatedInsert 'MSSQL Void Expression ->
  QueryTagsComment ->
  Tx.TxET QErr IO EncJSON
buildInsertTx :: TableName
-> Text
-> StringifyNumbers
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr IO EncJSON
buildInsertTx TableName
tableName Text
withAlias StringifyNumbers
stringifyNum AnnotatedInsert 'MSSQL Void Expression
insert QueryTagsComment
queryTags = do
  let tableColumns :: [ColumnInfo 'MSSQL]
tableColumns = AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> [ColumnInfo b]
_aiTableColumns (AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL])
-> AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL]
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert
      ifMatchedField :: Maybe (IfMatched Expression)
ifMatchedField = BackendInsert Expression -> Maybe (IfMatched Expression)
forall v. BackendInsert v -> Maybe (IfMatched v)
_biIfMatched (BackendInsert Expression -> Maybe (IfMatched Expression))
-> (AnnotatedInsert 'MSSQL Void Expression
    -> BackendInsert Expression)
-> AnnotatedInsert 'MSSQL Void Expression
-> Maybe (IfMatched Expression)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsertData 'MSSQL [] Expression
-> BackendInsert Expression
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> BackendInsert b v
_aiBackendInsert (AnnotatedInsertData 'MSSQL [] Expression
 -> BackendInsert Expression)
-> (AnnotatedInsert 'MSSQL Void Expression
    -> AnnotatedInsertData 'MSSQL [] Expression)
-> AnnotatedInsert 'MSSQL Void Expression
-> BackendInsert Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData (AnnotatedInsert 'MSSQL Void Expression
 -> Maybe (IfMatched Expression))
-> AnnotatedInsert 'MSSQL Void Expression
-> Maybe (IfMatched Expression)
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
insert

  -- Create #inserted temporary table
  let createInsertedTempTableQuery :: Query
createInsertedTempTableQuery =
        Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$
          SelectIntoTempTable -> Printer
TQ.fromSelectIntoTempTable (SelectIntoTempTable -> Printer) -> SelectIntoTempTable -> Printer
forall a b. (a -> b) -> a -> b
$
            TempTableName
-> TableName
-> [ColumnInfo 'MSSQL]
-> SITTConstraints
-> SelectIntoTempTable
TSQL.toSelectIntoTempTable TempTableName
tempTableNameInserted TableName
tableName [ColumnInfo 'MSSQL]
tableColumns SITTConstraints
RemoveConstraints

  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
createInsertedTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- Choose between running a regular @INSERT INTO@ statement or a @MERGE@ statement
  -- depending on the @if_matched@ field.
  --
  -- Affected rows will be inserted into the #inserted temporary table regardless.
  case Maybe (IfMatched Expression)
ifMatchedField of
    Maybe (IfMatched Expression)
Nothing -> do
      -- Insert values into the table using INSERT query
      let insertQuery :: Query
insertQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ Insert -> Printer
TQ.fromInsert (Insert -> Printer) -> Insert -> Printer
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression -> Insert
TSQL.fromInsert AnnotatedInsert 'MSSQL Void Expression
insert
      (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
mutationMSSQLTxErrorHandler (Query
insertQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)
    Just IfMatched Expression
ifMatched -> TableName
-> AnnotatedInsert 'MSSQL Void Expression
-> IfMatched Expression
-> QueryTagsComment
-> TxET QErr IO ()
buildUpsertTx TableName
tableName AnnotatedInsert 'MSSQL Void Expression
insert IfMatched Expression
ifMatched QueryTagsComment
queryTags

  -- Build a response to the user using the values in the temporary table named #inserted
  (Text
responseText, Int
checkConditionInt) <- StringifyNumbers
-> Text
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr IO (Text, Int)
buildInsertResponseTx StringifyNumbers
stringifyNum Text
withAlias AnnotatedInsert 'MSSQL Void Expression
insert QueryTagsComment
queryTags

  -- Drop the #inserted temp table
  let dropInsertedTempTableQuery :: Query
dropInsertedTempTableQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ TempTableName -> Printer
dropTempTableQuery TempTableName
tempTableNameInserted
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
dropInsertedTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- Raise an exception if the check condition is not met
  Bool -> TxET QErr IO () -> TxET QErr IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
checkConditionInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (TxET QErr IO () -> TxET QErr IO ())
-> TxET QErr IO () -> TxET QErr IO ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> TxET QErr IO ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionError Text
"check constraint of an insert permission has failed"

  EncJSON -> TxET QErr IO EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TxET QErr IO EncJSON)
-> EncJSON -> TxET QErr IO EncJSON
forall a b. (a -> b) -> a -> b
$ Text -> EncJSON
encJFromText Text
responseText

-- | Translates an IR IfMatched clause to SQL and
--   builds a corresponding transaction to run against MS SQL Server.
--
--   We do this in 2 steps:
--
--   1. Create a temporary table called @#values@ which will hold the values the user want to insert,
--      and insert the values into it
--   2. Build an run a @MERGE@ statement to either insert or upsert the values from the temporary table @#values@
--      into the original table, and output the affected rows into another temporary table called @#inserted@
--      which will be used to build a "response" for the user.
--
--   Should be used as part of a bigger transaction in 'buildInsertTx'.
buildUpsertTx ::
  TSQL.TableName ->
  AnnotatedInsert 'MSSQL Void Expression ->
  IfMatched Expression ->
  QueryTagsComment ->
  Tx.TxET QErr IO ()
buildUpsertTx :: TableName
-> AnnotatedInsert 'MSSQL Void Expression
-> IfMatched Expression
-> QueryTagsComment
-> TxET QErr IO ()
buildUpsertTx TableName
tableName AnnotatedInsert 'MSSQL Void Expression
insert IfMatched Expression
ifMatched QueryTagsComment
queryTags = do
  let presets :: PreSetColsG 'MSSQL Expression
presets = AnnotatedInsertData 'MSSQL [] Expression
-> PreSetColsG 'MSSQL Expression
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> PreSetColsG b v
_aiPresetValues (AnnotatedInsertData 'MSSQL [] Expression
 -> PreSetColsG 'MSSQL Expression)
-> AnnotatedInsertData 'MSSQL [] Expression
-> PreSetColsG 'MSSQL Expression
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert
      insertColumnNames :: [ColumnName]
insertColumnNames =
        (AnnotatedInsertRow 'MSSQL Expression -> [ColumnName])
-> [AnnotatedInsertRow 'MSSQL Expression] -> [ColumnName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((ColumnName, Expression) -> ColumnName)
-> [(ColumnName, Expression)] -> [ColumnName]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnName, Expression) -> ColumnName
forall a b. (a, b) -> a
fst ([(ColumnName, Expression)] -> [ColumnName])
-> (AnnotatedInsertRow 'MSSQL Expression
    -> [(ColumnName, Expression)])
-> AnnotatedInsertRow 'MSSQL Expression
-> [ColumnName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsertRow 'MSSQL Expression -> [(ColumnName, Expression)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
getInsertColumns) (AnnotatedInsertData 'MSSQL [] Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
_aiInsertObject (AnnotatedInsertData 'MSSQL [] Expression
 -> [AnnotatedInsertRow 'MSSQL Expression])
-> AnnotatedInsertData 'MSSQL [] Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert) [ColumnName] -> [ColumnName] -> [ColumnName]
forall a. Semigroup a => a -> a -> a
<> HashMap ColumnName Expression -> [ColumnName]
forall k v. HashMap k v -> [k]
HM.keys PreSetColsG 'MSSQL Expression
HashMap ColumnName Expression
presets
      allTableColumns :: [ColumnInfo 'MSSQL]
allTableColumns = AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> [ColumnInfo b]
_aiTableColumns (AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL])
-> AnnotatedInsertData 'MSSQL [] Expression -> [ColumnInfo 'MSSQL]
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert
      insertColumns :: [ColumnInfo 'MSSQL]
insertColumns = (ColumnInfo 'MSSQL -> Bool)
-> [ColumnInfo 'MSSQL] -> [ColumnInfo 'MSSQL]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ColumnInfo 'MSSQL
c -> ColumnInfo 'MSSQL -> Column 'MSSQL
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo 'MSSQL
c ColumnName -> [ColumnName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ColumnName]
insertColumnNames) [ColumnInfo 'MSSQL]
allTableColumns
      createValuesTempTableQuery :: Query
createValuesTempTableQuery =
        Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$
          SelectIntoTempTable -> Printer
TQ.fromSelectIntoTempTable (SelectIntoTempTable -> Printer) -> SelectIntoTempTable -> Printer
forall a b. (a -> b) -> a -> b
$
            -- We want to KeepConstraints here so the user can omit values for identity columns such as `id`
            TempTableName
-> TableName
-> [ColumnInfo 'MSSQL]
-> SITTConstraints
-> SelectIntoTempTable
TSQL.toSelectIntoTempTable TempTableName
tempTableNameValues TableName
tableName [ColumnInfo 'MSSQL]
insertColumns SITTConstraints
KeepConstraints
  -- Create #values temporary table
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
createValuesTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- Store values in #values temporary table
  let insertValuesIntoTempTableQuery :: Query
insertValuesIntoTempTableQuery =
        Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$
          InsertValuesIntoTempTable -> Printer
TQ.fromInsertValuesIntoTempTable (InsertValuesIntoTempTable -> Printer)
-> InsertValuesIntoTempTable -> Printer
forall a b. (a -> b) -> a -> b
$
            TempTableName
-> AnnotatedInsert 'MSSQL Void Expression
-> InsertValuesIntoTempTable
TSQL.toInsertValuesIntoTempTable TempTableName
tempTableNameValues AnnotatedInsert 'MSSQL Void Expression
insert
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
mutationMSSQLTxErrorHandler (Query
insertValuesIntoTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- Run the MERGE query and store the mutated rows in #inserted temporary table
  Merge
merge <- FromIr Merge -> TxET QErr IO Merge
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr (TableName
-> [AnnotatedInsertRow 'MSSQL Expression]
-> [ColumnInfo 'MSSQL]
-> IfMatched Expression
-> FromIr Merge
toMerge TableName
tableName (AnnotatedInsertData 'MSSQL [] Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
_aiInsertObject (AnnotatedInsertData 'MSSQL [] Expression
 -> [AnnotatedInsertRow 'MSSQL Expression])
-> AnnotatedInsertData 'MSSQL [] Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert) [ColumnInfo 'MSSQL]
allTableColumns IfMatched Expression
ifMatched)
  let mergeQuery :: Query
mergeQuery = Printer -> Query
toQueryFlat (Printer -> Query) -> Printer -> Query
forall a b. (a -> b) -> a -> b
$ Merge -> Printer
TQ.fromMerge Merge
merge
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
mutationMSSQLTxErrorHandler (Query
mergeQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- After @MERGE@ we no longer need this temporary table
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Printer -> Query
toQueryFlat (TempTableName -> Printer
dropTempTableQuery TempTableName
tempTableNameValues) Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

-- | Builds a response to the user using the values in the temporary table named #inserted.
buildInsertResponseTx ::
  Options.StringifyNumbers ->
  Text ->
  AnnotatedInsert 'MSSQL Void Expression ->
  QueryTagsComment ->
  Tx.TxET QErr IO (Text, Int)
buildInsertResponseTx :: StringifyNumbers
-> Text
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr IO (Text, Int)
buildInsertResponseTx StringifyNumbers
stringifyNum Text
withAlias AnnotatedInsert 'MSSQL Void Expression
insert QueryTagsComment
queryTags = do
  -- Generate a SQL SELECT statement which outputs the mutation response using the #inserted
  Select
mutationOutputSelect <- FromIr Select -> TxET QErr IO Select
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr (FromIr Select -> TxET QErr IO Select)
-> FromIr Select -> TxET QErr IO Select
forall a b. (a -> b) -> a -> b
$ StringifyNumbers
-> Text -> MutationOutputG 'MSSQL Void Expression -> FromIr Select
mkMutationOutputSelect StringifyNumbers
stringifyNum Text
withAlias (MutationOutputG 'MSSQL Void Expression -> FromIr Select)
-> MutationOutputG 'MSSQL Void Expression -> FromIr Select
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> MutationOutputG 'MSSQL Void Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MutationOutputG b r v
_aiOutput AnnotatedInsert 'MSSQL Void Expression
insert

  -- The check constraint is translated to boolean expression
  let checkCondition :: AnnBoolExp 'MSSQL Expression
checkCondition = (AnnBoolExp 'MSSQL Expression,
 Maybe (AnnBoolExp 'MSSQL Expression))
-> AnnBoolExp 'MSSQL Expression
forall a b. (a, b) -> a
fst ((AnnBoolExp 'MSSQL Expression,
  Maybe (AnnBoolExp 'MSSQL Expression))
 -> AnnBoolExp 'MSSQL Expression)
-> (AnnBoolExp 'MSSQL Expression,
    Maybe (AnnBoolExp 'MSSQL Expression))
-> AnnBoolExp 'MSSQL Expression
forall a b. (a -> b) -> a -> b
$ AnnotatedInsertData 'MSSQL [] Expression
-> (AnnBoolExp 'MSSQL Expression,
    Maybe (AnnBoolExp 'MSSQL Expression))
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v
-> (AnnBoolExp b v, Maybe (AnnBoolExp b v))
_aiCheckCondition (AnnotatedInsertData 'MSSQL [] Expression
 -> (AnnBoolExp 'MSSQL Expression,
     Maybe (AnnBoolExp 'MSSQL Expression)))
-> AnnotatedInsertData 'MSSQL [] Expression
-> (AnnBoolExp 'MSSQL Expression,
    Maybe (AnnBoolExp 'MSSQL Expression))
forall a b. (a -> b) -> a -> b
$ AnnotatedInsert 'MSSQL Void Expression
-> AnnotatedInsertData 'MSSQL [] Expression
forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiData AnnotatedInsert 'MSSQL Void Expression
insert
  Expression
checkBoolExp <- FromIr Expression -> TxET QErr IO Expression
forall (m :: * -> *) a. MonadError QErr m => FromIr a -> m a
runFromIr (FromIr Expression -> TxET QErr IO Expression)
-> FromIr Expression -> TxET QErr IO Expression
forall a b. (a -> b) -> a -> b
$ ReaderT EntityAlias FromIr Expression
-> EntityAlias -> FromIr Expression
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AnnBoolExp 'MSSQL Expression
-> ReaderT EntityAlias FromIr Expression
fromGBoolExp AnnBoolExp 'MSSQL Expression
checkCondition) (Text -> EntityAlias
EntityAlias Text
withAlias)

  let withSelect :: Select
withSelect =
        Select
emptySelect
          { $sel:selectProjections:Select :: [Projection]
selectProjections = [Projection
StarProjection],
            $sel:selectFrom:Select :: Maybe From
selectFrom = From -> Maybe From
forall a. a -> Maybe a
Just (From -> Maybe From) -> From -> Maybe From
forall a b. (a -> b) -> a -> b
$ Aliased TempTableName -> From
FromTempTable (Aliased TempTableName -> From) -> Aliased TempTableName -> From
forall a b. (a -> b) -> a -> b
$ TempTableName -> Text -> Aliased TempTableName
forall a. a -> Text -> Aliased a
Aliased TempTableName
tempTableNameInserted Text
"inserted_alias"
          }
      -- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
      mutationOutputCheckConstraintSelect :: Select
mutationOutputCheckConstraintSelect = Text -> Select -> Expression -> Select
selectMutationOutputAndCheckCondition Text
withAlias Select
mutationOutputSelect Expression
checkBoolExp
      -- WITH "with_alias" AS (<table_select>)
      -- SELECT (<mutation_output_select>) AS [mutation_response], (<check_constraint_select>) AS [check_constraint_select]
      finalSelect :: Select
finalSelect = Select
mutationOutputCheckConstraintSelect {$sel:selectWith:Select :: Maybe With
selectWith = With -> Maybe With
forall a. a -> Maybe a
Just (With -> Maybe With) -> With -> Maybe With
forall a b. (a -> b) -> a -> b
$ NonEmpty (Aliased Select) -> With
With (NonEmpty (Aliased Select) -> With)
-> NonEmpty (Aliased Select) -> With
forall a b. (a -> b) -> a -> b
$ Aliased Select -> NonEmpty (Aliased Select)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased Select -> NonEmpty (Aliased Select))
-> Aliased Select -> NonEmpty (Aliased Select)
forall a b. (a -> b) -> a -> b
$ Select -> Text -> Aliased Select
forall a. a -> Text -> Aliased a
Aliased Select
withSelect Text
withAlias}

  -- Execute SELECT query to fetch mutation response and check constraint result
  let selectQuery :: Query
selectQuery = Printer -> Query
toQueryFlat (Select -> Printer
TQ.fromSelect Select
finalSelect)
  (MSSQLTxError -> QErr) -> Query -> TxET QErr IO (Text, Int)
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m a
Tx.singleRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
selectQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)