rust部分推进：进程间通信（Windows平台命名管线）、内存页表、B+树、WAL恢复系统、动态配置

chusql-engine/src/ChuSQL/Algebra/Eval.hs

@@ -1,25 +1,41 @@
-module ChuSQL.Algebra.Eval (evalRelOp) where
+module ChuSQL.Algebra.Eval (evalRelOp, evalRelOpM) where
 
 import ChuSQL.Algebra.Expr (evalCondForRow)
 import ChuSQL.Algebra.Op
 import ChuSQL.Algebra.Sort (sortRows)
 import ChuSQL.Model
+import ChuSQL.Storage (MonadStorage (..))
+import ChuSQL.Syntax.AST (Expr (..))
 import Control.Monad (filterM)
 
--- 投影
+-- 执行：按关系算子树真正算出结果行（Scan 阶段会给列名加上别名前缀）。
+
+-- 投影：只保留清单里的列；哨兵 "*" 表示全部列。
 project :: [String] -> Row -> Row
 project ["*"] row = row
 project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
 
--- 执行关系代数运算
+-- 给一行里的每个列名加上别名前缀（如 "u."）。
 addPrefix :: String -> Row -> Row
 addPrefix prefix = map (\(k, v) -> (prefix ++ k, v))
 
-evalRelOp :: Database -> RelOp -> Either String [Row]
-evalRelOp db (Scan mAlias tbl) = do
+-- 索引查找的约定：主键列名是 "id"（优化器只在这种情况下才把过滤改写成 Lookup）。
+keyCondition :: Int -> Expr
+keyCondition k = Eq (Col "id") (LitInt k)
+
+-- 扫描一张表；有别名就给每个列名加上前缀，JOIN 两边同名列靠它区分。
+evalScan :: Database -> Maybe String -> String -> Either String [Row]
+evalScan db mAlias tbl = do
     table <- lookupTable db tbl
     let prefix = maybe "" (++ ".") mAlias
     Right (map (addPrefix prefix) (tableRows table))
+
+-- 执行关系代数运算：Scan / Lookup / Filter / Project / Sort / Limit / Join 各一支。
+evalRelOp :: Database -> RelOp -> Either String [Row]
+evalRelOp db (Scan mAlias tbl) = evalScan db mAlias tbl
+evalRelOp db (Lookup tbl k) = do
+    rows <- evalScan db Nothing tbl
+    filterM (evalCondForRow (keyCondition k)) rows
 evalRelOp db (Filter e op) = do
     rows <- evalRelOp db op
     filterM (evalCondForRow e) rows
@@ -37,3 +53,35 @@ evalRelOp db (Join left right cond) = do
     rrows <- evalRelOp db right
     let cross = [l ++ r | l <- lrows, r <- rrows] -- 笛卡尔积
     filterM (evalCondForRow cond) cross
+
+-- | Monadic 版本：Lookup 直接问存储要一行（走索引），其余算子照原样递归。
+evalRelOpM :: (MonadStorage m) => Database -> RelOp -> m (Either String [Row])
+evalRelOpM _ (Lookup t k) = do
+    result <- lookupByKey t k
+    pure $ case result of
+        Left e -> Left e
+        Right Nothing -> Right []
+        Right (Just r) -> Right [r]
+evalRelOpM db (Scan a t) = pure (evalScan db a t)
+evalRelOpM db (Filter p x) = do
+    result <- evalRelOpM db x
+    pure $ do
+        rows <- result
+        filterM (evalCondForRow p) rows
+evalRelOpM db (Project cols x) = do
+    result <- evalRelOpM db x
+    pure (map (project cols) <$> result)
+evalRelOpM db (Sort specs x) = do
+    result <- evalRelOpM db x
+    pure (sortRows specs <$> result)
+evalRelOpM db (Limit n x) = do
+    result <- evalRelOpM db x
+    pure (take n <$> result)
+evalRelOpM db (Join l r c) = do
+    ls <- evalRelOpM db l
+    rs <- evalRelOpM db r
+    pure $ do
+        leftRows <- ls
+        rightRows <- rs
+        let cross = [x ++ y | x <- leftRows, y <- rightRows]
+        filterM (evalCondForRow c) cross

chusql-engine/src/ChuSQL/Algebra/Expr.hs

@@ -4,6 +4,8 @@ import ChuSQL.Model
 import ChuSQL.Syntax.AST
 import Control.Monad (join)
 
+-- 表达式求值：在一行（列名 → 值）上算出单个值；另外提供"静态收集表达式里用到哪些列"的工具。
+
 -- 表达式求值
 evalExpr :: Expr -> Row -> Either String Value
 evalExpr (Col name) row =
@@ -17,7 +19,7 @@ evalExpr (Eq a b) row = liftBinOp eqOp a b row
 evalExpr (And a b) row = liftBinOp (boolOp (&&)) a b row
 evalExpr (Or a b) row = liftBinOp (boolOp (||)) a b row
 
--- | 收集表达式里用到的列名
+-- 收集表达式里用到的列名
 colsInExpr :: Expr -> [String]
 colsInExpr (Col c) = [c]
 colsInExpr (Gt a b) = colsInExpr a ++ colsInExpr b

chusql-engine/src/ChuSQL/Algebra/Op.hs

@@ -2,9 +2,12 @@ module ChuSQL.Algebra.Op (RelOp (..), renderPlan) where
 
 import ChuSQL.Syntax.AST (Expr, SortDir)
 
