-- | This module defines the translation functions for insert and upsert
-- mutations.
module Hasura.Backends.MSSQL.FromIr.Insert
  ( fromInsert,
    toMerge,
    toInsertValuesIntoTempTable,
  )
where

import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict.Extended qualified as HM
import Data.HashSet qualified as HS
import Hasura.Backends.MSSQL.FromIr (FromIr)
import Hasura.Backends.MSSQL.FromIr.Constants (tempTableNameInserted, tempTableNameValues)
import Hasura.Backends.MSSQL.FromIr.Expression (fromGBoolExp)
import Hasura.Backends.MSSQL.Instances.Types ()
import Hasura.Backends.MSSQL.Types.Insert (IfMatched (..))
import Hasura.Backends.MSSQL.Types.Internal as TSQL
import Hasura.Prelude
import Hasura.RQL.IR qualified as IR
import Hasura.RQL.Types.Column qualified as IR
import Hasura.SQL.Backend

fromInsert :: IR.AnnotatedInsert 'MSSQL Void Expression -> Insert
fromInsert :: AnnotatedInsert 'MSSQL Void Expression -> Insert
fromInsert IR.AnnotatedInsert {Bool
Maybe NamingCase
Text
MutationOutputG 'MSSQL Void Expression
MultiObjectInsert 'MSSQL Expression
_aiNamingConvention :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> Maybe NamingCase
_aiOutput :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MutationOutputG b r v
_aiData :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiIsSingle :: forall (b :: BackendType) r v. AnnotatedInsert b r v -> Bool
_aiFieldName :: forall (b :: BackendType) r v. AnnotatedInsert b r v -> Text
_aiNamingConvention :: Maybe NamingCase
_aiOutput :: MutationOutputG 'MSSQL Void Expression
_aiData :: MultiObjectInsert 'MSSQL Expression
_aiIsSingle :: Bool
_aiFieldName :: Text
..} =
  let IR.AnnotatedInsertData {[AnnotatedInsertRow 'MSSQL Expression]
[ColumnInfo 'MSSQL]
(AnnBoolExp 'MSSQL Expression,
 Maybe (AnnBoolExp 'MSSQL Expression))
PreSetColsG 'MSSQL Expression
TableName 'MSSQL
BackendInsert 'MSSQL Expression
_aiBackendInsert :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> BackendInsert b v
_aiPresetValues :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> PreSetColsG b v
_aiTableColumns :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> [ColumnInfo b]
_aiCheckCondition :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v
-> (AnnBoolExp b v, Maybe (AnnBoolExp b v))
_aiTableName :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> TableName b
_aiInsertObject :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
_aiBackendInsert :: BackendInsert 'MSSQL Expression
_aiPresetValues :: PreSetColsG 'MSSQL Expression
_aiTableColumns :: [ColumnInfo 'MSSQL]
_aiCheckCondition :: (AnnBoolExp 'MSSQL Expression,
 Maybe (AnnBoolExp 'MSSQL Expression))
_aiTableName :: TableName 'MSSQL
_aiInsertObject :: [AnnotatedInsertRow 'MSSQL Expression]
..} = MultiObjectInsert 'MSSQL Expression
_aiData
      (HashSet (Column 'MSSQL)
insertColumnNames, [HashMap (Column 'MSSQL) Expression]
insertRows) = HashMap (Column 'MSSQL) Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
-> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression])
normalizeInsertRows PreSetColsG 'MSSQL Expression
HashMap (Column 'MSSQL) Expression
_aiPresetValues ([AnnotatedInsertRow 'MSSQL Expression]
 -> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression]))
-> [AnnotatedInsertRow 'MSSQL Expression]
-> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression])
forall a b. (a -> b) -> a -> b
$ [AnnotatedInsertRow 'MSSQL Expression]
_aiInsertObject
      insertValues :: [Values]
insertValues = (HashMap (Column 'MSSQL) Expression -> Values)
-> [HashMap (Column 'MSSQL) Expression] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map ([Expression] -> Values
Values ([Expression] -> Values)
-> (HashMap (Column 'MSSQL) Expression -> [Expression])
-> HashMap (Column 'MSSQL) Expression
-> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (Column 'MSSQL) Expression -> [Expression]
forall k v. HashMap k v -> [v]
HM.elems) [HashMap (Column 'MSSQL) Expression]
insertRows
      allColumnNames :: [Column 'MSSQL]
allColumnNames = (ColumnInfo 'MSSQL -> Column 'MSSQL)
-> [ColumnInfo 'MSSQL] -> [Column 'MSSQL]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo 'MSSQL -> Column 'MSSQL
forall (b :: BackendType). ColumnInfo b -> Column b
IR.ciColumn [ColumnInfo 'MSSQL]
_aiTableColumns
      insertOutput :: Output Inserted
insertOutput = Inserted -> [OutputColumn] -> Output Inserted
forall t. t -> [OutputColumn] -> Output t
Output Inserted
Inserted ([OutputColumn] -> Output Inserted)
-> [OutputColumn] -> Output Inserted
forall a b. (a -> b) -> a -> b
$ (Column 'MSSQL -> OutputColumn)
-> [Column 'MSSQL] -> [OutputColumn]
forall a b. (a -> b) -> [a] -> [b]
map Column 'MSSQL -> OutputColumn
OutputColumn [Column 'MSSQL]
allColumnNames
      tempTable :: TempTable
tempTable = TempTableName -> [Column 'MSSQL] -> TempTable
TempTable TempTableName
tempTableNameInserted [Column 'MSSQL]
allColumnNames
   in TableName
-> [Column 'MSSQL]
-> Output Inserted
-> TempTable
-> [Values]
-> Insert
Insert TableName 'MSSQL
TableName
_aiTableName (HashSet (Column 'MSSQL) -> [Column 'MSSQL]
forall a. HashSet a -> [a]
HS.toList HashSet (Column 'MSSQL)
insertColumnNames) Output Inserted
insertOutput TempTable
tempTable [Values]
insertValues

-- | Normalize a row by adding missing columns with @DEFAULT@ value and sort by
-- column name to make sure all rows are consistent in column values and order.
--
-- Example: A table "author" is defined as:
--
-- > CREATE TABLE author ([id] INTEGER NOT NULL PRIMARY KEY, name TEXT NOT NULL, age INTEGER)
--
-- Consider the following mutation:
--
-- > mutation {
-- >   insert_author(
-- >     objects: [{id: 1, name: "Foo", age: 21}, {id: 2, name: "Bar"}]
-- >   ){
-- >     affected_rows
-- >   }
-- > }
--
-- We consider @DEFAULT@ value for @age@ column which is missing in second
-- insert row.
--
-- The corresponding @INSERT@ statement looks like:
--
-- > INSERT INTO author (id, name, age)
-- >   OUTPUT INSERTED.id
-- >   VALUES (1, 'Foo', 21), (2, 'Bar', DEFAULT)
normalizeInsertRows ::
  HM.HashMap (Column 'MSSQL) Expression ->
  [IR.AnnotatedInsertRow 'MSSQL Expression] ->
  (HashSet (Column 'MSSQL), [HM.HashMap (Column 'MSSQL) Expression])
normalizeInsertRows :: HashMap (Column 'MSSQL) Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
-> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression])
normalizeInsertRows HashMap (Column 'MSSQL) Expression
presets [AnnotatedInsertRow 'MSSQL Expression]
insertRows =
  Expression
-> [HashMap (Column 'MSSQL) Expression]
-> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression])
forall a b.
(Hashable a, Eq a) =>
b -> [HashMap a b] -> (HashSet a, [HashMap a b])
HM.homogenise
    Expression
DefaultExpression
    ((AnnotatedInsertRow 'MSSQL Expression
 -> HashMap (Column 'MSSQL) Expression)
-> [AnnotatedInsertRow 'MSSQL Expression]
-> [HashMap (Column 'MSSQL) Expression]
forall a b. (a -> b) -> [a] -> [b]
map ((HashMap (Column 'MSSQL) Expression
presets HashMap (Column 'MSSQL) Expression
-> HashMap (Column 'MSSQL) Expression
-> HashMap (Column 'MSSQL) Expression
forall a. Semigroup a => a -> a -> a
<>) (HashMap (Column 'MSSQL) Expression
 -> HashMap (Column 'MSSQL) Expression)
-> (AnnotatedInsertRow 'MSSQL Expression
    -> HashMap (Column 'MSSQL) Expression)
-> AnnotatedInsertRow 'MSSQL Expression
-> HashMap (Column 'MSSQL) Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Column 'MSSQL, Expression)] -> HashMap (Column 'MSSQL) Expression
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Column 'MSSQL, Expression)]
 -> HashMap (Column 'MSSQL) Expression)
-> (AnnotatedInsertRow 'MSSQL Expression
    -> [(Column 'MSSQL, Expression)])
-> AnnotatedInsertRow 'MSSQL Expression
-> HashMap (Column 'MSSQL) Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsertRow 'MSSQL Expression
-> [(Column 'MSSQL, Expression)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
IR.getInsertColumns) [AnnotatedInsertRow 'MSSQL Expression]
insertRows)

-- | Construct a MERGE statement from AnnotatedInsert information.
--   A MERGE statement is responsible for actually inserting and/or updating
--   the data in the table.
toMerge ::
  TableName ->
  [IR.AnnotatedInsertRow 'MSSQL Expression] ->
  [IR.ColumnInfo 'MSSQL] ->
  IfMatched Expression ->
  FromIr Merge
toMerge :: TableName
-> [AnnotatedInsertRow 'MSSQL Expression]
-> [ColumnInfo 'MSSQL]
-> IfMatched Expression
-> FromIr Merge
toMerge TableName
tableName [AnnotatedInsertRow 'MSSQL Expression]
insertRows [ColumnInfo 'MSSQL]
allColumns IfMatched {[Column 'MSSQL]
HashMap (Column 'MSSQL) Expression
AnnBoolExp 'MSSQL Expression
_imColumnPresets :: forall v. IfMatched v -> HashMap (Column 'MSSQL) v
_imConditions :: forall v. IfMatched v -> AnnBoolExp 'MSSQL v
_imUpdateColumns :: forall v. IfMatched v -> [Column 'MSSQL]
_imMatchColumns :: forall v. IfMatched v -> [Column 'MSSQL]
_imColumnPresets :: HashMap (Column 'MSSQL) Expression
_imConditions :: AnnBoolExp 'MSSQL Expression
_imUpdateColumns :: [Column 'MSSQL]
_imMatchColumns :: [Column 'MSSQL]
..} = do
  let insertColumnNames :: [Column 'MSSQL]
insertColumnNames =
        HashSet (Column 'MSSQL) -> [Column 'MSSQL]
forall a. HashSet a -> [a]
HS.toList (HashSet (Column 'MSSQL) -> [Column 'MSSQL])
-> HashSet (Column 'MSSQL) -> [Column 'MSSQL]
forall a b. (a -> b) -> a -> b
$
          HashMap (Column 'MSSQL) Expression -> HashSet (Column 'MSSQL)
forall k a. HashMap k a -> HashSet k
HM.keysSet HashMap (Column 'MSSQL) Expression
_imColumnPresets
            HashSet (Column 'MSSQL)
-> HashSet (Column 'MSSQL) -> HashSet (Column 'MSSQL)
forall a. Semigroup a => a -> a -> a
<> [HashSet (Column 'MSSQL)] -> HashSet (Column 'MSSQL)
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
HS.unions ((AnnotatedInsertRow 'MSSQL Expression -> HashSet (Column 'MSSQL))
-> [AnnotatedInsertRow 'MSSQL Expression]
-> [HashSet (Column 'MSSQL)]
forall a b. (a -> b) -> [a] -> [b]
map (HashMap (Column 'MSSQL) Expression -> HashSet (Column 'MSSQL)
forall k a. HashMap k a -> HashSet k
HM.keysSet (HashMap (Column 'MSSQL) Expression -> HashSet (Column 'MSSQL))
-> (AnnotatedInsertRow 'MSSQL Expression
    -> HashMap (Column 'MSSQL) Expression)
-> AnnotatedInsertRow 'MSSQL Expression
-> HashSet (Column 'MSSQL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Column 'MSSQL, Expression)] -> HashMap (Column 'MSSQL) Expression
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Column 'MSSQL, Expression)]
 -> HashMap (Column 'MSSQL) Expression)
-> (AnnotatedInsertRow 'MSSQL Expression
    -> [(Column 'MSSQL, Expression)])
-> AnnotatedInsertRow 'MSSQL Expression
-> HashMap (Column 'MSSQL) Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsertRow 'MSSQL Expression
-> [(Column 'MSSQL, Expression)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
IR.getInsertColumns) [AnnotatedInsertRow 'MSSQL Expression]
insertRows)
      allColumnNames :: [Column 'MSSQL]
allColumnNames = (ColumnInfo 'MSSQL -> Column 'MSSQL)
-> [ColumnInfo 'MSSQL] -> [Column 'MSSQL]
forall a b. (a -> b) -> [a] -> [b]
map ColumnInfo 'MSSQL -> Column 'MSSQL
forall (b :: BackendType). ColumnInfo b -> Column b
IR.ciColumn [ColumnInfo 'MSSQL]
allColumns

  Expression
matchConditions <-
    (ReaderT EntityAlias FromIr Expression
 -> EntityAlias -> FromIr Expression)
-> EntityAlias
-> ReaderT EntityAlias FromIr Expression
-> FromIr Expression
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT EntityAlias FromIr Expression
-> EntityAlias -> FromIr Expression
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Text -> EntityAlias
EntityAlias Text
"target") (ReaderT EntityAlias FromIr Expression -> FromIr Expression)
-> ReaderT EntityAlias FromIr Expression -> FromIr Expression
forall a b. (a -> b) -> a -> b
$ -- the table is aliased as "target" in MERGE sql
      AnnBoolExp 'MSSQL Expression
-> ReaderT EntityAlias FromIr Expression
fromGBoolExp AnnBoolExp 'MSSQL Expression
_imConditions

  Merge -> FromIr Merge
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Merge -> FromIr Merge) -> Merge -> FromIr Merge
forall a b. (a -> b) -> a -> b
$
    Merge :: TableName
-> MergeUsing
-> MergeOn
-> MergeWhenMatched
-> MergeWhenNotMatched
-> Output Inserted
-> TempTable
-> Merge
Merge
      { $sel:mergeTargetTable:Merge :: TableName
mergeTargetTable = TableName
tableName,
        $sel:mergeUsing:Merge :: MergeUsing
mergeUsing = TempTableName -> [Column 'MSSQL] -> MergeUsing
MergeUsing TempTableName
tempTableNameValues [Column 'MSSQL]
insertColumnNames,
        $sel:mergeOn:Merge :: MergeOn
mergeOn = [Column 'MSSQL] -> MergeOn
MergeOn [Column 'MSSQL]
_imMatchColumns,
        $sel:mergeWhenMatched:Merge :: MergeWhenMatched
mergeWhenMatched = [Column 'MSSQL]
-> Expression
-> HashMap (Column 'MSSQL) Expression
-> MergeWhenMatched
MergeWhenMatched [Column 'MSSQL]
_imUpdateColumns Expression
matchConditions HashMap (Column 'MSSQL) Expression
_imColumnPresets,
        $sel:mergeWhenNotMatched:Merge :: MergeWhenNotMatched
mergeWhenNotMatched = [Column 'MSSQL] -> MergeWhenNotMatched
MergeWhenNotMatched [Column 'MSSQL]
insertColumnNames,
        $sel:mergeInsertOutput:Merge :: Output Inserted
mergeInsertOutput = Inserted -> [OutputColumn] -> Output Inserted
forall t. t -> [OutputColumn] -> Output t
Output Inserted
Inserted ([OutputColumn] -> Output Inserted)
-> [OutputColumn] -> Output Inserted
forall a b. (a -> b) -> a -> b
$ (Column 'MSSQL -> OutputColumn)
-> [Column 'MSSQL] -> [OutputColumn]
forall a b. (a -> b) -> [a] -> [b]
map Column 'MSSQL -> OutputColumn
OutputColumn [Column 'MSSQL]
allColumnNames,
        $sel:mergeOutputTempTable:Merge :: TempTable
mergeOutputTempTable = TempTableName -> [Column 'MSSQL] -> TempTable
TempTable TempTableName
tempTableNameInserted [Column 'MSSQL]
allColumnNames
      }

-- | As part of an INSERT/UPSERT process, insert VALUES into a temporary table.
--   The content of the temporary table will later be inserted into the original table
--   using a MERGE statement.
--
--   We insert the values into a temporary table first in order to replace the missing
--   fields with @DEFAULT@ in @normalizeInsertRows@, and we can't do that in a
--   MERGE statement directly.
toInsertValuesIntoTempTable :: TempTableName -> IR.AnnotatedInsert 'MSSQL Void Expression -> InsertValuesIntoTempTable
toInsertValuesIntoTempTable :: TempTableName
-> AnnotatedInsert 'MSSQL Void Expression
-> InsertValuesIntoTempTable
toInsertValuesIntoTempTable TempTableName
tempTable IR.AnnotatedInsert {Bool
Maybe NamingCase
Text
MutationOutputG 'MSSQL Void Expression
MultiObjectInsert 'MSSQL Expression
_aiNamingConvention :: Maybe NamingCase
_aiOutput :: MutationOutputG 'MSSQL Void Expression
_aiData :: MultiObjectInsert 'MSSQL Expression
_aiIsSingle :: Bool
_aiFieldName :: Text
_aiNamingConvention :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> Maybe NamingCase
_aiOutput :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MutationOutputG b r v
_aiData :: forall (b :: BackendType) r v.
AnnotatedInsert b r v -> MultiObjectInsert b v
_aiIsSingle :: forall (b :: BackendType) r v. AnnotatedInsert b r v -> Bool
_aiFieldName :: forall (b :: BackendType) r v. AnnotatedInsert b r v -> Text
..} =
  let IR.AnnotatedInsertData {[AnnotatedInsertRow 'MSSQL Expression]
[ColumnInfo 'MSSQL]
(AnnBoolExp 'MSSQL Expression,
 Maybe (AnnBoolExp 'MSSQL Expression))
PreSetColsG 'MSSQL Expression
TableName 'MSSQL
BackendInsert 'MSSQL Expression
_aiBackendInsert :: BackendInsert 'MSSQL Expression
_aiPresetValues :: PreSetColsG 'MSSQL Expression
_aiTableColumns :: [ColumnInfo 'MSSQL]
_aiCheckCondition :: (AnnBoolExp 'MSSQL Expression,
 Maybe (AnnBoolExp 'MSSQL Expression))
_aiTableName :: TableName 'MSSQL
_aiInsertObject :: [AnnotatedInsertRow 'MSSQL Expression]
_aiBackendInsert :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> BackendInsert b v
_aiPresetValues :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> PreSetColsG b v
_aiTableColumns :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> [ColumnInfo b]
_aiCheckCondition :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v
-> (AnnBoolExp b v, Maybe (AnnBoolExp b v))
_aiTableName :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> TableName b
_aiInsertObject :: forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
..} = MultiObjectInsert 'MSSQL Expression
_aiData
      (HashSet (Column 'MSSQL)
insertColumnNames, [HashMap (Column 'MSSQL) Expression]
insertRows) = HashMap (Column 'MSSQL) Expression
-> [AnnotatedInsertRow 'MSSQL Expression]
-> (HashSet (Column 'MSSQL), [HashMap (Column 'MSSQL) Expression])
normalizeInsertRows PreSetColsG 'MSSQL Expression
HashMap (Column 'MSSQL) Expression
_aiPresetValues [AnnotatedInsertRow 'MSSQL Expression]
_aiInsertObject
      insertValues :: [Values]
insertValues = (HashMap (Column 'MSSQL) Expression -> Values)
-> [HashMap (Column 'MSSQL) Expression] -> [Values]
forall a b. (a -> b) -> [a] -> [b]
map ([Expression] -> Values
Values ([Expression] -> Values)
-> (HashMap (Column 'MSSQL) Expression -> [Expression])
-> HashMap (Column 'MSSQL) Expression
-> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (Column 'MSSQL) Expression -> [Expression]
forall k v. HashMap k v -> [v]
HM.elems) [HashMap (Column 'MSSQL) Expression]
insertRows
   in InsertValuesIntoTempTable :: TempTableName
-> [Column 'MSSQL] -> [Values] -> InsertValuesIntoTempTable
InsertValuesIntoTempTable
        { $sel:ivittTempTableName:InsertValuesIntoTempTable :: TempTableName
ivittTempTableName = TempTableName
tempTable,
          $sel:ivittColumns:InsertValuesIntoTempTable :: [Column 'MSSQL]
ivittColumns = HashSet (Column 'MSSQL) -> [Column 'MSSQL]
forall a. HashSet a -> [a]
HS.toList HashSet (Column 'MSSQL)
insertColumnNames,
          $sel:ivittValues:InsertValuesIntoTempTable :: [Values]
ivittValues = [Values]
insertValues
        }