diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -46,11 +46,7 @@ See the haddocks. -## Most important features not currently implemented - -* `ON CONFLICT` clause for `INSERT` statements. - -## Other features not currently implemented +## Features not currently implemented This is a list of known unsupported SQL features. If you need one of these, please open an issue! @@ -82,6 +78,7 @@ * Data-modifying statements (`INSERT`, `UPDATE`, `DELETE`) within a `WITH` clause ### Data Manipulation (INSERT/UPDATE/DELETE) +* `ON CONFLICT` with a column list conflict target (e.g. `ON CONFLICT (col1, col2) ...`) * `INSERT ... DEFAULT VALUES` * `INSERT INTO table (columns) SELECT ...` (must omit column list) * `OVERRIDING` clause for identity columns in `INSERT` diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +### 0.1.3.0 + +* New features + * Support `ON CONFLICT ON CONSTRAINT` in `INSERT` statements. + * `insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do nothing` [✔] + * `insert into users_copy (id, name, bio) values ('id1', 'name1', 'bio1') on conflict on constraint pk_users_copy do update set name = 'new_name'` [✔] + * `insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do update set name = 'new_name' where users_copy.name = 'old_name'` [✔] + * `insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do nothing returning id` [✔] + * `insert into users_copy (id, name, bio) values ('id1', 'name1', 'bio1') on conflict on constraint pk_users_copy do update set name = 'new_name' returning *` [✔] + ### 0.1.2.1 * No-op improvements diff --git a/squeal-postgresql-qq.cabal b/squeal-postgresql-qq.cabal --- a/squeal-postgresql-qq.cabal +++ b/squeal-postgresql-qq.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: squeal-postgresql-qq -version: 0.1.2.1 +version: 0.1.3.0 synopsis: QuasiQuoter transforming raw sql into Squeal expressions. -- description: homepage: https://github.com/owensmurray/squeal-postgresql-qq diff --git a/src/Squeal/QuasiQuotes/Insert.hs b/src/Squeal/QuasiQuotes/Insert.hs --- a/src/Squeal/QuasiQuotes/Insert.hs +++ b/src/Squeal/QuasiQuotes/Insert.hs @@ -8,13 +8,14 @@ toSquealInsert, ) where -import Control.Monad (MonadFail(fail), mapM, when, zipWithM) -import Data.Foldable (Foldable(foldr, length), foldlM) +import Control.Monad (when, zipWithM) +import Data.Foldable (foldlM) import Data.Maybe (isJust) import Language.Haskell.TH.Syntax (Exp(AppE, ConE, LabelE, ListE, VarE), Q) import Prelude - ( Applicative(pure), Either(Left), Eq((/=)), Maybe(Just, Nothing) - , Semigroup((<>)), Show(show), ($), (.), error, otherwise + ( Applicative(pure), Either(Left), Eq((/=)), Foldable(foldr, length) + , Maybe(Just, Nothing), MonadFail(fail), Semigroup((<>)), Show(show) + , Traversable(mapM), ($), (.), (<$>), error, otherwise ) import Squeal.QuasiQuotes.Query (getIdentText, renderPGTAExpr, toSquealQuery) import qualified Data.List.NonEmpty as NE @@ -77,63 +78,59 @@ (names, exp) <- renderPGTWithClause withClause pure (names, Just exp) - when (isJust maybeOnConflict) $ - fail "ON CONFLICT clauses are not supported yet." + let + table = renderPGTInsertTarget insertTarget - insertBody <- + queryClauseExp <- case insertRest of PGT_AST.SelectInsertRest maybeInsertColumnList maybeOverrideKind selectStmt -> do when (isJust maybeOverrideKind) $ fail "OVERRIDING clause is not supported yet." - queryClauseExp <- - case selectStmt of - -- Case 1: INSERT ... VALUES ... - Left - (PGT_AST.SelectNoParens _ (Left (PGT_AST.ValuesSimpleSelect valuesClause)) _ _ _) -> - case maybeInsertColumnList of - Just colItems -> - renderPGTValueRows cteNames (NE.toList colItems) valuesClause - Nothing -> - fail - "INSERT INTO ... VALUES must specify column names for the Squeal-QQ translation." - -- Case 2: INSERT ... SELECT ... (a general SELECT statement) - _ -> - -- selectStmt is not a ValuesSimpleSelect (i.e., it's a general query) + case selectStmt of + -- Case 1: INSERT ... VALUES ... + Left + (PGT_AST.SelectNoParens _ (Left (PGT_AST.ValuesSimpleSelect valuesClause)) _ _ _) -> case maybeInsertColumnList of - Just _ -> + Just colItems -> + renderPGTValueRows cteNames (NE.toList colItems) valuesClause + Nothing -> fail - "INSERT INTO table (columns) SELECT ... is not yet supported by Squeal-QQ. Please use INSERT INTO table SELECT ... and ensure your SELECT statement provides all columns for the table, matching the table's column order and types." - Nothing -> do - squealQueryExp <- toSquealQuery cteNames Nothing selectStmt -- from Squeal.QuasiQuotes.Query - pure (ConE 'S.Subquery `AppE` squealQueryExp) - let - table = renderPGTInsertTarget insertTarget - case maybeReturningClause of - Nothing -> - pure $ VarE 'S.insertInto_ `AppE` table `AppE` queryClauseExp - Just (NE.toList -> [PGT_AST.AsteriskTargetEl]) -> do - let - returning = ConE 'S.Returning `AppE` ConE 'S.Star - pure $ - VarE 'S.insertInto - `AppE` table - `AppE` queryClauseExp - `AppE` ConE 'S.OnConflictDoRaise - `AppE` returning - Just targetList -> do - returningProj <- renderTargetList cteNames (NE.toList targetList) - let - returning = ConE 'S.Returning `AppE` (ConE 'S.List `AppE` returningProj) - pure $ - VarE 'S.insertInto - `AppE` table - `AppE` queryClauseExp - `AppE` ConE 'S.OnConflictDoRaise - `AppE` returning + "INSERT INTO ... VALUES must specify column names for the Squeal-QQ translation." + -- Case 2: INSERT ... SELECT ... (a general SELECT statement) + _ -> + -- selectStmt is not a ValuesSimpleSelect (i.e., it's a general query) + case maybeInsertColumnList of + Just _ -> + fail + "INSERT INTO table (columns) SELECT ... is not yet supported by Squeal-QQ. Please use INSERT INTO table SELECT ... and ensure your SELECT statement provides all columns for the table, matching the table's column order and types." + Nothing -> do + squealQueryExp <- toSquealQuery cteNames Nothing selectStmt -- from Squeal.QuasiQuotes.Query + pure (ConE 'S.Subquery `AppE` squealQueryExp) PGT_AST.DefaultValuesInsertRest -> fail "INSERT INTO ... DEFAULT VALUES is not yet supported by Squeal-QQ." let + renderReturning maybeReturning = case maybeReturning of + Nothing -> pure $ ConE 'S.Returning_ `AppE` ConE 'S.Nil + Just (NE.toList -> [PGT_AST.AsteriskTargetEl]) -> + pure $ ConE 'S.Returning `AppE` ConE 'S.Star + Just targetList -> do + returningProj <- renderTargetList cteNames (NE.toList targetList) + pure $ ConE 'S.Returning `AppE` (ConE 'S.List `AppE` returningProj) + insertBody <- + case (maybeOnConflict, maybeReturningClause) of + (Nothing, Nothing) -> + pure $ VarE 'S.insertInto_ `AppE` table `AppE` queryClauseExp + (Just onConflict, returning) -> do + onConflictExp <- renderOnConflict cteNames onConflict + returningExp <- renderReturning returning + pure $ VarE 'S.insertInto `AppE` table `AppE` queryClauseExp `AppE` onConflictExp `AppE` returningExp + (Nothing, returning) -> do + let onConflictExp = ConE 'S.OnConflictDoRaise + returningExp <- renderReturning returning + pure $ VarE 'S.insertInto `AppE` table `AppE` queryClauseExp `AppE` onConflictExp `AppE` returningExp + + let finalExp = case renderedWithClause of Nothing -> insertBody Just withExp -> VarE 'S.with `AppE` withExp `AppE` insertBody @@ -253,3 +250,53 @@ `AppE` LabelE colNameStr +renderOnConflict :: [Text.Text] -> PGT_AST.OnConflict -> Q Exp +renderOnConflict cteNames (PGT_AST.OnConflict maybeConfExpr onConflictDo) = do + conflictActionExp <- renderOnConflictDo cteNames onConflictDo + case maybeConfExpr of + Nothing -> fail "ON CONFLICT without a conflict target is not supported yet." + Just confExpr -> do + conflictTargetExp <- renderConfExpr confExpr + pure $ ConE 'S.OnConflict `AppE` conflictTargetExp `AppE` conflictActionExp + +renderConfExpr :: PGT_AST.ConfExpr -> Q Exp +renderConfExpr = \case + PGT_AST.ConstraintConfExpr name -> + pure $ ConE 'S.OnConstraint `AppE` LabelE (Text.unpack (getIdentText name)) + PGT_AST.WhereConfExpr _ _ -> + fail "ON CONFLICT (columns) is not supported yet. Use ON CONFLICT ON CONSTRAINT." + +renderOnConflictDo :: [Text.Text] -> PGT_AST.OnConflictDo -> Q Exp +renderOnConflictDo cteNames = \case + PGT_AST.NothingOnConflictDo -> pure $ ConE 'S.DoNothing + PGT_AST.UpdateOnConflictDo setClauseList maybeWhereClause -> do + setClauseListExp <- renderPGTSetClauseList' cteNames setClauseList + whereClauseExp <- case maybeWhereClause of + Nothing -> pure $ ListE [] + Just whereClause -> ListE . (:[]) <$> renderPGTAExpr cteNames whereClause + pure $ ConE 'S.DoUpdate `AppE` setClauseListExp `AppE` whereClauseExp + +renderPGTSetClauseList' :: [Text.Text] -> PGT_AST.SetClauseList -> Q Exp +renderPGTSetClauseList' cteNames setClauses = do + renderedItems <- mapM (renderPGTSetClause' cteNames) (NE.toList setClauses) + pure $ + foldr + (\item acc -> ConE '(S.:*) `AppE` item `AppE` acc) + (ConE 'S.Nil) + renderedItems + +renderPGTSetClause' :: [Text.Text] -> PGT_AST.SetClause -> Q Exp +renderPGTSetClause' cteNames = \case + PGT_AST.TargetSetClause (PGT_AST.SetTarget colId maybeIndirection) aExpr -> do + when (isJust maybeIndirection) $ + fail "UPDATE SET with indirection (e.g., array access) is not supported." + let + colNameStr = Text.unpack (getIdentText colId) + renderedExpr <- renderPGTAExpr cteNames aExpr + pure $ + VarE 'S.as + `AppE` (ConE 'S.Set `AppE` renderedExpr) + `AppE` LabelE colNameStr + PGT_AST.TargetListSetClause _ _ -> + fail + "UPDATE with multiple SET targets (e.g. (col1, col2) = (val1, val2)) is not yet supported." diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -941,6 +941,93 @@ "WITH \"new_user\" AS (SELECT * FROM (VALUES ((E'id_new' :: text), (E'new_name' :: text), (E'new_bio' :: text))) AS t (\"id\", \"name\", \"bio\")) INSERT INTO \"users_copy\" AS \"users_copy\" SELECT * FROM \"new_user\" AS \"new_user\"" checkStatement squealRendering statement + describe "on conflict" $ do + it "insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do nothing" $ do + let + statement :: Statement DB () () + statement = + [ssql| + insert into users_copy (id, name, bio) + values ('id1', 'name1', null) + on conflict on constraint pk_users_copy do nothing + |] + squealRendering :: Text + squealRendering = + "INSERT INTO \"users_copy\" AS \"users_copy\" (\"id\", \"name\", \"bio\") VALUES ((E'id1' :: text), (E'name1' :: text), NULL) ON CONFLICT ON CONSTRAINT \"pk_users_copy\" DO NOTHING" + checkStatement squealRendering statement + + it "insert into users_copy (id, name, bio) values ('id1', 'name1', 'bio1') on conflict on constraint pk_users_copy do update set name = 'new_name'" $ do + let + statement :: Statement DB () () + statement = + [ssql| + insert into users_copy (id, name, bio) + values ('id1', 'name1', 'bio1') + on conflict on constraint pk_users_copy + do update set name = 'new_name' + |] + squealRendering :: Text + squealRendering = + "INSERT INTO \"users_copy\" AS \"users_copy\" (\"id\", \"name\", \"bio\") VALUES ((E'id1' :: text), (E'name1' :: text), (E'bio1' :: text)) ON CONFLICT ON CONSTRAINT \"pk_users_copy\" DO UPDATE SET \"name\" = (E'new_name' :: text)" + checkStatement squealRendering statement + + it "insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do update set name = 'new_name' where users_copy.name = 'old_name'" $ do + let + statement :: Statement DB () () + statement = + [ssql| + insert into users_copy (id, name, bio) + values ('id1', 'name1', null) + on conflict on constraint pk_users_copy + do update set name = 'new_name' + where users_copy.name = 'old_name' + |] + squealRendering :: Text + squealRendering = + "INSERT INTO \"users_copy\" AS \"users_copy\" (\"id\", \"name\", \"bio\") VALUES ((E'id1' :: text), (E'name1' :: text), NULL) ON CONFLICT ON CONSTRAINT \"pk_users_copy\" DO UPDATE SET \"name\" = (E'new_name' :: text) WHERE (\"users_copy\".\"name\" = (E'old_name' :: text))" + checkStatement squealRendering statement + + it "insert into users_copy (id, name, bio) values ('id1', 'name1', null) on conflict on constraint pk_users_copy do nothing returning id" $ do + let + statement :: Statement DB () (Field "id" Text, ()) + statement = + [ssql| + insert into users_copy (id, name, bio) + values ('id1', 'name1', null) + on conflict on constraint pk_users_copy do nothing + returning id + |] + squealRendering :: Text + squealRendering = + "INSERT INTO \"users_copy\" AS \"users_copy\" (\"id\", \"name\", \"bio\") VALUES ((E'id1' :: text), (E'name1' :: text), NULL) ON CONFLICT ON CONSTRAINT \"pk_users_copy\" DO NOTHING RETURNING \"id\" AS \"id\"" + checkStatement squealRendering statement + + it "insert into users_copy (id, name, bio) values ('id1', 'name1', 'bio1') on conflict on constraint pk_users_copy do update set name = 'new_name' returning *" $ do + let + statement + :: Statement + DB + () + ( Field "id" Text + , ( Field "name" Text + , ( Field "bio" (Maybe Text) + , () + ) + ) + ) + statement = + [ssql| + insert into users_copy (id, name, bio) + values ('id1', 'name1', 'bio1') + on conflict on constraint pk_users_copy + do update set name = 'new_name' + returning * + |] + squealRendering :: Text + squealRendering = + "INSERT INTO \"users_copy\" AS \"users_copy\" (\"id\", \"name\", \"bio\") VALUES ((E'id1' :: text), (E'name1' :: text), (E'bio1' :: text)) ON CONFLICT ON CONSTRAINT \"pk_users_copy\" DO UPDATE SET \"name\" = (E'new_name' :: text) RETURNING *" + checkStatement squealRendering statement + describe "deletes" $ do it "delete from users where true" $ do let