squeal-postgresql-qq 0.1.2.1 → 0.1.3.0
raw patch · 5 files changed
+197/−56 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +2/−5
- changelog.md +10/−0
- squeal-postgresql-qq.cabal +1/−1
- src/Squeal/QuasiQuotes/Insert.hs +97/−50
- test/test.hs +87/−0
README.md view
@@ -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`
changelog.md view
@@ -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
squeal-postgresql-qq.cabal view
@@ -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
src/Squeal/QuasiQuotes/Insert.hs view
@@ -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."
test/test.hs view
@@ -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