事务保存点

chusql-core/engine/src/ChuSQL/Core/Engine.hs

@@ -137,6 +137,9 @@ runStatementUncheckedM _ ShowDatabases = runStatementM ShowDatabases
 runStatementUncheckedM _ BeginTransaction = pure (Left "BEGIN is executed by the session")
 runStatementUncheckedM _ CommitTransaction = pure (Left "COMMIT is executed by the session")
 runStatementUncheckedM _ RollbackTransaction = pure (Left "ROLLBACK is executed by the session")
+runStatementUncheckedM _ Savepoint{} = pure (Left "SAVEPOINT is executed by the session")
+runStatementUncheckedM _ RollbackToSavepoint{} = pure (Left "ROLLBACK TO is executed by the session")
+runStatementUncheckedM _ ReleaseSavepoint{} = pure (Left "RELEASE is executed by the session")
 
 -- | 只有需要读全表才能判断约束时才扫表
 existingRows :: (MonadStorage m) => String -> Table -> m (Either String [Row])

chusql-core/engine/src/ChuSQL/Core/Engine/Semantic.hs

@@ -437,6 +437,10 @@ checkResolvedWith db outer q = case q of
     BeginTransaction -> Right ()
     CommitTransaction -> Right ()
     RollbackTransaction -> Right ()
+    -- | 保存点名字只是会话层的记号，不做列检查
+    Savepoint _ -> Right ()
+    RollbackToSavepoint _ -> Right ()
+    ReleaseSavepoint _ -> Right ()
   where
     tableCols' = map fst . tableCols
 

chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/AST.hs

@@ -59,6 +59,12 @@ data Statement
     | CommitTransaction
     -- | 回滚事务
     | RollbackTransaction
+    -- | 建保存点：SAVEPOINT 名字
+    | Savepoint String
+    -- | 回滚到保存点：ROLLBACK TO [SAVEPOINT] 名字
+    | RollbackToSavepoint String
+    -- | 释放保存点：RELEASE [SAVEPOINT] 名字
+    | ReleaseSavepoint String
     deriving (Show, Eq)
 
 -- | 连接类型：内连接与左外连接

chusql-core/engine/src/ChuSQL/Core/Engine/Syntax/Parser.hs

@@ -619,7 +619,14 @@ transactionStatement =
     try (BeginTransaction <$ (keyword "start" *> keyword "transaction"))
         <|> (BeginTransaction <$ (keyword "begin" *> optional (keyword "transaction")))
         <|> (CommitTransaction <$ (keyword "commit" *> optional (keyword "transaction")))
+        <|> try (RollbackToSavepoint <$> rollbackToName)
         <|> (RollbackTransaction <$ (keyword "rollback" *> optional (keyword "transaction")))
+        <|> (Savepoint <$> (keyword "savepoint" *> identifier))
+        <|> (ReleaseSavepoint <$> (keyword "release" *> optional (keyword "savepoint") *> identifier))
+  where
+    -- | ROLLBACK TO [SAVEPOINT] 名字
+    rollbackToName =
+        keyword "rollback" *> keyword "to" *> optional (keyword "savepoint") *> identifier
 
 -- | 解析总入口
 parseStatement :: String -> Either String Statement

chusql-core/engine/test/Spec.hs

@@ -286,6 +286,17 @@ main = hspec $ do
             parseStatement "COMMIT TRANSACTION" `shouldBe` Right CommitTransaction
             parseStatement "ROLLBACK" `shouldBe` Right RollbackTransaction
             parseStatement "rollback transaction" `shouldBe` Right RollbackTransaction
+            parseStatement "SAVEPOINT spot" `shouldBe` Right (Savepoint "spot")
+            parseStatement "savepoint spot" `shouldBe` Right (Savepoint "spot")
+            parseStatement "ROLLBACK TO spot" `shouldBe` Right (RollbackToSavepoint "spot")
+            parseStatement "ROLLBACK TO SAVEPOINT spot" `shouldBe` Right (RollbackToSavepoint "spot")
+            parseStatement "RELEASE spot" `shouldBe` Right (ReleaseSavepoint "spot")
+            parseStatement "RELEASE SAVEPOINT spot" `shouldBe` Right (ReleaseSavepoint "spot")
+
+        it "requires a name on savepoint statements" $ do
+            parseStatement "SAVEPOINT" `shouldSatisfy` isLeft
+            parseStatement "ROLLBACK TO" `shouldSatisfy` isLeft
+            parseStatement "RELEASE" `shouldSatisfy` isLeft
 
         it "parses the bare words only as whole words" $ do
             parseStatement "BEGINNER" `shouldSatisfy` isLeft
@@ -297,7 +308,7 @@ main = hspec $ do
                     (runStatement [("users", users)] =<< parseStatement sql)
                         `shouldSatisfy` either (isInfixOf "executed by the session") (const False)
                 )
-                ["BEGIN", "COMMIT", "ROLLBACK"]
+                ["BEGIN", "COMMIT", "ROLLBACK", "SAVEPOINT spot", "ROLLBACK TO spot", "RELEASE spot"]
 
         it "puts transaction errors under the protocol category" $ do
             errorCode "BEGIN is executed by the session" `shouldBe` "query_error"