+-- 关系代数算子：执行计划用 RelOp 表示；另外提供一个把计划打印成缩进文本的辅助函数。
+
 -- 关系代数算子
 data RelOp
     = Scan (Maybe String) String
+    | Lookup String Int
     | Filter Expr RelOp
     | Project [String] RelOp
     | Sort [(String, SortDir)] RelOp
@@ -12,11 +15,12 @@ data RelOp
     | Join RelOp RelOp Expr
     deriving (Show, Eq)
 
--- | 把算子树画成缩进文本（演示和调试用）
+-- 把算子树画成缩进文本（演示和调试用）
 renderPlan :: RelOp -> String
 renderPlan = go 0
   where
     go ind op = case op of
+        Lookup t k -> "Lookup " ++ show t ++ " " ++ show k
         Scan a t -> pad ++ "Scan " ++ show a ++ " " ++ show t
         Filter e x -> pad ++ "Filter " ++ show e ++ "\n" ++ go (ind + 1) x
         Project c x -> pad ++ "Project " ++ show c ++ "\n" ++ go (ind + 1) x

chusql-engine/src/ChuSQL/Algebra/Optimize.hs

@@ -1,9 +1,11 @@
 module ChuSQL.Algebra.Optimize (optimize, pushProject) where
 
+import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
 import ChuSQL.Algebra.Op (RelOp (..))
 import ChuSQL.Model
 import ChuSQL.Syntax.AST (Expr (..))
-import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
+
+-- 查询优化：谓词下推 + 投影下推 + 常量折叠，反复应用规则直到算子树形状不再变化。
 
 -- * 谓词下推
 
@@ -15,6 +17,7 @@ relOpCols db (Limit _ x) = relOpCols db x
 relOpCols _ (Project ["*"] _) = ["*"]
 relOpCols _ (Project cols _) = cols
 relOpCols db (Join l r _) = relOpCols db l ++ relOpCols db r
+relOpCols db (Lookup tbl _) = relOpCols db (Scan Nothing tbl)
 relOpCols db (Scan mAlias tbl) =
     case lookup tbl db of
         Nothing -> []
@@ -73,10 +76,18 @@ pushOne _ op = op
 
 -- * 投影下推
 
--- | 工具函数
+-- | 是不是要拿全部列（need 里含哨兵 "*"）。
 needsAll :: [String] -> Bool
 needsAll = elem allColumns
 
+-- | 叶子算子（扫描 / 索引查找）的投影下推：需要全部列就原样保留，缺列才套一层 Project
+pushProjectLeaf :: Database -> [String] -> RelOp -> RelOp
+pushProjectLeaf db need leaf
+    | needsAll need = leaf
+    | all (`elem` need) (relOpCols db leaf) = leaf
+    | otherwise = Project need leaf
+
+-- | 投影下推：把"上层需要哪些列"一路往下传，JOIN 两侧各自只保留自己需要的列。
 pushProject :: Database -> [String] -> RelOp -> RelOp
 pushProject db _ (Project cols x) = case pushProject db cols x of
     Project cols' y | cols' == cols -> Project cols y
@@ -93,10 +104,8 @@ pushProject db need (Join l r c)
             lNeed = if needsAll lCols then ["*"] else [x | x <- tot, x `elem` lCols]
             rNeed = if needsAll rCols then ["*"] else [x | x <- tot, x `elem` rCols]
          in Join (pushProject db lNeed l) (pushProject db rNeed r) c
-pushProject db need scan@(Scan _ _)
-    | needsAll need = scan
-    | all (`elem` need) (relOpCols db scan) = scan
-    | otherwise = Project need scan
+pushProject db need leaf@(Scan _ _) = pushProjectLeaf db need leaf
+pushProject db need leaf@(Lookup _ _) = pushProjectLeaf db need leaf
 
 -- * 常量折叠
 
@@ -123,6 +132,8 @@ foldConstants e = e
 
 -- | 单节点重写：把 Filter 分派给上面几条规则，另外负责恒真条件删除与恒等投影消除
 rewriteNode :: Database -> RelOp -> RelOp
+rewriteNode _ (Filter (Eq (Col k) (LitInt v)) (Scan _ t))
+    | k == "id" = Lookup t v
 rewriteNode db (Filter p (Join l r c)) = pushJoin db p l r c
 rewriteNode db (Filter p x) = case foldConstants p of
     LitBool True -> x

chusql-engine/src/ChuSQL/Algebra/Planner.hs

@@ -3,12 +3,15 @@ module ChuSQL.Algebra.Planner (translate) where
 import ChuSQL.Algebra.Op
 import ChuSQL.Syntax.AST
 
--- 内部查询语句转执行计划
+-- 计划翻译：把 AST 里的 SELECT 翻译成关系代数算子树（只翻译，不做合法性检查）。
+
+-- 把 FROM 从句转成 Scan / Join 算子。
 fromToRelOp :: FromClause -> RelOp
 fromToRelOp (FromTable mAlias tbl) = Scan mAlias tbl
 fromToRelOp (FromJoin left mAlias tbl cond) =
     Join (fromToRelOp left) (Scan mAlias tbl) cond
 
+-- 翻译入口：把 SELECT 翻译成算子树；其它语句类型不支持（返回 Left）。
 translate :: Query -> Either String RelOp
 translate q = case q of
     Select

chusql-engine/src/ChuSQL/Algebra/Sort.hs

@@ -4,20 +4,22 @@ import ChuSQL.Model
 import ChuSQL.Syntax.AST
 import Data.List (sortBy)
 
