{-# 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 HashMap
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.Execute.Backend
import Hasura.Prelude
import Hasura.QueryTags (QueryTagsComment)
import Hasura.RQL.IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Schema.Options qualified as Options
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 (OnBaseMonad (ExceptT QErr) EncJSON)
executeInsert :: forall (m :: * -> *).
(MonadError QErr m, MonadReader QueryTagsComment m) =>
UserInfo
-> StringifyNumbers
-> SourceConfig 'MSSQL
-> AnnotatedInsert 'MSSQL Void (UnpreparedValue 'MSSQL)
-> m (OnBaseMonad (ExceptT QErr) 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> AnnotatedInsert 'MSSQL Void a
-> f (AnnotatedInsert 'MSSQL Void 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
  OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OnBaseMonad (ExceptT QErr) EncJSON
 -> m (OnBaseMonad (ExceptT QErr) EncJSON))
-> OnBaseMonad (ExceptT QErr) EncJSON
-> m (OnBaseMonad (ExceptT QErr) EncJSON)
forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *).
 (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
  MonadTrace m, MonadError QErr m) =>
 ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
forall (t :: (* -> *) -> * -> *) a.
(forall (m :: * -> *).
 (Functor (t m), MonadIO m, MonadBaseControl IO m, MonadTrace m,
  MonadError QErr m) =>
 t m a)
-> OnBaseMonad t a
OnBaseMonad ((forall (m :: * -> *).
  (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
   MonadTrace m, MonadError QErr m) =>
  ExceptT QErr m EncJSON)
 -> OnBaseMonad (ExceptT QErr) EncJSON)
-> (forall (m :: * -> *).
    (Functor (ExceptT QErr m), MonadIO m, MonadBaseControl IO m,
     MonadTrace m, MonadError QErr m) =>
    ExceptT QErr m EncJSON)
-> OnBaseMonad (ExceptT QErr) EncJSON
forall a b. (a -> b) -> a -> b
$ MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadWrite (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
SourceConfig 'MSSQL
sourceConfig) (TxET QErr m EncJSON -> ExceptT QErr m EncJSON)
-> TxET QErr m EncJSON -> ExceptT QErr m EncJSON
forall a b. (a -> b) -> a -> b
$ TableName
-> Text
-> StringifyNumbers
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr m EncJSON
forall (m :: * -> *).
MonadIO m =>
TableName
-> Text
-> StringifyNumbers
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr m EncJSON
buildInsertTx TableName 'MSSQL
TableName
tableName Text
withAlias StringifyNumbers
stringifyNum AnnotatedInsert 'MSSQL Void Expression
insert QueryTagsComment
queryTags
  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 ::
  (MonadIO m) =>
  TSQL.TableName ->
  Text ->
  Options.StringifyNumbers ->
  AnnotatedInsert 'MSSQL Void Expression ->
  QueryTagsComment ->
  Tx.TxET QErr m EncJSON
buildInsertTx :: forall (m :: * -> *).
MonadIO m =>
TableName
-> Text
-> StringifyNumbers
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr m 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 'MSSQL Expression
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 m ()
forall (m :: * -> *) e.
MonadIO m =>
(MSSQLTxError -> e) -> Query -> TxET e m ()
Tx.unitQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler (Query
createInsertedTempTableQuery Query -> QueryTagsComment -> Query
`withQueryTags` QueryTagsComment
queryTags)

  -- check we have any values to insert, SQLServer doesn't appear to have a
  -- nice syntax for "insert no rows please"
  Bool -> TxET QErr m () -> TxET QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([AnnotatedInsertRow 'MSSQL Expression] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([AnnotatedInsertRow 'MSSQL Expression] -> Bool)
-> [AnnotatedInsertRow 'MSSQL Expression] -> Bool
forall a b. (a -> b) -> a -> b
$ 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)
    (TxET QErr m () -> TxET QErr m ())
-> TxET QErr m () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$
    -- 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 m ()
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 m ()
forall (m :: * -> *).
MonadIO m =>
TableName
-> AnnotatedInsert 'MSSQL Void Expression
-> IfMatched Expression
-> QueryTagsComment
-> TxET QErr m ()
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 m (Text, Int)
forall (m :: * -> *).
MonadIO m =>
StringifyNumbers
-> Text
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr m (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 m ()
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 m () -> TxET QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
checkConditionInt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
    (TxET QErr m () -> TxET QErr m ())
-> TxET QErr m () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> TxET QErr m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
PermissionError Text
"check constraint of an insert/update permission has failed"

  EncJSON -> TxET QErr m EncJSON
forall a. a -> TxET QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> TxET QErr m EncJSON) -> EncJSON -> TxET QErr m 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 ::
  (MonadIO m) =>
  TSQL.TableName ->
  AnnotatedInsert 'MSSQL Void Expression ->
  IfMatched Expression ->
  QueryTagsComment ->
  Tx.TxET QErr m ()
buildUpsertTx :: forall (m :: * -> *).
MonadIO m =>
TableName
-> AnnotatedInsert 'MSSQL Void Expression
-> IfMatched Expression
-> QueryTagsComment
-> TxET QErr m ()
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
-> [(Column 'MSSQL, Expression)]
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]
HashMap.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 a. Eq a => a -> [a] -> 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 m ()
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 m ()
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 <- QueryWithDDL Merge -> Merge
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Merge -> Merge)
-> TxET QErr m (QueryWithDDL Merge) -> TxET QErr m Merge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Merge -> TxET QErr m (QueryWithDDL Merge)
forall (m :: * -> *) a.
MonadError QErr m =>
FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs (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 m ()
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 m ()
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 ::
  (MonadIO m) =>
  Options.StringifyNumbers ->
  Text ->
  AnnotatedInsert 'MSSQL Void Expression ->
  QueryTagsComment ->
  Tx.TxET QErr m (Text, Int)
buildInsertResponseTx :: forall (m :: * -> *).
MonadIO m =>
StringifyNumbers
-> Text
-> AnnotatedInsert 'MSSQL Void Expression
-> QueryTagsComment
-> TxET QErr m (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 <- QueryWithDDL Select -> Select
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Select -> Select)
-> TxET QErr m (QueryWithDDL Select) -> TxET QErr m Select
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Select -> TxET QErr m (QueryWithDDL Select)
forall (m :: * -> *).
MonadError QErr m =>
FromIr Select -> m (QueryWithDDL Select)
runFromIrUseCTEs (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 <- QueryWithDDL Expression -> Expression
forall a. QueryWithDDL a -> a
qwdQuery (QueryWithDDL Expression -> Expression)
-> TxET QErr m (QueryWithDDL Expression) -> TxET QErr m Expression
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FromIr Expression -> TxET QErr m (QueryWithDDL Expression)
forall (m :: * -> *) a.
MonadError QErr m =>
FromIr a -> m (QueryWithDDL a)
runFromIrErrorOnCTEs (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 CTEBody) -> With
With (NonEmpty (Aliased CTEBody) -> With)
-> NonEmpty (Aliased CTEBody) -> With
forall a b. (a -> b) -> a -> b
$ Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Aliased CTEBody -> NonEmpty (Aliased CTEBody))
-> Aliased CTEBody -> NonEmpty (Aliased CTEBody)
forall a b. (a -> b) -> a -> b
$ CTEBody -> Text -> Aliased CTEBody
forall a. a -> Text -> Aliased a
Aliased (Select -> CTEBody
CTESelect 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 m (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)