-- | Postgres Execute Insert
--
-- Translates and executes IR to Postgres-specific SQL.
--
-- See 'Hasura.Backends.Postgres.Instances.Execute'.
module Hasura.Backends.Postgres.Execute.Insert
  ( convertToSQLTransaction,
  )
where

import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.Extended qualified as Map
import Data.List qualified as L
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Text.Extended
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation qualified as PGE
import Hasura.Backends.Postgres.SQL.DML qualified as PG
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Backends.Postgres.Translate.BoolExp qualified as PGT
import Hasura.Backends.Postgres.Translate.Insert qualified as PGT
import Hasura.Backends.Postgres.Translate.Mutation qualified as PGT
import Hasura.Backends.Postgres.Translate.Returning qualified as PGT
import Hasura.Backends.Postgres.Translate.Select (PostgresAnnotatedFieldJSON)
import Hasura.Backends.Postgres.Types.Insert
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.Insert qualified as IR
import Hasura.RQL.IR.Returning qualified as IR
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Relationships.Local
import Hasura.SQL.Backend
import Hasura.Session
import Hasura.Tracing qualified as Tracing

convertToSQLTransaction ::
  forall pgKind m.
  ( MonadTx m,
    MonadIO m,
    Tracing.MonadTrace m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  IR.AnnotatedInsert ('Postgres pgKind) Void PG.SQLExp ->
  UserInfo ->
  Seq.Seq Q.PrepArg ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  m EncJSON
convertToSQLTransaction :: AnnotatedInsert ('Postgres pgKind) Void SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
convertToSQLTransaction (IR.AnnotatedInsert Text
fieldName Bool
isSingle MultiObjectInsert ('Postgres pgKind) SQLExp
annIns MutationOutputG ('Postgres pgKind) Void SQLExp
mutationOutput Maybe NamingCase
_tCase) UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase =
  if [AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Bool)
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Bool
forall a b. (a -> b) -> a -> b
$ MultiObjectInsert ('Postgres pgKind) SQLExp
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
IR._aiInsertObject MultiObjectInsert ('Postgres pgKind) SQLExp
annIns
    then EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MutationOutput ('Postgres pgKind) -> EncJSON
forall (backend :: BackendType). MutationOutput backend -> EncJSON
IR.buildEmptyMutResp MutationOutput ('Postgres pgKind)
MutationOutputG ('Postgres pgKind) Void SQLExp
mutationOutput
    else
      [Text] -> m EncJSON -> m EncJSON
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadError QErr m, Functor t) =>
t Text -> m a -> m a
withPaths [Text
"selectionSet", Text
fieldName, Text
"args", Text
suffix] (m EncJSON -> m EncJSON) -> m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
        MultiObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> MutationOutput ('Postgres pgKind)
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
MultiObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> MutationOutput ('Postgres pgKind)
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
insertMultipleObjects MultiObjectInsert ('Postgres pgKind) SQLExp
annIns HashMap PGCol SQLExp
forall a. Monoid a => a
mempty UserInfo
userInfo MutationOutput ('Postgres pgKind)
MutationOutputG ('Postgres pgKind) Void SQLExp
mutationOutput Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase
  where
    withPaths :: t Text -> m a -> m a
withPaths t Text
p m a
x = ((m a -> m a) -> m a -> m a) -> m a -> t (m a -> m a) -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
($) m a
x (t (m a -> m a) -> m a) -> t (m a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ Text -> m a -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (Text -> m a -> m a) -> t Text -> t (m a -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Text
p
    suffix :: Text
suffix = Text -> Text -> Bool -> Text
forall a. a -> a -> Bool -> a
bool Text
"objects" Text
"object" Bool
isSingle

insertMultipleObjects ::
  forall pgKind m.
  ( MonadTx m,
    MonadIO m,
    Tracing.MonadTrace m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  IR.MultiObjectInsert ('Postgres pgKind) PG.SQLExp ->
  Map.HashMap PGCol PG.SQLExp ->
  UserInfo ->
  IR.MutationOutput ('Postgres pgKind) ->
  Seq.Seq Q.PrepArg ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  m EncJSON
insertMultipleObjects :: MultiObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> MutationOutput ('Postgres pgKind)
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
insertMultipleObjects MultiObjectInsert ('Postgres pgKind) SQLExp
multiObjIns HashMap PGCol SQLExp
additionalColumns UserInfo
userInfo MutationOutput ('Postgres pgKind)
mutationOutput Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase =
  m EncJSON -> m EncJSON -> Bool -> m EncJSON
forall a. a -> a -> Bool -> a
bool m EncJSON
withoutRelsInsert m EncJSON
withRelsInsert Bool
anyRelsToInsert
  where
    IR.AnnotatedInsertData [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs TableName ('Postgres pgKind)
table (AnnBoolExp ('Postgres pgKind) SQLExp,
 Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
checkCondition [ColumnInfo ('Postgres pgKind)]
columnInfos PreSetColsG ('Postgres pgKind) SQLExp
presetRow (BackendInsert conflictClause) = MultiObjectInsert ('Postgres pgKind) SQLExp
multiObjIns
    allInsObjRels :: [ObjectRelationInsert ('Postgres pgKind) SQLExp]
allInsObjRels = (AnnotatedInsertRow ('Postgres pgKind) SQLExp
 -> [ObjectRelationInsert ('Postgres pgKind) SQLExp])
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> [ObjectRelationInsert ('Postgres pgKind) SQLExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> [ObjectRelationInsert ('Postgres pgKind) SQLExp]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [ObjectRelationInsert b v]
IR.getInsertObjectRelationships [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs
    allInsArrRels :: [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allInsArrRels = (AnnotatedInsertRow ('Postgres pgKind) SQLExp
 -> [ArrayRelationInsert ('Postgres pgKind) SQLExp])
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [ArrayRelationInsert b v]
IR.getInsertArrayRelationships [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs
    anyRelsToInsert :: Bool
anyRelsToInsert = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ArrayRelationInsert ('Postgres pgKind) SQLExp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allInsArrRels Bool -> Bool -> Bool
&& [ObjectRelationInsert ('Postgres pgKind) SQLExp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ObjectRelationInsert ('Postgres pgKind) SQLExp]
allInsObjRels

    withoutRelsInsert :: m EncJSON
withoutRelsInsert = do
      [[(PGCol, SQLExp)]] -> ([(PGCol, SQLExp)] -> m ()) -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(QErrM m, Foldable t) =>
t a -> (a -> m b) -> m ()
indexedForM_ (AnnotatedInsertRow ('Postgres pgKind) SQLExp -> [(PGCol, SQLExp)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
IR.getInsertColumns (AnnotatedInsertRow ('Postgres pgKind) SQLExp -> [(PGCol, SQLExp)])
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> [[(PGCol, SQLExp)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs) \[(PGCol, SQLExp)]
column ->
        [PGCol] -> [RelInfo ('Postgres Any)] -> [PGCol] -> m ()
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
[PGCol] -> [RelInfo ('Postgres pgKind)] -> [PGCol] -> m ()
validateInsert (((PGCol, SQLExp) -> PGCol) -> [(PGCol, SQLExp)] -> [PGCol]
forall a b. (a -> b) -> [a] -> [b]
map (PGCol, SQLExp) -> PGCol
forall a b. (a, b) -> a
fst [(PGCol, SQLExp)]
column) [] (HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys HashMap PGCol SQLExp
additionalColumns)
      let insObjRows :: [HashMap PGCol SQLExp]
insObjRows = [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(PGCol, SQLExp)] -> HashMap PGCol SQLExp)
-> (AnnotatedInsertRow ('Postgres pgKind) SQLExp
    -> [(PGCol, SQLExp)])
-> AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotatedInsertRow ('Postgres pgKind) SQLExp -> [(PGCol, SQLExp)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
IR.getInsertColumns (AnnotatedInsertRow ('Postgres pgKind) SQLExp
 -> HashMap PGCol SQLExp)
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> [HashMap PGCol SQLExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs
          (HashSet PGCol
columnNames, [HashMap PGCol SQLExp]
insertRows) = SQLExp
-> [HashMap PGCol SQLExp]
-> (HashSet PGCol, [HashMap PGCol SQLExp])
forall a b.
(Hashable a, Eq a) =>
b -> [HashMap a b] -> (HashSet a, [HashMap a b])
Map.homogenise SQLExp
PG.columnDefaultValue ([HashMap PGCol SQLExp] -> (HashSet PGCol, [HashMap PGCol SQLExp]))
-> [HashMap PGCol SQLExp]
-> (HashSet PGCol, [HashMap PGCol SQLExp])
forall a b. (a -> b) -> a -> b
$ (HashMap PGCol SQLExp -> HashMap PGCol SQLExp)
-> [HashMap PGCol SQLExp] -> [HashMap PGCol SQLExp]
forall a b. (a -> b) -> [a] -> [b]
map ((PreSetColsG ('Postgres pgKind) SQLExp
HashMap PGCol SQLExp
presetRow HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall a. Semigroup a => a -> a -> a
<> HashMap PGCol SQLExp
additionalColumns) HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall a. Semigroup a => a -> a -> a
<>) [HashMap PGCol SQLExp]
insObjRows
          insertQuery :: InsertQueryP1 ('Postgres pgKind)
insertQuery =
            TableName ('Postgres pgKind)
-> [Column ('Postgres pgKind)]
-> [[SQLExpression ('Postgres pgKind)]]
-> Maybe
     (OnConflictClause
        ('Postgres pgKind) (SQLExpression ('Postgres pgKind)))
-> (AnnBoolExpSQL ('Postgres pgKind),
    Maybe (AnnBoolExpSQL ('Postgres pgKind)))
-> MutationOutput ('Postgres pgKind)
-> [ColumnInfo ('Postgres pgKind)]
-> InsertQueryP1 ('Postgres pgKind)
forall (b :: BackendType).
TableName b
-> [Column b]
-> [[SQLExpression b]]
-> Maybe (OnConflictClause b (SQLExpression b))
-> (AnnBoolExpSQL b, Maybe (AnnBoolExpSQL b))
-> MutationOutput b
-> [ColumnInfo b]
-> InsertQueryP1 b
IR.InsertQueryP1
              TableName ('Postgres pgKind)
table
              (HashSet PGCol -> [PGCol]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet PGCol
columnNames)
              ((HashMap PGCol SQLExp -> [SQLExp])
-> [HashMap PGCol SQLExp] -> [[SQLExp]]
forall a b. (a -> b) -> [a] -> [b]
map HashMap PGCol SQLExp -> [SQLExp]
forall k v. HashMap k v -> [v]
Map.elems [HashMap PGCol SQLExp]
insertRows)
              Maybe
  (OnConflictClause
     ('Postgres pgKind) (SQLExpression ('Postgres pgKind)))
Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
conflictClause
              (AnnBoolExpSQL ('Postgres pgKind),
 Maybe (AnnBoolExpSQL ('Postgres pgKind)))
(AnnBoolExp ('Postgres pgKind) SQLExp,
 Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
checkCondition
              MutationOutput ('Postgres pgKind)
mutationOutput
              [ColumnInfo ('Postgres pgKind)]
columnInfos
          rowCount :: Text
rowCount = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text)
-> ([AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Int)
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Text)
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp] -> Text
forall a b. (a -> b) -> a -> b
$ MultiObjectInsert ('Postgres pgKind) SQLExp
-> [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
IR._aiInsertObject MultiObjectInsert ('Postgres pgKind) SQLExp
multiObjIns
      Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace (Text
"Insert (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedObject TableName -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText TableName ('Postgres pgKind)
QualifiedObject TableName
table) do
        TracingMetadata -> m ()
forall (m :: * -> *). MonadTrace m => TracingMetadata -> m ()
Tracing.attachMetadata [(Text
"count", Text
rowCount)]
        StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (InsertQueryP1 ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
StringifyNumbers
-> Maybe NamingCase
-> UserInfo
-> (InsertQueryP1 ('Postgres pgKind), Seq PrepArg)
-> m EncJSON
PGE.execInsertQuery StringifyNumbers
stringifyNum Maybe NamingCase
tCase UserInfo
userInfo (InsertQueryP1 ('Postgres pgKind)
insertQuery, Seq PrepArg
planVars)

    withRelsInsert :: m EncJSON
withRelsInsert = do
      [(Int, Maybe (HashMap PGCol TxtEncodedVal))]
insertRequests <- [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
-> (AnnotatedInsertRow ('Postgres pgKind) SQLExp
    -> m (Int, Maybe (HashMap PGCol TxtEncodedVal)))
-> m [(Int, Maybe (HashMap PGCol TxtEncodedVal))]
forall (m :: * -> *) a b. QErrM m => [a] -> (a -> m b) -> m [b]
indexedForM [AnnotatedInsertRow ('Postgres pgKind) SQLExp]
insObjs \AnnotatedInsertRow ('Postgres pgKind) SQLExp
obj -> do
        let singleObj :: AnnotatedInsertData ('Postgres pgKind) Single SQLExp
singleObj = Single (AnnotatedInsertRow ('Postgres pgKind) SQLExp)
-> TableName ('Postgres pgKind)
-> (AnnBoolExp ('Postgres pgKind) SQLExp,
    Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
-> [ColumnInfo ('Postgres pgKind)]
-> PreSetColsG ('Postgres pgKind) SQLExp
-> BackendInsert ('Postgres pgKind) SQLExp
-> AnnotatedInsertData ('Postgres pgKind) Single SQLExp
forall (b :: BackendType) (f :: * -> *) v.
f (AnnotatedInsertRow b v)
-> TableName b
-> (AnnBoolExp b v, Maybe (AnnBoolExp b v))
-> [ColumnInfo b]
-> PreSetColsG b v
-> BackendInsert b v
-> AnnotatedInsertData b f v
IR.AnnotatedInsertData (AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> Single (AnnotatedInsertRow ('Postgres pgKind) SQLExp)
forall a. a -> Single a
IR.Single AnnotatedInsertRow ('Postgres pgKind) SQLExp
obj) TableName ('Postgres pgKind)
table (AnnBoolExp ('Postgres pgKind) SQLExp,
 Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
checkCondition [ColumnInfo ('Postgres pgKind)]
columnInfos PreSetColsG ('Postgres pgKind) SQLExp
presetRow (Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BackendInsert pgKind SQLExp
forall (pgKind :: PostgresKind) v.
Maybe (OnConflictClause ('Postgres pgKind) v)
-> BackendInsert pgKind v
BackendInsert Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
conflictClause)
        AnnotatedInsertData ('Postgres pgKind) Single SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
SingleObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
insertObject AnnotatedInsertData ('Postgres pgKind) Single SQLExp
singleObj HashMap PGCol SQLExp
additionalColumns UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase
      let affectedRows :: Int
affectedRows = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, Maybe (HashMap PGCol TxtEncodedVal)) -> Int)
-> [(Int, Maybe (HashMap PGCol TxtEncodedVal))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Maybe (HashMap PGCol TxtEncodedVal)) -> Int
forall a b. (a, b) -> a
fst [(Int, Maybe (HashMap PGCol TxtEncodedVal))]
insertRequests
          columnValues :: [HashMap PGCol TxtEncodedVal]
columnValues = ((Int, Maybe (HashMap PGCol TxtEncodedVal))
 -> Maybe (HashMap PGCol TxtEncodedVal))
-> [(Int, Maybe (HashMap PGCol TxtEncodedVal))]
-> [HashMap PGCol TxtEncodedVal]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Int, Maybe (HashMap PGCol TxtEncodedVal))
-> Maybe (HashMap PGCol TxtEncodedVal)
forall a b. (a, b) -> b
snd [(Int, Maybe (HashMap PGCol TxtEncodedVal))]
insertRequests
      Select
selectExpr <- QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m Select
forall (pgKind :: PostgresKind) (m :: * -> *).
MonadError QErr m =>
QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m Select
PGT.mkSelectExpFromColumnValues TableName ('Postgres pgKind)
QualifiedObject TableName
table [ColumnInfo ('Postgres pgKind)]
columnInfos [ColumnValues ('Postgres pgKind) TxtEncodedVal]
[HashMap PGCol TxtEncodedVal]
columnValues
      QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> Maybe Int
-> MutationCTE
-> MutationOutput ('Postgres pgKind)
-> StringifyNumbers
-> Maybe NamingCase
-> [PrepArg]
-> m EncJSON
PGE.executeMutationOutputQuery
        TableName ('Postgres pgKind)
QualifiedObject TableName
table
        [ColumnInfo ('Postgres pgKind)]
columnInfos
        (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
affectedRows)
        (Select -> MutationCTE
PGT.MCSelectValues Select
selectExpr)
        MutationOutput ('Postgres pgKind)
mutationOutput
        StringifyNumbers
stringifyNum
        Maybe NamingCase
tCase
        []

insertObject ::
  forall pgKind m.
  ( MonadTx m,
    MonadIO m,
    Tracing.MonadTrace m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  IR.SingleObjectInsert ('Postgres pgKind) PG.SQLExp ->
  HashMap PGCol PG.SQLExp ->
  UserInfo ->
  Seq.Seq Q.PrepArg ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
insertObject :: SingleObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
insertObject SingleObjectInsert ('Postgres pgKind) SQLExp
singleObjIns HashMap PGCol SQLExp
additionalColumns UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase = Text
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace (Text
"Insert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QualifiedObject TableName -> Text
forall a. ToTxt a => QualifiedObject a -> Text
qualifiedObjectToText TableName ('Postgres pgKind)
QualifiedObject TableName
table) do
  [PGCol] -> [RelInfo ('Postgres pgKind)] -> [PGCol] -> m ()
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
[PGCol] -> [RelInfo ('Postgres pgKind)] -> [PGCol] -> m ()
validateInsert (HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys HashMap PGCol SQLExp
columns) ((RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
 -> RelInfo ('Postgres pgKind))
-> [RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
-> [RelInfo ('Postgres pgKind)]
forall a b. (a -> b) -> [a] -> [b]
map RelationInsert
  ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> RelInfo ('Postgres pgKind)
forall (b :: BackendType) a. RelationInsert b a -> RelInfo b
IR._riRelationInfo [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
objectRels) (HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys HashMap PGCol SQLExp
additionalColumns)

  -- insert all object relations and fetch this insert dependent column values
  [(Int, [(PGCol, SQLExp)])]
objInsRes <- [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
-> (RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
    -> m (Int, [(PGCol, SQLExp)]))
-> m [(Int, [(PGCol, SQLExp)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
beforeInsert ((RelationInsert
    ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
  -> m (Int, [(PGCol, SQLExp)]))
 -> m [(Int, [(PGCol, SQLExp)])])
-> (RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
    -> m (Int, [(PGCol, SQLExp)]))
-> m [(Int, [(PGCol, SQLExp)])]
forall a b. (a -> b) -> a -> b
$ Seq PrepArg
-> UserInfo
-> StringifyNumbers
-> Maybe NamingCase
-> RelationInsert
     ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> m (Int, [(PGCol, SQLExp)])
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
Seq PrepArg
-> UserInfo
-> StringifyNumbers
-> Maybe NamingCase
-> ObjectRelationInsert ('Postgres pgKind) SQLExp
-> m (Int, [(PGCol, SQLExp)])
insertObjRel Seq PrepArg
planVars UserInfo
userInfo StringifyNumbers
stringifyNum Maybe NamingCase
tCase

  -- prepare final insert columns
  let objRelAffRows :: Int
objRelAffRows = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, [(PGCol, SQLExp)]) -> Int)
-> [(Int, [(PGCol, SQLExp)])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(PGCol, SQLExp)]) -> Int
forall a b. (a, b) -> a
fst [(Int, [(PGCol, SQLExp)])]
objInsRes
      objRelDeterminedCols :: HashMap PGCol SQLExp
objRelDeterminedCols = [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(PGCol, SQLExp)] -> HashMap PGCol SQLExp)
-> [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall a b. (a -> b) -> a -> b
$ ((Int, [(PGCol, SQLExp)]) -> [(PGCol, SQLExp)])
-> [(Int, [(PGCol, SQLExp)])] -> [(PGCol, SQLExp)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(PGCol, SQLExp)]) -> [(PGCol, SQLExp)]
forall a b. (a, b) -> b
snd [(Int, [(PGCol, SQLExp)])]
objInsRes
      finalInsCols :: HashMap PGCol SQLExp
finalInsCols = PreSetColsG ('Postgres pgKind) SQLExp
HashMap PGCol SQLExp
presetValues HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall a. Semigroup a => a -> a -> a
<> HashMap PGCol SQLExp
columns HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall a. Semigroup a => a -> a -> a
<> HashMap PGCol SQLExp
objRelDeterminedCols HashMap PGCol SQLExp
-> HashMap PGCol SQLExp -> HashMap PGCol SQLExp
forall a. Semigroup a => a -> a -> a
<> HashMap PGCol SQLExp
additionalColumns

  let cte :: TopLevelCTE
cte = QualifiedObject TableName
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> HashMap PGCol SQLExp
-> (AnnBoolExpSQL ('Postgres pgKind),
    Maybe (AnnBoolExpSQL ('Postgres pgKind)))
-> TopLevelCTE
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
QualifiedObject TableName
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> HashMap PGCol SQLExp
-> (AnnBoolExpSQL ('Postgres pgKind),
    Maybe (AnnBoolExpSQL ('Postgres pgKind)))
-> TopLevelCTE
mkInsertQ TableName ('Postgres pgKind)
QualifiedObject TableName
table Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
onConflict HashMap PGCol SQLExp
finalInsCols (AnnBoolExpSQL ('Postgres pgKind),
 Maybe (AnnBoolExpSQL ('Postgres pgKind)))
(AnnBoolExp ('Postgres pgKind) SQLExp,
 Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
checkCond

  PGE.MutateResp Int
affRows [ColumnValues ('Postgres pgKind) TxtEncodedVal]
colVals <-
    TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> m (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> m a
liftTx (TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
 -> m (MutateResp ('Postgres pgKind) TxtEncodedVal))
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
-> m (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall a b. (a -> b) -> a -> b
$
      QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> (MutationCTE, Seq PrepArg)
-> StringifyNumbers
-> Maybe NamingCase
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
forall (pgKind :: PostgresKind).
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
QualifiedObject TableName
-> [ColumnInfo ('Postgres pgKind)]
-> (MutationCTE, Seq PrepArg)
-> StringifyNumbers
-> Maybe NamingCase
-> TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
PGE.mutateAndFetchCols @pgKind TableName ('Postgres pgKind)
QualifiedObject TableName
table [ColumnInfo ('Postgres pgKind)]
allColumns (TopLevelCTE -> MutationCTE
PGT.MCCheckConstraint TopLevelCTE
cte, Seq PrepArg
planVars) StringifyNumbers
stringifyNum Maybe NamingCase
tCase
  Maybe (HashMap PGCol TxtEncodedVal)
colValM <- [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m (Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
asSingleObject [ColumnValues ('Postgres pgKind) TxtEncodedVal]
colVals

  Int
arrRelAffRows <- m Int -> m Int -> Bool -> m Int
forall a. a -> a -> Bool -> a
bool (Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal) -> m Int
withArrRels Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal)
Maybe (HashMap PGCol TxtEncodedVal)
colValM) (Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) (Bool -> m Int) -> Bool -> m Int
forall a b. (a -> b) -> a -> b
$ [ArrayRelationInsert ('Postgres pgKind) SQLExp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allAfterInsertRels
  let totAffRows :: Int
totAffRows = Int
objRelAffRows Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
affRows Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arrRelAffRows

  (Int, Maybe (HashMap PGCol TxtEncodedVal))
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
totAffRows, Maybe (HashMap PGCol TxtEncodedVal)
colValM)
  where
    IR.AnnotatedInsertData (IR.Single AnnotatedInsertRow ('Postgres pgKind) SQLExp
annObj) TableName ('Postgres pgKind)
table (AnnBoolExp ('Postgres pgKind) SQLExp,
 Maybe (AnnBoolExp ('Postgres pgKind) SQLExp))
checkCond [ColumnInfo ('Postgres pgKind)]
allColumns PreSetColsG ('Postgres pgKind) SQLExp
presetValues (BackendInsert onConflict) = SingleObjectInsert ('Postgres pgKind) SQLExp
singleObjIns
    columns :: HashMap PGCol SQLExp
columns = [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(PGCol, SQLExp)] -> HashMap PGCol SQLExp)
-> [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall a b. (a -> b) -> a -> b
$ AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> [(Column ('Postgres pgKind), SQLExp)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [(Column b, v)]
IR.getInsertColumns AnnotatedInsertRow ('Postgres pgKind) SQLExp
annObj
    objectRels :: [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
objectRels = AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> [RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [ObjectRelationInsert b v]
IR.getInsertObjectRelationships AnnotatedInsertRow ('Postgres pgKind) SQLExp
annObj
    arrayRels :: [ArrayRelationInsert ('Postgres pgKind) SQLExp]
arrayRels = AnnotatedInsertRow ('Postgres pgKind) SQLExp
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
forall (b :: BackendType) v.
AnnotatedInsertRow b v -> [ArrayRelationInsert b v]
IR.getInsertArrayRelationships AnnotatedInsertRow ('Postgres pgKind) SQLExp
annObj

    afterInsert, beforeInsert :: [IR.ObjectRelationInsert ('Postgres pgKind) PG.SQLExp]
    ([RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
afterInsert, [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
beforeInsert) =
      (RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
 -> Bool)
-> [RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
-> ([RelationInsert
       ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)],
    [RelationInsert
       ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((InsertOrder -> InsertOrder -> Bool
forall a. Eq a => a -> a -> Bool
== InsertOrder
AfterParent) (InsertOrder -> Bool)
-> (RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
    -> InsertOrder)
-> RelationInsert
     ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelInfo ('Postgres pgKind) -> InsertOrder
forall (b :: BackendType). RelInfo b -> InsertOrder
riInsertOrder (RelInfo ('Postgres pgKind) -> InsertOrder)
-> (RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
    -> RelInfo ('Postgres pgKind))
-> RelationInsert
     ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> InsertOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelationInsert
  ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> RelInfo ('Postgres pgKind)
forall (b :: BackendType) a. RelationInsert b a -> RelInfo b
IR._riRelationInfo) [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
objectRels

    allAfterInsertRels :: [IR.ArrayRelationInsert ('Postgres pgKind) PG.SQLExp]
    allAfterInsertRels :: [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allAfterInsertRels = [ArrayRelationInsert ('Postgres pgKind) SQLExp]
arrayRels [ArrayRelationInsert ('Postgres pgKind) SQLExp]
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
forall a. Semigroup a => a -> a -> a
<> (RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
 -> ArrayRelationInsert ('Postgres pgKind) SQLExp)
-> [RelationInsert
      ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp]
forall a b. (a -> b) -> [a] -> [b]
map RelationInsert
  ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
forall a (b :: BackendType).
ObjectRelationInsert b a -> ArrayRelationInsert b a
objToArr [RelationInsert
   ('Postgres pgKind) (SingleObjectInsert ('Postgres pgKind) SQLExp)]
afterInsert

    afterInsertDepCols :: [ColumnInfo ('Postgres pgKind)]
    afterInsertDepCols :: [ColumnInfo ('Postgres pgKind)]
afterInsertDepCols =
      ([PGCol]
 -> [ColumnInfo ('Postgres pgKind)]
 -> [ColumnInfo ('Postgres pgKind)])
-> [ColumnInfo ('Postgres pgKind)]
-> [PGCol]
-> [ColumnInfo ('Postgres pgKind)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Backend ('Postgres pgKind) =>
[Column ('Postgres pgKind)]
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType).
Backend b =>
[Column b] -> [ColumnInfo b] -> [ColumnInfo b]
getColInfos @('Postgres pgKind)) [ColumnInfo ('Postgres pgKind)]
allColumns ([PGCol] -> [ColumnInfo ('Postgres pgKind)])
-> [PGCol] -> [ColumnInfo ('Postgres pgKind)]
forall a b. (a -> b) -> a -> b
$
        (ArrayRelationInsert ('Postgres pgKind) SQLExp -> [PGCol])
-> [ArrayRelationInsert ('Postgres pgKind) SQLExp] -> [PGCol]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HashMap PGCol PGCol -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys (HashMap PGCol PGCol -> [PGCol])
-> (ArrayRelationInsert ('Postgres pgKind) SQLExp
    -> HashMap PGCol PGCol)
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
-> [PGCol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelInfo ('Postgres pgKind) -> HashMap PGCol PGCol
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping (RelInfo ('Postgres pgKind) -> HashMap PGCol PGCol)
-> (ArrayRelationInsert ('Postgres pgKind) SQLExp
    -> RelInfo ('Postgres pgKind))
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol PGCol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayRelationInsert ('Postgres pgKind) SQLExp
-> RelInfo ('Postgres pgKind)
forall (b :: BackendType) a. RelationInsert b a -> RelInfo b
IR._riRelationInfo) [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allAfterInsertRels

    objToArr :: forall a b. IR.ObjectRelationInsert b a -> IR.ArrayRelationInsert b a
    objToArr :: ObjectRelationInsert b a -> ArrayRelationInsert b a
objToArr IR.RelationInsert {RelInfo b
SingleObjectInsert b a
_riInsertData :: forall (b :: BackendType) a. RelationInsert b a -> a
_riRelationInfo :: RelInfo b
_riInsertData :: SingleObjectInsert b a
_riRelationInfo :: forall (b :: BackendType) a. RelationInsert b a -> RelInfo b
..} = MultiObjectInsert b a -> RelInfo b -> ArrayRelationInsert b a
forall (b :: BackendType) a. a -> RelInfo b -> RelationInsert b a
IR.RelationInsert (SingleObjectInsert b a -> MultiObjectInsert b a
forall a (b :: BackendType).
SingleObjectInsert b a -> MultiObjectInsert b a
singleToMulti SingleObjectInsert b a
_riInsertData) RelInfo b
_riRelationInfo

    singleToMulti :: forall a b. IR.SingleObjectInsert b a -> IR.MultiObjectInsert b a
    singleToMulti :: SingleObjectInsert b a -> MultiObjectInsert b a
singleToMulti SingleObjectInsert b a
annIns = SingleObjectInsert b a
annIns {_aiInsertObject :: [AnnotatedInsertRow b a]
IR._aiInsertObject = [Single (AnnotatedInsertRow b a) -> AnnotatedInsertRow b a
forall a. Single a -> a
IR.unSingle (Single (AnnotatedInsertRow b a) -> AnnotatedInsertRow b a)
-> Single (AnnotatedInsertRow b a) -> AnnotatedInsertRow b a
forall a b. (a -> b) -> a -> b
$ SingleObjectInsert b a -> Single (AnnotatedInsertRow b a)
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> f (AnnotatedInsertRow b v)
IR._aiInsertObject SingleObjectInsert b a
annIns]}

    withArrRels ::
      Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal) ->
      m Int
    withArrRels :: Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal) -> m Int
withArrRels Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal)
colValM = do
      HashMap PGCol TxtEncodedVal
colVal <- Maybe (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal)
Maybe (HashMap PGCol TxtEncodedVal)
colValM (m (HashMap PGCol TxtEncodedVal)
 -> m (HashMap PGCol TxtEncodedVal))
-> m (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (HashMap PGCol TxtEncodedVal)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
cannotInsArrRelErr
      [(PGCol, SQLExp)]
afterInsertDepColsWithVal <- ColumnValues ('Postgres pgKind) TxtEncodedVal
-> [ColumnInfo ('Postgres pgKind)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
ColumnValues ('Postgres pgKind) TxtEncodedVal
-> [ColumnInfo ('Postgres pgKind)] -> m [(PGCol, SQLExp)]
fetchFromColVals ColumnValues ('Postgres pgKind) TxtEncodedVal
HashMap PGCol TxtEncodedVal
colVal [ColumnInfo ('Postgres pgKind)]
afterInsertDepCols
      [Int]
arrInsARows <-
        [ArrayRelationInsert ('Postgres pgKind) SQLExp]
-> (ArrayRelationInsert ('Postgres pgKind) SQLExp -> m Int)
-> m [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ArrayRelationInsert ('Postgres pgKind) SQLExp]
allAfterInsertRels ((ArrayRelationInsert ('Postgres pgKind) SQLExp -> m Int)
 -> m [Int])
-> (ArrayRelationInsert ('Postgres pgKind) SQLExp -> m Int)
-> m [Int]
forall a b. (a -> b) -> a -> b
$
          [(PGCol, SQLExp)]
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
-> m Int
forall (m :: * -> *) (pgKind :: PostgresKind).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
[(PGCol, SQLExp)]
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
-> m Int
insertArrRel [(PGCol, SQLExp)]
afterInsertDepColsWithVal UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase
      Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
arrInsARows

    asSingleObject ::
      [ColumnValues ('Postgres pgKind) TxtEncodedVal] ->
      m (Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
    asSingleObject :: [ColumnValues ('Postgres pgKind) TxtEncodedVal]
-> m (Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
asSingleObject = \case
      [] -> Maybe (HashMap PGCol TxtEncodedVal)
-> m (Maybe (HashMap PGCol TxtEncodedVal))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HashMap PGCol TxtEncodedVal)
forall a. Maybe a
Nothing
      [ColumnValues ('Postgres pgKind) TxtEncodedVal
r] -> Maybe (HashMap PGCol TxtEncodedVal)
-> m (Maybe (HashMap PGCol TxtEncodedVal))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap PGCol TxtEncodedVal)
 -> m (Maybe (HashMap PGCol TxtEncodedVal)))
-> Maybe (HashMap PGCol TxtEncodedVal)
-> m (Maybe (HashMap PGCol TxtEncodedVal))
forall a b. (a -> b) -> a -> b
$ HashMap PGCol TxtEncodedVal -> Maybe (HashMap PGCol TxtEncodedVal)
forall a. a -> Maybe a
Just ColumnValues ('Postgres pgKind) TxtEncodedVal
HashMap PGCol TxtEncodedVal
r
      [ColumnValues ('Postgres pgKind) TxtEncodedVal]
_ -> Text -> m (Maybe (HashMap PGCol TxtEncodedVal))
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"more than one row returned"

    cannotInsArrRelErr :: Text
    cannotInsArrRelErr :: Text
cannotInsArrRelErr =
      Text
"cannot proceed to insert array relations since insert to table "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName ('Postgres pgKind)
QualifiedObject TableName
table QualifiedObject TableName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" affects zero rows"

insertObjRel ::
  forall pgKind m.
  ( MonadTx m,
    MonadIO m,
    Tracing.MonadTrace m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  Seq.Seq Q.PrepArg ->
  UserInfo ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  IR.ObjectRelationInsert ('Postgres pgKind) PG.SQLExp ->
  m (Int, [(PGCol, PG.SQLExp)])
insertObjRel :: Seq PrepArg
-> UserInfo
-> StringifyNumbers
-> Maybe NamingCase
-> ObjectRelationInsert ('Postgres pgKind) SQLExp
-> m (Int, [(PGCol, SQLExp)])
insertObjRel Seq PrepArg
planVars UserInfo
userInfo StringifyNumbers
stringifyNum Maybe NamingCase
tCase ObjectRelationInsert ('Postgres pgKind) SQLExp
objRelIns =
  Text -> m (Int, [(PGCol, SQLExp)]) -> m (Int, [(PGCol, SQLExp)])
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (RelName -> Text
relNameToTxt RelName
relName) (m (Int, [(PGCol, SQLExp)]) -> m (Int, [(PGCol, SQLExp)]))
-> m (Int, [(PGCol, SQLExp)]) -> m (Int, [(PGCol, SQLExp)])
forall a b. (a -> b) -> a -> b
$ do
    (Int
affRows, Maybe (HashMap PGCol TxtEncodedVal)
colValM) <- Text
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"data" (m (Int, Maybe (HashMap PGCol TxtEncodedVal))
 -> m (Int, Maybe (HashMap PGCol TxtEncodedVal)))
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
-> m (Int, Maybe (HashMap PGCol TxtEncodedVal))
forall a b. (a -> b) -> a -> b
$ SingleObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
SingleObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
insertObject SingleObjectInsert ('Postgres pgKind) SQLExp
singleObjIns HashMap PGCol SQLExp
forall a. Monoid a => a
mempty UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase
    HashMap PGCol TxtEncodedVal
colVal <- Maybe (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe (HashMap PGCol TxtEncodedVal)
colValM (m (HashMap PGCol TxtEncodedVal)
 -> m (HashMap PGCol TxtEncodedVal))
-> m (HashMap PGCol TxtEncodedVal)
-> m (HashMap PGCol TxtEncodedVal)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (HashMap PGCol TxtEncodedVal)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
errMsg
    [(PGCol, SQLExp)]
retColsWithVals <- ColumnValues ('Postgres pgKind) TxtEncodedVal
-> [ColumnInfo ('Postgres pgKind)] -> m [(PGCol, SQLExp)]
forall (m :: * -> *) (pgKind :: PostgresKind).
MonadError QErr m =>
ColumnValues ('Postgres pgKind) TxtEncodedVal
-> [ColumnInfo ('Postgres pgKind)] -> m [(PGCol, SQLExp)]
fetchFromColVals ColumnValues ('Postgres pgKind) TxtEncodedVal
HashMap PGCol TxtEncodedVal
colVal [ColumnInfo ('Postgres pgKind)]
rColInfos
    let columns :: [(PGCol, SQLExp)]
columns = (((PGCol, PGCol) -> Maybe (PGCol, SQLExp))
 -> [(PGCol, PGCol)] -> [(PGCol, SQLExp)])
-> [(PGCol, PGCol)]
-> ((PGCol, PGCol) -> Maybe (PGCol, SQLExp))
-> [(PGCol, SQLExp)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PGCol, PGCol) -> Maybe (PGCol, SQLExp))
-> [(PGCol, PGCol)] -> [(PGCol, SQLExp)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (HashMap PGCol PGCol -> [(PGCol, PGCol)]
forall k v. HashMap k v -> [(k, v)]
Map.toList HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
mapCols) \(PGCol
column, PGCol
target) -> do
          SQLExp
value <- PGCol -> [(PGCol, SQLExp)] -> Maybe SQLExp
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PGCol
target [(PGCol, SQLExp)]
retColsWithVals
          (PGCol, SQLExp) -> Maybe (PGCol, SQLExp)
forall a. a -> Maybe a
Just (PGCol
column, SQLExp
value)
    (Int, [(PGCol, SQLExp)]) -> m (Int, [(PGCol, SQLExp)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
affRows, [(PGCol, SQLExp)]
columns)
  where
    IR.RelationInsert SingleObjectInsert ('Postgres pgKind) SQLExp
singleObjIns RelInfo ('Postgres pgKind)
relInfo = ObjectRelationInsert ('Postgres pgKind) SQLExp
objRelIns
    relName :: RelName
relName = RelInfo ('Postgres pgKind) -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo ('Postgres pgKind)
relInfo
    table :: TableName ('Postgres pgKind)
table = RelInfo ('Postgres pgKind) -> TableName ('Postgres pgKind)
forall (b :: BackendType). RelInfo b -> TableName b
riRTable RelInfo ('Postgres pgKind)
relInfo
    mapCols :: HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
mapCols = RelInfo ('Postgres pgKind)
-> HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo ('Postgres pgKind)
relInfo
    allCols :: [ColumnInfo ('Postgres pgKind)]
allCols = SingleObjectInsert ('Postgres pgKind) SQLExp
-> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType) (f :: * -> *) v.
AnnotatedInsertData b f v -> [ColumnInfo b]
IR._aiTableColumns SingleObjectInsert ('Postgres pgKind) SQLExp
singleObjIns
    rCols :: [PGCol]
rCols = HashMap PGCol PGCol -> [PGCol]
forall k v. HashMap k v -> [v]
Map.elems HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
mapCols
    rColInfos :: [ColumnInfo ('Postgres pgKind)]
rColInfos = [Column ('Postgres pgKind)]
-> [ColumnInfo ('Postgres pgKind)]
-> [ColumnInfo ('Postgres pgKind)]
forall (b :: BackendType).
Backend b =>
[Column b] -> [ColumnInfo b] -> [ColumnInfo b]
getColInfos [Column ('Postgres pgKind)]
[PGCol]
rCols [ColumnInfo ('Postgres pgKind)]
allCols
    errMsg :: Text
errMsg =
      Text
"cannot proceed to insert object relation "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" since insert to table "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName ('Postgres pgKind)
QualifiedObject TableName
table QualifiedObject TableName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" affects zero rows"

insertArrRel ::
  ( MonadTx m,
    MonadIO m,
    Tracing.MonadTrace m,
    Backend ('Postgres pgKind),
    PostgresAnnotatedFieldJSON pgKind,
    MonadReader QueryTagsComment m
  ) =>
  [(PGCol, PG.SQLExp)] ->
  UserInfo ->
  Seq.Seq Q.PrepArg ->
  Options.StringifyNumbers ->
  Maybe NamingCase ->
  IR.ArrayRelationInsert ('Postgres pgKind) PG.SQLExp ->
  m Int
insertArrRel :: [(PGCol, SQLExp)]
-> UserInfo
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> ArrayRelationInsert ('Postgres pgKind) SQLExp
-> m Int
insertArrRel [(PGCol, SQLExp)]
resCols UserInfo
userInfo Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase ArrayRelationInsert ('Postgres pgKind) SQLExp
arrRelIns =
  Text -> m Int -> m Int
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK (RelName -> Text
relNameToTxt (RelName -> Text) -> RelName -> Text
forall a b. (a -> b) -> a -> b
$ RelInfo ('Postgres pgKind) -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo ('Postgres pgKind)
relInfo) (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
    let additionalColumns :: HashMap PGCol SQLExp
additionalColumns = [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(PGCol, SQLExp)] -> HashMap PGCol SQLExp)
-> [(PGCol, SQLExp)] -> HashMap PGCol SQLExp
forall a b. (a -> b) -> a -> b
$
          (((PGCol, SQLExp) -> Maybe (PGCol, SQLExp))
 -> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)])
-> [(PGCol, SQLExp)]
-> ((PGCol, SQLExp) -> Maybe (PGCol, SQLExp))
-> [(PGCol, SQLExp)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((PGCol, SQLExp) -> Maybe (PGCol, SQLExp))
-> [(PGCol, SQLExp)] -> [(PGCol, SQLExp)]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe [(PGCol, SQLExp)]
resCols \(PGCol
column, SQLExp
value) -> do
            PGCol
target <- PGCol -> HashMap PGCol PGCol -> Maybe PGCol
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup PGCol
column HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
HashMap PGCol PGCol
mapping
            (PGCol, SQLExp) -> Maybe (PGCol, SQLExp)
forall a. a -> Maybe a
Just (PGCol
target, SQLExp
value)
    EncJSON
resBS <-
      Text -> m EncJSON -> m EncJSON
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
"data" (m EncJSON -> m EncJSON) -> m EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$
        MultiObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> MutationOutput ('Postgres pgKind)
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
forall (pgKind :: PostgresKind) (m :: * -> *).
(MonadTx m, MonadIO m, MonadTrace m, Backend ('Postgres pgKind),
 PostgresAnnotatedFieldJSON pgKind,
 MonadReader QueryTagsComment m) =>
MultiObjectInsert ('Postgres pgKind) SQLExp
-> HashMap PGCol SQLExp
-> UserInfo
-> MutationOutput ('Postgres pgKind)
-> Seq PrepArg
-> StringifyNumbers
-> Maybe NamingCase
-> m EncJSON
insertMultipleObjects MultiObjectInsert ('Postgres pgKind) SQLExp
multiObjIns HashMap PGCol SQLExp
additionalColumns UserInfo
userInfo MutationOutput ('Postgres pgKind)
forall (b :: BackendType) r v. MutationOutputG b r v
mutOutput Seq PrepArg
planVars StringifyNumbers
stringifyNum Maybe NamingCase
tCase
    HashMap Text Int
resObj <- EncJSON -> m (HashMap Text Int)
forall a (m :: * -> *). (FromJSON a, QErrM m) => EncJSON -> m a
decodeEncJSON EncJSON
resBS
    Maybe Int -> m Int -> m Int
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (Text
"affected_rows" :: Text) HashMap Text Int
resObj) (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$
      Text -> m Int
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"affected_rows not returned in array rel insert"
  where
    IR.RelationInsert MultiObjectInsert ('Postgres pgKind) SQLExp
multiObjIns RelInfo ('Postgres pgKind)
relInfo = ArrayRelationInsert ('Postgres pgKind) SQLExp
arrRelIns
    mapping :: HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
mapping = RelInfo ('Postgres pgKind)
-> HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo ('Postgres pgKind)
relInfo
    mutOutput :: MutationOutputG b r v
mutOutput = MutFldsG b r v -> MutationOutputG b r v
forall (b :: BackendType) r v.
MutFldsG b r v -> MutationOutputG b r v
IR.MOutMultirowFields [(FieldName
"affected_rows", MutFldG b r v
forall (b :: BackendType) r v. MutFldG b r v
IR.MCount)]

-- | Validate an insert object based on insert columns,
-- insert object relations and additional columns from parent:
--
-- * There should be no overlap between 'insCols' and 'addCols'.
-- * There should be no overlap between any object relationship columns and
--   'insCols' and 'addCols'.
validateInsert ::
  (MonadError QErr m) =>
  -- | inserting columns
  [PGCol] ->
  -- | object relation inserts
  [RelInfo ('Postgres pgKind)] ->
  -- | additional fields from parent
  [PGCol] ->
  m ()
validateInsert :: [PGCol] -> [RelInfo ('Postgres pgKind)] -> [PGCol] -> m ()
validateInsert [PGCol]
insCols [RelInfo ('Postgres pgKind)]
objRels [PGCol]
addCols = do
  -- validate insertCols
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PGCol] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PGCol]
insConflictCols) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"cannot insert " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PGCol] -> Text
forall (t :: * -> *). (Foldable t, Functor t) => t PGCol -> Text
showPGCols [PGCol]
insConflictCols
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" columns as their values are already being determined by parent insert"

  [RelInfo ('Postgres pgKind)]
-> (RelInfo ('Postgres pgKind) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RelInfo ('Postgres pgKind)]
objRels ((RelInfo ('Postgres pgKind) -> m ()) -> m ())
-> (RelInfo ('Postgres pgKind) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \RelInfo ('Postgres pgKind)
relInfo -> do
    let lCols :: [PGCol]
lCols = HashMap PGCol PGCol -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys (HashMap PGCol PGCol -> [PGCol]) -> HashMap PGCol PGCol -> [PGCol]
forall a b. (a -> b) -> a -> b
$ RelInfo ('Postgres pgKind)
-> HashMap (Column ('Postgres pgKind)) (Column ('Postgres pgKind))
forall (b :: BackendType).
RelInfo b -> HashMap (Column b) (Column b)
riMapping RelInfo ('Postgres pgKind)
relInfo
        relName :: RelName
relName = RelInfo ('Postgres pgKind) -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo ('Postgres pgKind)
relInfo
        relNameTxt :: Text
relNameTxt = RelName -> Text
relNameToTxt RelName
relName
        lColConflicts :: [PGCol]
lColConflicts = [PGCol]
lCols [PGCol] -> [PGCol] -> [PGCol]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` ([PGCol]
addCols [PGCol] -> [PGCol] -> [PGCol]
forall a. Semigroup a => a -> a -> a
<> [PGCol]
insCols)
    Text -> m () -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a -> m a
withPathK Text
relNameTxt (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PGCol] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PGCol]
lColConflicts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
          Text
"cannot insert object relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName
            RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" as "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [PGCol] -> Text
forall (t :: * -> *). (Foldable t, Functor t) => t PGCol -> Text
showPGCols [PGCol]
lColConflicts
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" column values are already determined"
  where
    insConflictCols :: [PGCol]
insConflictCols = [PGCol]
insCols [PGCol] -> [PGCol] -> [PGCol]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [PGCol]
addCols

mkInsertQ ::
  Backend ('Postgres pgKind) =>
  QualifiedTable ->
  Maybe (IR.OnConflictClause ('Postgres pgKind) PG.SQLExp) ->
  Map.HashMap PGCol PG.SQLExp ->
  (AnnBoolExpSQL ('Postgres pgKind), Maybe (AnnBoolExpSQL ('Postgres pgKind))) ->
  PG.TopLevelCTE
mkInsertQ :: QualifiedObject TableName
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> HashMap PGCol SQLExp
-> (AnnBoolExpSQL ('Postgres pgKind),
    Maybe (AnnBoolExpSQL ('Postgres pgKind)))
-> TopLevelCTE
mkInsertQ QualifiedObject TableName
table Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
onConflictM HashMap PGCol SQLExp
insertRow (AnnBoolExpSQL ('Postgres pgKind)
insCheck, Maybe (AnnBoolExpSQL ('Postgres pgKind))
updCheck) =
  let sqlConflict :: Maybe SQLConflict
sqlConflict = QualifiedObject TableName
-> OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
QualifiedObject TableName
-> OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict
PGT.toSQLConflict QualifiedObject TableName
table (OnConflictClause ('Postgres pgKind) SQLExp -> SQLConflict)
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> Maybe SQLConflict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
onConflictM
      sqlExps :: [SQLExp]
sqlExps = HashMap PGCol SQLExp -> [SQLExp]
forall k v. HashMap k v -> [v]
Map.elems HashMap PGCol SQLExp
insertRow
      valueExp :: ValuesExp
valueExp = [TupleExp] -> ValuesExp
PG.ValuesExp [[SQLExp] -> TupleExp
PG.TupleExp [SQLExp]
sqlExps]
      tableCols :: [PGCol]
tableCols = HashMap PGCol SQLExp -> [PGCol]
forall k v. HashMap k v -> [k]
Map.keys HashMap PGCol SQLExp
insertRow
      sqlInsert :: SQLInsert
sqlInsert =
        QualifiedObject TableName
-> [PGCol]
-> ValuesExp
-> Maybe SQLConflict
-> Maybe RetExp
-> SQLInsert
PG.SQLInsert QualifiedObject TableName
table [PGCol]
tableCols ValuesExp
valueExp Maybe SQLConflict
sqlConflict
          (Maybe RetExp -> SQLInsert)
-> (RetExp -> Maybe RetExp) -> RetExp -> SQLInsert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetExp -> Maybe RetExp
forall a. a -> Maybe a
Just
          (RetExp -> SQLInsert) -> RetExp -> SQLInsert
forall a b. (a -> b) -> a -> b
$ [Extractor] -> RetExp
PG.RetExp
            [ Extractor
PG.selectStar,
              QualifiedObject TableName
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BoolExp
-> Maybe BoolExp
-> Extractor
forall (pgKind :: PostgresKind).
QualifiedObject TableName
-> Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
-> BoolExp
-> Maybe BoolExp
-> Extractor
PGT.insertOrUpdateCheckExpr
                QualifiedObject TableName
table
                Maybe (OnConflictClause ('Postgres pgKind) SQLExp)
onConflictM
                (Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
PGT.toSQLBoolExp (QualifiedObject TableName -> Qual
PG.QualTable QualifiedObject TableName
table) AnnBoolExpSQL ('Postgres pgKind)
insCheck)
                ((AnnBoolExp ('Postgres pgKind) SQLExp -> BoolExp)
-> Maybe (AnnBoolExp ('Postgres pgKind) SQLExp) -> Maybe BoolExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
forall (pgKind :: PostgresKind).
Backend ('Postgres pgKind) =>
Qual -> AnnBoolExpSQL ('Postgres pgKind) -> BoolExp
PGT.toSQLBoolExp (QualifiedObject TableName -> Qual
PG.QualTable QualifiedObject TableName
table)) Maybe (AnnBoolExpSQL ('Postgres pgKind))
Maybe (AnnBoolExp ('Postgres pgKind) SQLExp)
updCheck)
            ]
   in SQLInsert -> TopLevelCTE
PG.CTEInsert SQLInsert
sqlInsert

fetchFromColVals ::
  MonadError QErr m =>
  ColumnValues ('Postgres pgKind) TxtEncodedVal ->
  [ColumnInfo ('Postgres pgKind)] ->
  m [(PGCol, PG.SQLExp)]
fetchFromColVals :: ColumnValues ('Postgres pgKind) TxtEncodedVal
-> [ColumnInfo ('Postgres pgKind)] -> m [(PGCol, SQLExp)]
fetchFromColVals ColumnValues ('Postgres pgKind) TxtEncodedVal
colVal [ColumnInfo ('Postgres pgKind)]
reqCols =
  [ColumnInfo ('Postgres pgKind)]
-> (ColumnInfo ('Postgres pgKind) -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ColumnInfo ('Postgres pgKind)]
reqCols ((ColumnInfo ('Postgres pgKind) -> m (PGCol, SQLExp))
 -> m [(PGCol, SQLExp)])
-> (ColumnInfo ('Postgres pgKind) -> m (PGCol, SQLExp))
-> m [(PGCol, SQLExp)]
forall a b. (a -> b) -> a -> b
$ \ColumnInfo ('Postgres pgKind)
ci -> do
    let valM :: Maybe TxtEncodedVal
valM = PGCol -> HashMap PGCol TxtEncodedVal -> Maybe TxtEncodedVal
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
ci) ColumnValues ('Postgres pgKind) TxtEncodedVal
HashMap PGCol TxtEncodedVal
colVal
    TxtEncodedVal
val <-
      Maybe TxtEncodedVal -> m TxtEncodedVal -> m TxtEncodedVal
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe TxtEncodedVal
valM (m TxtEncodedVal -> m TxtEncodedVal)
-> m TxtEncodedVal -> m TxtEncodedVal
forall a b. (a -> b) -> a -> b
$
        Text -> m TxtEncodedVal
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m TxtEncodedVal) -> Text -> m TxtEncodedVal
forall a b. (a -> b) -> a -> b
$
          Text
"column "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
ci PGCol -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in given colVal"
    let pgColVal :: SQLExp
pgColVal = case TxtEncodedVal
val of
          TxtEncodedVal
TENull -> SQLExp
PG.SENull
          TELit Text
t -> Text -> SQLExp
PG.SELit Text
t
    (PGCol, SQLExp) -> m (PGCol, SQLExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnInfo ('Postgres pgKind) -> Column ('Postgres pgKind)
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo ('Postgres pgKind)
ci, SQLExp
pgColVal)

decodeEncJSON :: (J.FromJSON a, QErrM m) => EncJSON -> m a
decodeEncJSON :: EncJSON -> m a
decodeEncJSON =
  (String -> m a) -> (Value -> m a) -> Either String Value -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m a) -> (String -> Text) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) Value -> m a
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue
    (Either String Value -> m a)
-> (EncJSON -> Either String Value) -> EncJSON -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
J.eitherDecode
    (ByteString -> Either String Value)
-> (EncJSON -> ByteString) -> EncJSON -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncJSON -> ByteString
encJToLBS