--- | 反向排序
+-- 排序：按 ORDER BY 的列清单逐列比较（支持 ASC / DESC），供执行 Sort 算子时使用。
+
+-- 反向排序
 flipOrdering :: Ordering -> Ordering
 flipOrdering LT = GT
 flipOrdering GT = LT
 flipOrdering EQ = EQ
 
--- | 定义值的比较规则
+-- 定义值的比较规则
 compareValue :: Value -> Value -> Ordering
 compareValue (VInt a) (VInt b) = compare a b
 compareValue (VStr a) (VStr b) = compare a b
 compareValue (VBool a) (VBool b) = compare a b
 compareValue _ _ = EQ
 
--- | 定义行的比较规则
+-- 定义行的比较规则
 compareRows :: [(String, SortDir)] -> Row -> Row -> Ordering
 compareRows [] _ _ = EQ
 compareRows ((col, dir) : rest) r1 r2 =
@@ -31,7 +33,7 @@ compareRows ((col, dir) : rest) r1 r2 =
                         else o
         _ -> compareRows rest r1 r2
 
--- | 将表的每行排序
+-- 将表的每行排序
 sortRows :: [(String, SortDir)] -> [Row] -> [Row]
 sortRows [] rows = rows
 sortRows spec rows = sortBy (compareRows spec) rows

chusql-engine/src/ChuSQL/Engine.hs

@@ -1,78 +1,100 @@
-module ChuSQL.Engine (runQuery, rowsOf) where
+module ChuSQL.Engine (runQuery, runQueryM, rowsOf) where
 
-import ChuSQL.Algebra.Eval (evalRelOp)
+import ChuSQL.Algebra.Eval (evalRelOpM)
 import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
 import ChuSQL.Algebra.Optimize (optimize)
 import ChuSQL.Algebra.Planner (translate)
 import ChuSQL.Model
 import ChuSQL.Semantic (check)
+import ChuSQL.Storage (MonadStorage (..))
+import ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage))
 import ChuSQL.Syntax.AST
 import Control.Monad (filterM)
 
--- | 带检查的查询入口：先做语义检查，再交给下面的执行
+-- | 对外入口：签名不变，内部走内存实现。
 runQuery :: Database -> Query -> Either String (Database, [Row])
 runQuery db q = do
