diff --git a/src/App.hs b/src/App.hs index ad8721cd3..8e2130132 100644 --- a/src/App.hs +++ b/src/App.hs @@ -130,7 +130,7 @@ app req = let vals = elems obj H.unit . coerce $ iffNotT (whereT qq $ update qt cols vals) - (insertInto qt cols vals) + (insertSelect qt cols vals) return $ responseLBS status204 [ jsonH ] "" else return $ if Prelude.null tableCols diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 14070ccf6..24c04da31 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -68,7 +68,7 @@ parentheticT (sql, params, pre) = iffNotT :: DynamicSQL -> StatementT iffNotT (aq, ap, apre) (bq, bp, bpre) = ("WITH aaa AS (" <> aq <> " returning *) " <> - bq <> "WHERE NOT EXISTS (SELECT * FROM aaa)" + bq <> " WHERE NOT EXISTS (SELECT * FROM aaa)" , ap ++ bp , All $ getAll apre && getAll bpre ) @@ -100,6 +100,18 @@ insertInto t cols vals = , mempty ) +insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL +insertSelect t [] _ = + ("insert into " <> fromQt t <> " default values returning *", [], mempty) +insertSelect t cols vals = + ("insert into " <> fromQt t <> " (" <> + cs (intercalate ", " (map pgFmtIdent cols)) <> + ") select " <> + cs (intercalate ", " (map (const "?") vals)) + , map pgParam vals + , mempty + ) + update :: QualifiedTable -> [Text] -> [JSON.Value] -> DynamicSQL update t cols vals = ("update " <> fromQt t <> " set (" <>