-    _ <- check db q
-    runQueryUnchecked db q
+    (result, db') <- runMemoryStorage (runQueryM q) db
+    rows <- result
+    Right (db', rows)
 
--- | 只要结果行（丢掉更新后的数据库），给演示和测试用
+-- | 只要结果行（丢掉更新后的数据库），给演示和测试用。
 rowsOf :: Either String (Database, [Row]) -> Either String [Row]
 rowsOf = fmap snd
 
--- 把表整体换掉（调用方已经查过，表一定存在）
-replaceTable :: String -> Table -> Database -> Database
-replaceTable name table = map (\(n, t) -> if n == name then (n, table) else (n, t))
+-- * 泛型入口：走 MonadStorage，未来 IPCStorage 复用同一份代码
 
--- 修改表
-applyUpdates :: [(String, Expr)] -> Row -> Either String Row
-applyUpdates [] row = Right row
-applyUpdates ((col, e) : rest) row = do
-    v <- evalExpr e row
-    let row' = setColumn col v row
-    applyUpdates rest row'
+-- | 语义检查 + 分发到具体语句。
+runQueryM :: (MonadStorage m) => Query -> m (Either String [Row])
+runQueryM q = do
+    db <- snapshot
+    case check db q of
+        Left err -> pure (Left err)
+        Right _ -> runQueryUncheckedM q
+
+-- | SELECT：拿快照，跑 translate → optimize → evalRelOp。
+runQueryUncheckedM :: (MonadStorage m) => Query -> m (Either String [Row])
+runQueryUncheckedM q@Select{} = do
+    db <- snapshot
+    case translate q of
+        Left e -> pure (Left e)
+        Right relOp -> evalRelOpM db (optimize db relOp)
+
+-- \| INSERT：求值后追加一行。
+runQueryUncheckedM (Insert tbl cols vals) =
+    case mapM (\e -> evalExpr e []) vals of
+        Left err -> pure (Left err)
+        Right values
+            | length cols /= length values ->
+                pure (Left "column count does not match value count")
+            | otherwise -> do
+                result <- insert tbl (zip cols values)
+                pure (result >> Right [])
+
+-- \| DELETE：扫表、筛掉命中行、整体写回。
+runQueryUncheckedM (Delete tbl mWhere) = do
+    rowsResult <- scan tbl
+    case rowsResult of
+        Left err -> pure (Left err)
+        Right rows -> do
+            let kept = case mWhere of
+                    Nothing -> Right []
+                    Just e -> filterM (shouldKeep e) rows
+            case kept of
+                Left err -> pure (Left err)
+                Right keptRows -> do
+                    result <- replaceAll tbl keptRows
+                    pure (result >> Right [])
   where
-    setColumn c v r = map (\(k, val) -> if k == c then (k, v) else (k, val)) r
-
--- 实际执行（调用方请确保已过 check）
-runQueryUnchecked :: Database -> Query -> Either String (Database, [Row])
-runQueryUnchecked db q@Select{} = do
-    relOp <- translate q
-    rows <- evalRelOp db (optimize db relOp)
-    Right (db, rows)
-
--- 处理插入
-runQueryUnchecked db (Insert tbl cols vals) = do
-    values <- mapM (\e -> evalExpr e []) vals
-    if length cols /= length values
-        then Left "column count does not match value count"
-        else do
-            table <- lookupTable db tbl
-            let newRow = zip cols values
-            Right (replaceTable tbl table{tableRows = tableRows table ++ [newRow]} db, [])
-
--- 处理删除
-runQueryUnchecked db (Delete tbl mWhere) = do
-    table <- lookupTable db tbl
-    rows <- case mWhere of
-        Nothing -> Right []
-        Just e -> filterM (shouldKeep e) (tableRows table)
-    Right (replaceTable tbl table{tableRows = rows} db, [])
-  where
-    -- 保留 = 条件不成立
+    -- \| 保留 = 条件不成立。
     shouldKeep :: Expr -> Row -> Either String Bool
     shouldKeep e row = not <$> evalCondForRow e row
 
--- 处理表更新
-runQueryUnchecked db (Update tbl assigns mWhere) = do
-    table <- lookupTable db tbl
-    rows <- mapM (updateRow mWhere assigns) (tableRows table)
-    Right (replaceTable tbl table{tableRows = rows} db, [])
+-- \| UPDATE：扫表、逐行改、整体写回。
+runQueryUncheckedM (Update tbl assigns mWhere) = do
+    rowsResult <- scan tbl
+    case rowsResult of
+        Left err -> pure (Left err)
+        Right rows -> do
+            let newRows = mapM (updateRow mWhere assigns) rows
+            case newRows of
+                Left err -> pure (Left err)
+                Right rs -> do
+                    result <- replaceAll tbl rs
+                    pure (result >> Right [])
   where
+    -- \| 命中条件就套用赋值，否则原样返回。
     updateRow :: Maybe Expr -> [(String, Expr)] -> Row -> Either String Row
     updateRow cond asgns row = do
         keep <- case cond of
             Nothing -> Right True
             Just e -> evalCondForRow e row
-        if keep
-            then applyUpdates asgns row
-            else Right row
+        if keep then applyUpdates asgns row else Right row
+
+-- | 按 assignments 依次求值并覆盖对应列。
+applyUpdates :: [(String, Expr)] -> Row -> Either String Row
+applyUpdates [] row = Right row
+applyUpdates ((col, e) : rest) row = do
+    v <- evalExpr e row
+    let row' = map (\(k, val) -> if k == col then (k, v) else (k, val)) row
+    applyUpdates rest row'

chusql-engine/src/ChuSQL/Model.hs

@@ -1,5 +1,7 @@
 module ChuSQL.Model (Column (..), Value (..), Row, Table (..), Database, colNames, colType, lookupTable, allColumns) where
 
+-- 数据模型：列类型、值、行、表、数据库，外加"按名查表 / 查列类型"这类通用小工具。
+
 -- 列的类型
 data Column
     = TInt
@@ -32,14 +34,14 @@ type Database = [(String, Table)]
 colNames :: Table -> [String]
 colNames = map fst . tableCols
 
--- | 查某一列的类型
+-- 查某一列的类型
 colType :: Table -> String -> Maybe Column
 colType t c = lookup c (tableCols t)
 
--- | 按名字查表；表不存在就报错
+-- 按名字查表；表不存在就报错
 lookupTable :: Database -> String -> Either String Table
 lookupTable db t = maybe (Left ("unknown table: " ++ t)) Right (lookup t db)
 
--- | 投影列清单里的哨兵值：它表示"全部列，不用挑"，不是列名
+-- 投影列清单里的哨兵值：它表示"全部列，不用挑"，不是列名
 allColumns :: String
 allColumns = "*"

chusql-engine/src/ChuSQL/Semantic.hs

@@ -5,6 +5,8 @@ import ChuSQL.Model
 import ChuSQL.Syntax.AST
 import Data.List (intercalate)
 
+-- 语义检查：执行前的关卡 —— 表和列存不存在、表达式类型对不对、写入的值类型是否匹配。
+
 -- * 表与列名解析
 
 -- | 给一批列加上"别名."前缀

chusql-engine/src/ChuSQL/Storage.hs

@@ -0,0 +1,20 @@
+module ChuSQL.Storage (MonadStorage (..)) where
+
+import ChuSQL.Model (Database, Row)
+
+-- 存储层抽象：上层只认 domain 类型，不关心底层是内存还是 IPC。
+class (Monad m) => MonadStorage m where
+    -- 全表扫描；表不存在返回 Left。
+    scan :: String -> m (Either String [Row])
+
+    -- 追加一行到表尾；表不存在返回 Left。
+    insert :: String -> Row -> m (Either String ())
+
+    -- 用新行列表整体替换一张表。
+    replaceAll :: String -> [Row] -> m (Either String ())
+
+    -- 按主键查一行；命中返回 Just，未命中返回 Nothing。
+    lookupByKey :: String -> Int -> m (Either String (Maybe Row))
+
+    -- 取全库快照，喂给还接收 Database 的语义检查 / 优化器 / evalRelOp。
+    snapshot :: m Database

chusql-engine/src/ChuSQL/Storage/IPC.hs

@@ -0,0 +1,331 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module ChuSQL.Storage.IPC (
+    IPCStorage (..),
+    Request (..),
+    Response (..),
+    SchemaColumn (..),
+    sendRequest,
+    doListTables,
+    doLookupByKey,
+    doInsertKeyed,
+    doDescribeTable,
+) where
+
+import ChuSQL.Model
+import ChuSQL.Storage
+import Control.Exception (bracket)
+import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict, encode, object, withObject, (.:), (.=))
+import Data.Aeson qualified as A
+import Data.Aeson.Key qualified as K
+import Data.Aeson.KeyMap qualified as KM
+import Data.Aeson.Types (Parser)
+import Data.ByteString.Char8 qualified as BSC
+import Data.ByteString.Lazy qualified as BL
+import Data.List (nub)
+import Data.Scientific (floatingOrInteger)
+import Data.Text qualified as T
+import System.Environment (lookupEnv)
+import System.IO
+
+-- IPC 存储实现：每个 MonadStorage 方法翻译成管道上的一条 JSON 请求。
+
+-- | IPC 实现：通过命名管道连 Rust 存储进程。
+newtype IPCStorage a = IPCStorage
+    { runIPCStorage :: IO a
+    }
+
+-- | Functor：把 fmap 转发给底下的 IO。
+instance Functor IPCStorage where
+    fmap f (IPCStorage m) = IPCStorage (fmap f m)
+
+-- | Applicative：把 pure / <*> 转发给底下的 IO。
+instance Applicative IPCStorage where
+    pure = IPCStorage . pure
+    IPCStorage mf <*> IPCStorage ma = IPCStorage (mf <*> ma)
+
+-- | Monad：顺序执行，转发给底下的 IO。
+instance Monad IPCStorage where
+    IPCStorage m >>= k = IPCStorage $ do
+        a <- m
+        runIPCStorage (k a)
+
+-- | 管道路径；默认 \\.\pipe\chusql-storage，可用 CHUSQL_PIPE 覆盖。
+pipePath :: IO String
+pipePath = do
+    name <- maybe "chusql-storage" id <$> lookupEnv "CHUSQL_PIPE"
+    pure ("\\\\.\\pipe\\" ++ name)
+
+-- | 打开管道、跑闭包、关闭。
+withPipe :: (Handle -> IO a) -> IO a
+withPipe = bracket openPipe hClose
+  where
+    -- \| 二进制读写、不做换行翻译，跟 Rust 侧对齐。
+    openPipe = do
+        path <- pipePath
+        h <- openFile path ReadWriteMode
+        hSetBuffering h LineBuffering
+        hSetNewlineMode h noNewlineTranslation
+        pure h
+
+-- | 发一条请求，读一条响应。
+sendRequest :: Request -> IO Response
+sendRequest req = withPipe $ \h -> do
+    BL.hPutStr h (encode req)
+    BSC.hPutStr h "\n"
+    hFlush h
+    line <- BSC.hGetLine h
+    let cleaned = BSC.dropWhileEnd (== '\r') line
+    case eitherDecodeStrict cleaned of
+        Left err -> pure (RespError ("decode: " ++ err))
+        Right r -> pure r
+
+-- * JSON 编解码
+
+-- | 一列的 schema；对应 Rust 侧的 SchemaColumn。
+data SchemaColumn = SchemaColumn
+    { scName :: String
+    , scType :: String
+    }
+    deriving (Show, Eq)
+
+-- | SchemaColumn 编码；Haskell 侧只发 DescribeTable，编码用不上，暂存实现。
+instance ToJSON SchemaColumn where
+    toJSON (SchemaColumn n t) = object ["name" .= n, "ty" .= t]
+
+-- | SchemaColumn 解码：从 {"name": "...", "ty": "int"|"str"|"bool"} 读回。
+instance FromJSON SchemaColumn where
+    parseJSON = withObject "SchemaColumn" $ \o -> do
+        n <- o .: "name"
+        t <- o .: "ty"
+        pure (SchemaColumn n t)
+
+-- | 请求；对应 Rust 侧带 method tag 的 enum。
+data Request
+    = ReqPing
+    | ReqScan String
+    | ReqInsert String Row (Maybe Int)
+    | ReqReplaceAll String [Row]
+    | ReqListTables
+    | ReqLookupByKey String Int
+    | ReqDescribeTable String
+
+-- | 请求编码：method 字段 + 各自参数。
+instance ToJSON Request where
+    toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
+    toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
+    toJSON (ReqInsert t r mk) =
+        object $
+            [ "method" .= ("insert" :: T.Text)
+            , "table" .= t
+            , "row" .= rowToJSON r
+            ]
+                ++ case mk of
+                    Nothing -> []
+                    Just k -> ["key" .= k]
+    toJSON (ReqReplaceAll t rs) =
+        object
+            [ "method" .= ("replace_all" :: T.Text)
+            , "table" .= t
+            , "rows" .= map rowToJSON rs
+            ]
+    toJSON ReqListTables = object ["method" .= ("list_tables" :: T.Text)]
+    toJSON (ReqLookupByKey t k) =
+        object
+            [ "method" .= ("lookup_by_index" :: T.Text)
+            , "table" .= t
+            , "key" .= k
+            ]
+    toJSON (ReqDescribeTable t) =
+        object
+            [ "method" .= ("describe_table" :: T.Text)
+            , "table" .= t
+            ]
+
+-- | 响应；对应 Rust 侧带 status tag 的 enum。
+data Response
+    = RespPong
+    | RespRows [Row]
+    | RespTables [String]
+    | RespSchema [SchemaColumn]
+    | RespOk
+    | RespError String
+
+-- | 响应解码：按 status 字段分派。
+instance FromJSON Response where
+    parseJSON = withObject "Response" $ \o -> do
+        status <- o .: "status"
+        case status :: T.Text of
+            "pong" -> pure RespPong
+            "ok" -> pure RespOk
+            "rows" -> RespRows <$> (o .: "rows" >>= mapM rowFromJSON)
+            "tables" -> RespTables <$> o .: "tables"
+            "schema" -> RespSchema <$> o .: "columns"
+            "error" -> RespError <$> o .: "message"
+            other -> fail ("unknown status: " ++ T.unpack other)
+
+-- | Value 编码成 JSON 的 number / string / bool。
+valueToJSON :: Value -> A.Value
+valueToJSON (VInt n) = A.Number (fromIntegral n)
+valueToJSON (VStr s) = A.String (T.pack s)
+valueToJSON (VBool b) = A.Bool b
+
+-- | JSON 解回 Value；number 只接受整数。
+valueFromJSON :: A.Value -> Parser Value
+valueFromJSON (A.Number n) =
+    case floatingOrInteger n :: Either Double Integer of
+        Right i -> pure (VInt (fromIntegral i))
+        Left _ -> fail "non-integer number"
+valueFromJSON (A.String s) = pure (VStr (T.unpack s))
+valueFromJSON (A.Bool b) = pure (VBool b)
+valueFromJSON _ = fail "unsupported value type"
+
+-- | 一行编成 JSON object。
+rowToJSON :: Row -> A.Value
+rowToJSON r =
+    A.Object (KM.fromList [(K.fromString k, valueToJSON v) | (k, v) <- r])
+
+-- | JSON object 解成一行。
+rowFromJSON :: A.Value -> Parser Row
+rowFromJSON (A.Object o) = mapM toPair (KM.toList o)
+  where
+    -- \| 解一个键值对。
+    toPair (k, v) = do
+        val <- valueFromJSON v
+        pure (K.toString k, val)
+rowFromJSON _ = fail "row must be a JSON object"
+
+-- * 内部请求封装
+
+-- | 发 Scan 并把结果取成 Either。
+doScan :: String -> IO (Either String [Row])
+doScan t = do
+    resp <- sendRequest (ReqScan t)
+    pure $ case resp of
+        RespRows rows -> Right rows
+        RespError e -> Left e
+        _ -> Left "unexpected response to scan"
+
+-- | 发 Insert（不带索引键）。
+doInsert :: String -> Row -> IO (Either String ())
+doInsert t r = do
+    resp <- sendRequest (ReqInsert t r Nothing)
+    pure $ case resp of
+        RespOk -> Right ()
+        RespError e -> Left e
+        _ -> Left "unexpected response to insert"
+
+-- | 发 Insert（带索引键）。
+doInsertKeyed :: String -> Row -> Int -> IO (Either String ())
+doInsertKeyed t r k = do
+    resp <- sendRequest (ReqInsert t r (Just k))
+    pure $ case resp of
+        RespOk -> Right ()
+        RespError e -> Left e
+        _ -> Left "unexpected response to insert"
+
+-- | 发 ReplaceAll。
+doReplaceAll :: String -> [Row] -> IO (Either String ())
+doReplaceAll t rs = do
+    resp <- sendRequest (ReqReplaceAll t rs)
+    pure $ case resp of
+        RespOk -> Right ()
+        RespError e -> Left e
+        _ -> Left "unexpected response to replace_all"
+
+-- | 发 ListTables。
+doListTables :: IO (Either String [String])
+doListTables = do
+    resp <- sendRequest ReqListTables
+    pure $ case resp of
+        RespTables ts -> Right ts
+        RespError e -> Left e
+        _ -> Left "unexpected response to list_tables"
+
+-- | 发 LookupByIndex。
+doLookupByKey :: String -> Int -> IO (Either String (Maybe Row))
+doLookupByKey t k = do
+    resp <- sendRequest (ReqLookupByKey t k)
+    pure $ case resp of
+        RespRows [] -> Right Nothing
+        RespRows (r : _) -> Right (Just r)
+        RespError e -> Left e
+        _ -> Left "unexpected response to lookup_by_index"
+
+-- | 发 DescribeTable。
+doDescribeTable :: String -> IO (Either String [SchemaColumn])
+doDescribeTable t = do
+    resp <- sendRequest (ReqDescribeTable t)
+    pure $ case resp of
+        RespSchema cols -> Right cols
+        RespError e -> Left e
+        _ -> Left "unexpected response to describe_table"
+
+-- | 把 Rust 的 schema 列转成 Model 的 Column；未知类型降级为 TStr。
+schemaToColumns :: [SchemaColumn] -> [(String, Column)]
+schemaToColumns = map go
+  where
+    -- \| 按 ty 字符串映射成 Column 构造子。
+    go (SchemaColumn n "int") = (n, TInt)
+    go (SchemaColumn n "str") = (n, TStr)
+    go (SchemaColumn n "bool") = (n, TBool)
+    go (SchemaColumn n _) = (n, TStr)
+
+-- | 从若干行推断列名与类型；catalog 拿不到时的兜底。
+inferColumns :: [Row] -> [(String, Column)]
+inferColumns rows = [(n, inferType n) | n <- names]
+  where
+    -- \| 全部出现过的列名。
+    names = nub (concatMap (map fst) rows)
+
+    -- \| 用第一个出现的值推断列类型；找不到就给 TStr。
+    inferType n = case [v | r <- rows, Just v <- [lookup n r]] of
+        (VInt _ : _) -> TInt
+        (VStr _ : _) -> TStr
+        (VBool _ : _) -> TBool
+        [] -> TStr
+
+-- | 先 describe 拿列，再 scan 拿行；describe 拿不到时退回扫行推断。
+loadTable :: String -> IO Table
+loadTable t = do
+    schemaR <- doDescribeTable t
+    case schemaR of
+        Right cols -> do
+            rowsR <- doScan t
+            case rowsR of
+                Right rows -> pure (Table t (schemaToColumns cols) rows)
+                Left _ -> pure (Table t (schemaToColumns cols) [])
+        Left _ -> do
+            rowsR <- doScan t
+            case rowsR of
+                Right rows -> pure (Table t (inferColumns rows) rows)
+                Left _ -> pure (Table t [] [])
+
+-- * MonadStorage 实例
+
+-- | IPC 实现：所有方法都走管道。
+instance MonadStorage IPCStorage where
+    -- \| 发 Scan。
+    scan t = IPCStorage (doScan t)
+
+    -- \| 发 Insert，不带索引键。
+    insert t r = IPCStorage (doInsert t r)
+
+    -- \| 发 ReplaceAll。
+    replaceAll t rs = IPCStorage (doReplaceAll t rs)
+
+    -- \| 发 LookupByIndex。
+    lookupByKey t k = IPCStorage (doLookupByKey t k)
+
+    -- \| ListTables + 逐表 (describe, scan)，拼成 Database。
+    snapshot = IPCStorage $ do
+        result <- doListTables
+        case result of
+            Left _ -> pure []
+            Right ts -> mapM loadDbEntry ts
+      where
+        -- \| 加载一个 (表名, 表) 对。
+        loadDbEntry t = do
+            tbl <- loadTable t
+            pure (t, tbl)

chusql-engine/src/ChuSQL/Storage/Memory.hs

@@ -0,0 +1,66 @@
+module ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage)) where
+
+import ChuSQL.Model
+import ChuSQL.Storage
+
+-- | 内存实现：本质是 Database 上的 State，错误通道是 Either String。
+newtype MemoryStorage a = MemoryStorage {runMemoryStorage :: Database -> Either String (a, Database)}
+
+-- | Functor：把 fmap 转发给底下的 State。
+instance Functor MemoryStorage where
+    fmap f (MemoryStorage m) = MemoryStorage $ \db -> do
+        (a, db') <- m db
+        Right (f a, db')
+
+-- | Applicative：转发 pure / <*>。
+instance Applicative MemoryStorage where
+    pure x = MemoryStorage $ \db -> Right (x, db)
+    MemoryStorage mf <*> MemoryStorage ma = MemoryStorage $ \db -> do
+        (f, db1) <- mf db
+        (a, db2) <- ma db1
+        Right (f a, db2)
+
+-- | Monad：顺序执行，把动作转发给底下的 State。
+instance Monad MemoryStorage where
+    MemoryStorage m >>= k = MemoryStorage $ \db -> do
+        (a, db') <- m db
+        runMemoryStorage (k a) db'
+
+-- | MonadStorage 实例：内存里直接改 Database。
+instance MonadStorage MemoryStorage where
+    -- \| 按名查表，返回所有行。
+    scan t = MemoryStorage $ \db -> do
+        tbl <- lookupTable db t
+        Right (Right (tableRows tbl), db)
+
+    -- \| 追加一行到表尾。
+    insert t r = MemoryStorage $ \db -> do
+        tbl <- lookupTable db t
+        Right (Right (), replaceTable t tbl{tableRows = tableRows tbl ++ [r]} db)
+
+    -- \| 用新行列表替换整表内容。
+    replaceAll t rows = MemoryStorage $ \db -> do
+        tbl <- lookupTable db t
+        Right (Right (), replaceTable t tbl{tableRows = rows} db)
+
+    -- \| 找 id 列等于 k 的第一行。
+    lookupByKey t k = MemoryStorage $ \db -> do
+        tbl <- lookupTable db t
+        Right (Right (findRow tbl k), db)
+
+    -- \| 原样返回当前数据库。
+    snapshot = MemoryStorage $ \db -> Right (db, db)
+
+-- | 按 id 列匹配一个整数。
+findRow :: Table -> Int -> Maybe Row
+findRow tbl k = case filter matches (tableRows tbl) of
+    (r : _) -> Just r
+    [] -> Nothing
+  where
+    -- \| 这行的 id 列是否等于 k。
+    matches r = lookup "id" r == Just (VInt k)
+
+-- | 用给定表替换同名表；不存在就原样返回。
+replaceTable :: String -> Table -> Database -> Database
+replaceTable name table =
+    map (\(n, t) -> if n == name then (n, table) else (n, t))

chusql-engine/src/ChuSQL/Syntax/AST.hs

@@ -1,5 +1,7 @@
 module ChuSQL.Syntax.AST (Query (..), FromClause (..), Expr (..), SortDir (..), makeSelect) where
 
+-- SQL 语法树：四类语句（SELECT / INSERT / DELETE / UPDATE）+ 表达式、FROM 从句、排序方向。
+
 -- 查询语句
 data Query
     = Select
@@ -14,7 +16,7 @@ data Query
     | Update String [(String, Expr)] (Maybe Expr)
     deriving (Show, Eq)
 
--- 从句
+-- FROM 从句：单表或 JOIN。
 data FromClause
     = FromTable (Maybe String) String
     | FromJoin FromClause (Maybe String) String Expr
@@ -33,11 +35,13 @@ data Expr
     | Or Expr Expr
     deriving (Show, Eq)
 
+-- 排序方向
 data SortDir
     = Asc
     | Desc
     deriving (Show, Eq)
 
+-- 便捷构造：造一条最简单的 SELECT（给测试和演示用）。
 makeSelect :: [String] -> String -> Maybe Expr -> Query
 makeSelect cols tbl w =
     Select

chusql-engine/src/ChuSQL/Syntax/Parser.hs

@@ -1,10 +1,5 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
-{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.Syntax.AST.Query'。
-
-词法层负责空白、关键字、标识符、字面量与符号；语法层按
-优先级 比较 > AND > OR 自底向上组装表达式。
--}
 module ChuSQL.Syntax.Parser (parseQuery) where
 
 import ChuSQL.Syntax.AST
@@ -17,6 +12,9 @@ import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer qualified as Lxr
 
+-- SQL 解析器：把 SQL 文本解析成 AST。词法层管空白、关键字、标识符、字面量与符号；
+-- 语法层按优先级 比较 > AND > OR 自底向上组装表达式。
+
 type Parser = Parsec Void String
 
 -- * 词法层
@@ -29,12 +27,12 @@ sc = Lxr.space space1 empty empty
 lexeme :: Parser a -> Parser a
 lexeme = Lxr.lexeme sc
 
+-- | 匹配一个符号（如 ","、"("），并吃掉其后的空白。
 symbol :: String -> Parser String
 symbol = Lxr.symbol sc
 
-{- | 大小写不敏感的关键字；其后不能紧跟标识符字符，避免把 @selection@ 读成 @select@。
-整体用 'try' 包住：否则 @ORDER@ 会被 @keyword "or"@ 吃掉前缀 @OR@ 再报错，导致无法回溯。
--}
+-- | 大小写不敏感的关键字；其后不能紧跟标识符字符，避免把 @selection@ 读成 @select@。
+-- 整体用 'try' 包住：否则 @ORDER@ 会被 @keyword "or"@ 吃掉前缀 @OR@ 再报错，导致无法回溯。
 keyword :: String -> Parser ()
 keyword k = lexeme $ try $ do
     _ <- string' k
@@ -47,6 +45,7 @@ identifier = lexeme $ do
     rest <- many (satisfy isIdentChar)
     return (first : rest)
 
+-- | 标识符允许的字符：字母、数字或下划线。
 isIdentChar :: Char -> Bool
 isIdentChar ch = isAlphaNum ch || ch == '_'
 
@@ -62,9 +61,8 @@ stringLit = lexeme $ do
     _ <- char '\''
     return s
 
-{- | 字符串内的一个字符：@''@ 折叠成一个单引号，其余字符（含反斜杠）原样保留。
-两个分支都不会在失败时消耗输入，因此可以安全地放进 'many'。
--}
+-- | 字符串内的一个字符：@''@ 折叠成一个单引号，其余字符（含反斜杠）原样保留。
+-- 两个分支都不会在失败时消耗输入，因此可以安全地放进 'many'。
 stringChar :: Parser Char
 stringChar =
     choice
@@ -95,9 +93,8 @@ qualifiedName = do
 expr :: Parser Expr
 expr = makeExprParser atom operatorTable
 
-{- | 运算符表。注意 'makeExprParser' 要求各层 **按优先级从高到低** 排列：
-比较运算符绑定最紧，'AND' 次之，'OR' 最松。
--}
+-- | 运算符表。注意 'makeExprParser' 要求各层按优先级从高到低排列：
+-- 比较运算符绑定最紧，'AND' 次之，'OR' 最松。
 operatorTable :: [[Operator Parser Expr]]
 operatorTable =
     [
@@ -128,12 +125,14 @@ orderItem = do
     dir <- sortDir
     return (col, dir)
 
+-- | @ORDER BY col [ASC|DESC], ...@。
 orderByClause :: Parser [(String, SortDir)]
 orderByClause = do
     keyword "order"
     keyword "by"
     sepBy1 orderItem (symbol ",")
 
+-- | @col = expr@，用于 UPDATE 的 SET 子句。
 assignment :: Parser (String, Expr)
 assignment = do
     col <- identifier
@@ -141,7 +140,7 @@ assignment = do
     e <- expr
     return (col, e)
 
--- | 从句语法
+-- * 从句层
 
 -- | SQL 保留字，不能用作表别名
 reservedWords :: [String]
@@ -166,21 +165,22 @@ reservedWords =
     , "set"
     ]
 
-{- | 表别名。别名不能是保留字：否则 @FROM users WHERE age > 18@ 会把 @WHERE@
-当成 @users@ 的别名吃掉，后面真正的 WHERE 子句就再也解析不到。
-用 'try' 包住，一旦命中保留字就整体回溯，让 'optional' 正常返回 'Nothing'。
--}
+-- | 表别名。别名不能是保留字：否则 @FROM users WHERE age > 18@ 会把 @WHERE@
+-- 当成 @users@ 的别名吃掉，后面真正的 WHERE 子句就再也解析不到。
+-- 用 'try' 包住，一旦命中保留字就整体回溯，让 'optional' 正常返回 'Nothing'。
 aliasName :: Parser String
 aliasName = try $ do
     name <- identifier
     if map toLower name `elem` reservedWords then empty else return name
 
+-- | @表名 [别名]@。
 tableRef :: Parser (Maybe String, String)
 tableRef = do
     tbl <- identifier
     mAlias <- optional aliasName
     return (mAlias, tbl)
 
+-- | @JOIN 表 [别名] ON 条件@。
 joinClause :: Parser (Maybe String, String, Expr)
 joinClause = do
     keyword "join"
@@ -189,6 +189,7 @@ joinClause = do
     cond <- expr
     return (mAlias, tbl, cond)
 
+-- | FROM 从句：一张表 + 任意多个 JOIN。
 fromClause :: Parser FromClause
 fromClause = do
     (mAlias, tbl) <- tableRef