完成语义检查,整理项目

This commit is contained in:
LIm1tZz7 committed 2026-09-22 21:26:54 +08:00
1 parent 0791fe0446
commit 91ce26d7f0
17 files changed
+447 -301

No files matched your search

+6 -21
View File
@@ -17,6 +17,7 @@
作为函数式编程语言,从语言层面契合SQL语句解析和代数数学运算,同时有强大的类型安全系统。
- SQL词法分析、AST
- 语义分析:表/列存在性与类型检查(执行前的关卡)
- 事务处理
- 查询优化、内存表管理
- 关系代数运算
@@ -41,22 +42,6 @@
> 如果找到了较好的Rust+Haskell集成方法也会及时替换
# 代码规模
| 语言 / 类别 | 文件数 | 行数 | 说明 |
| --------------- | -----: | -------: | --------------------------------------------------------------- |
| Haskell(引擎) | 11 | 902 | `chusql-engine/src/` 10 个模块 + `app/Main.hs` |
| Haskell(测试) | 1 | 1058 | `test/Spec.hs`,124 条用例 |
| Haskell(基准) | 1 | 118 | `benchmark/chusql-engine/src/Main.hs` |
| Rust | 0 | 0 | `chusql-storage/` 尚未开工 |
| 前端 | 0 | 0 | `chusql-web/` 尚未开工 |
| Markdown 文档 | 6 | 1456 | `README.md` + `docs/` 3 篇 + `benchmark/` 2 篇 |
| 构建 / 配置 | 9 | 231 | cabal、`stack.yaml(.lock)`、`tasks.json`、`.gitignore`、LICENSE |
| 项目计划 | 1 | 368 | `chusql-engine/projectplan.txt` |
| **合计** | **29** | **4133** | 另有 3 个 `.gitkeep` 占位文件未计入 |
> 最近更新:2026-09-19
# 性能基准
**测试环境**:Windows / GHC 9.10.3 / `-O2`
@@ -65,9 +50,9 @@
| 查询 | 结果行数 | 未优化 | 优化后 | 加速 |
| ------------------------------------------ | -------: | -------: | ----------: | --------: |
| `JOIN` + `WHERE u.age > 90` | 45 | 125.0 ms | **7.1 ms** | **17.7x** |
| `JOIN`(无 WHERE,只有投影) | 500 | 132.8 ms | 105.5 ms | 1.3x |
| `JOIN` + `WHERE` + `ORDER BY` + `LIMIT 10` | 10 | 171.9 ms | **10.3 ms** | **16.8x** |
| 单表 `WHERE age > 90`(对照组) | 45 | 0.111 ms | 0.153 ms | 0.7x |
| `JOIN` + `WHERE u.age > 90` | 45 | 242.2 ms | **16.6 ms** | **14.6x** |
| `JOIN`(无 WHERE,只有投影) | 500 | 210.9 ms | 195.3 ms | 1.1x |
| `JOIN` + `WHERE` + `ORDER BY` + `LIMIT 10` | 10 | 164.1 ms | **14.2 ms** | **11.6x** |
| 单表 `WHERE age > 90`(对照组) | 45 | 0.175 ms | 0.290 ms | 0.6x |
> 最近更新:2026-09-19
> 最近更新:2026-09-22(绝对值受机器状态影响,倍率更稳定;同机同法可复现)
+24 -18
View File
@@ -4,8 +4,9 @@ import ChuSQL.Algebra.Eval (evalRelOp)
import ChuSQL.Algebra.Optimize (optimize)
import ChuSQL.Algebra.Planner (translate)
import ChuSQL.Model
import ChuSQL.SQLSyntax.Parser (parseQuery)
import ChuSQL.Syntax.Parser (parseQuery)
import Control.Exception (evaluate)
import Data.IORef (IORef, newIORef, readIORef)
import System.CPUTime (getCPUTime)
import System.Environment (getArgs)
import Text.Printf (printf)
@@ -14,7 +15,7 @@ mkUsers :: Int -> Table
mkUsers n =
Table
{ tableName = "users"
, tableCols = ["id", "name", "age"]
, tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
, tableRows =
[ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (i `mod` 100))]
| i <- [1 .. n]
@@ -25,7 +26,7 @@ mkOrders :: Int -> Int -> Table
mkOrders n m =
Table
{ tableName = "orders"
, tableCols = ["id", "user_id", "product"]
, tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
, tableRows =
[ [("id", VInt j), ("user_id", VInt (1 + (j - 1) `mod` n)), ("product", VStr ("item" ++ show (j `mod` 50)))]
| j <- [1 .. m]
@@ -43,17 +44,21 @@ rowCount :: Either String [Row] -> Int
rowCount (Left _) = -1
rowCount (Right rows) = length rows
runOnce :: Database -> String -> Bool -> IO Int
runOnce db sql useOpt = do
let result = case parseQuery sql >>= translate db of
-- salt 是从 IORef 里读出来的:有了这个"IO 里来的"依赖,GHC 就没法把整段纯计算
-- 提到循环外只算一次 —— 否则批量计时会把 1 次的开销除以 k,测出 0.000 ms 这种假数据
runOnce :: IORef String -> Database -> String -> Bool -> IO Int
runOnce saltRef db sql useOpt = do
salt <- readIORef saltRef
let result = case parseQuery (sql ++ salt) >>= translate of
Left e -> Left e
Right plan -> evalRelOp db (if useOpt then optimize db plan else plan)
forced <- evaluate (checksum result)
return forced
resultRows :: Database -> String -> Bool -> IO Int
resultRows db sql useOpt = do
let result = case parseQuery sql >>= translate db of
resultRows :: IORef String -> Database -> String -> Bool -> IO Int
resultRows saltRef db sql useOpt = do
salt <- readIORef saltRef
let result = case parseQuery (sql ++ salt) >>= translate of
Left e -> Left e
Right plan -> evalRelOp db (if useOpt then optimize db plan else plan)
_ <- evaluate (checksum result)
@@ -73,12 +78,12 @@ benchOp target act = loop 1
t <- timed (mapM_ (const act) [1 .. k])
if t < target then loop (k * 2) else return (t / fromIntegral k, k)
report :: Database -> Double -> String -> IO ()
report db target sql = do
nUn <- resultRows db sql False
nOp <- resultRows db sql True
(tUn, kUn) <- benchOp target (runOnce db sql False)
(tOp, kOp) <- benchOp target (runOnce db sql True)
report :: IORef String -> Database -> Double -> String -> IO ()
report saltRef db target sql = do
nUn <- resultRows saltRef db sql False
nOp <- resultRows saltRef db sql True
(tUn, kUn) <- benchOp target (runOnce saltRef db sql False)
(tOp, kOp) <- benchOp target (runOnce saltRef db sql True)
let speedup = if tOp <= 0 then 0 else tUn / tOp
mismatch = if nUn == nOp then "" else " <<< 结果不一致!"
printf "%s\n" sql
@@ -113,6 +118,7 @@ main = do
printf "数据规模:users = %d 行,orders = %d 行\n" n m
printf "计时方式:CPU 时间;每个用例自动加倍批量次数,直到一批累计耗时超过 %.2f 秒,再折算成单次耗时\n" target
printf "(先跑一遍预热,避免把首次构造数据的开销算进去)\n\n"
_ <- runOnce db warmupSql False
_ <- runOnce db warmupSql True
mapM_ (report db target) queries
saltRef <- newIORef ""
_ <- runOnce saltRef db warmupSql False
_ <- runOnce saltRef db warmupSql True
mapM_ (report saltRef db target) queries
+10 -37
View File
@@ -1,18 +1,18 @@
module Main where
import ChuSQL.Algebra.Op (RelOp (..))
import ChuSQL.Algebra.Op (renderPlan)
import ChuSQL.Algebra.Optimize (optimize)
import ChuSQL.Algebra.Planner (translate)
import ChuSQL.Engine
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Executor
import ChuSQL.SQLSyntax.Parser
import ChuSQL.Syntax.AST
import ChuSQL.Syntax.Parser
users :: Table
users =
Table
{ tableName = "users"
, tableCols = ["id", "name", "age"]
, tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
, tableRows =
[ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
@@ -24,7 +24,7 @@ orders :: Table
orders =
Table
{ tableName = "orders"
, tableCols = ["id", "user_id", "product"]
, tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
, tableRows =
[ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
, [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
@@ -35,13 +35,9 @@ orders =
db :: Database
db = [("users", users), ("orders", orders)]
-- runQuery 返回 (更新后的数据库, 结果行);演示只关心结果行
rowsOf :: Either String (Database, [Row]) -> Either String [Row]
rowsOf = fmap snd
main :: IO ()
main = do
putStrLn "==================== Parser Test ====================="
putStrLn "==================== Engine ====================="
let q1 = makeSelect ["name"] "users" (Just (Gt (Col "age") (LitInt 18)))
print (rowsOf (runQuery db q1))
@@ -73,35 +69,12 @@ main = do
\JOIN orders o ON u.id = o.user_id WHERE u.age > 18"
case parseQuery planSql of
Left err -> putStrLn err
Right query -> case translate db query of
Right query -> case translate query of
Left err -> putStrLn err
Right plan -> do
putStrLn "--- plan before optimization ---"
putStrLn (dump 0 plan)
putStrLn (renderPlan plan)
putStrLn "--- plan after optimization ---"
putStrLn (dump 0 (optimize db plan))
putStrLn (renderPlan (optimize db plan))
putStrLn "--- rows ---"
print (rowsOf (runQuery db query))
dump :: Int -> RelOp -> String
dump ind op = case op of
Scan a t ->
pad ++ "Scan " ++ show a ++ " " ++ show t
Filter e x ->
pad ++ "Filter " ++ show e ++ "\n" ++ dump (ind + 1) x
Project c x ->
pad ++ "Project " ++ show c ++ "\n" ++ dump (ind + 1) x
Sort s x ->
pad ++ "Sort " ++ show s ++ "\n" ++ dump (ind + 1) x
Limit n x ->
pad ++ "Limit " ++ show n ++ "\n" ++ dump (ind + 1) x
Join l r c ->
pad
++ "Join on "
++ show c
++ "\n"
++ dump (ind + 1) l
++ "\n"
++ dump (ind + 1) r
where
pad = replicate (ind * 2) ' '
+6 -5
View File
@@ -10,15 +10,16 @@ build-type: Simple
library
hs-source-dirs: src
exposed-modules: ChuSQL.Algebra.Eval
ChuSQL.Algebra.Expr
ChuSQL.Algebra.Op
ChuSQL.Algebra.Optimize
ChuSQL.Algebra.Planner
ChuSQL.Algebra.Sort
ChuSQL.Engine
ChuSQL.Model
ChuSQL.SQLSyntax.AST
ChuSQL.SQLSyntax.Executor
ChuSQL.SQLSyntax.Expr
ChuSQL.SQLSyntax.Parser
ChuSQL.SQLSyntax.Sort
ChuSQL.Semantic
ChuSQL.Syntax.AST
ChuSQL.Syntax.Parser
build-depends: base >= 4.14 && < 5
, megaparsec
, parser-combinators
+4 -4
View File
@@ -1,9 +1,9 @@
module ChuSQL.Algebra.Eval where
module ChuSQL.Algebra.Eval (evalRelOp) where
import ChuSQL.Algebra.Expr (evalCondForRow)
import ChuSQL.Algebra.Op
import ChuSQL.Algebra.Sort (sortRows)
import ChuSQL.Model
import ChuSQL.SQLSyntax.Expr (evalCondForRow)
import ChuSQL.SQLSyntax.Sort (sortRows)
import Control.Monad (filterM)
-- 投影
@@ -17,7 +17,7 @@ addPrefix prefix = map (\(k, v) -> (prefix ++ k, v))
evalRelOp :: Database -> RelOp -> Either String [Row]
evalRelOp db (Scan mAlias tbl) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
table <- lookupTable db tbl
let prefix = maybe "" (++ ".") mAlias
Right (map (addPrefix prefix) (tableRows table))
evalRelOp db (Filter e op) = do
@@ -1,7 +1,7 @@
module ChuSQL.SQLSyntax.Expr where
module ChuSQL.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr) where
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
import ChuSQL.Syntax.AST
import Control.Monad (join)
-- 表达式求值
@@ -17,6 +17,16 @@ 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
colsInExpr (Lt a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Eq a b) = colsInExpr a ++ colsInExpr b
colsInExpr (And a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Or a b) = colsInExpr a ++ colsInExpr b
colsInExpr _ = []
-- 对行计算条件语句
evalCondForRow :: Expr -> Row -> Either String Bool
evalCondForRow e row = do
+16 -2
View File
@@ -1,6 +1,6 @@
module ChuSQL.Algebra.Op where
module ChuSQL.Algebra.Op (RelOp (..), renderPlan) where
import ChuSQL.SQLSyntax.AST (Expr, SortDir)
import ChuSQL.Syntax.AST (Expr, SortDir)
-- 关系代数算子
data RelOp
@@ -11,3 +11,17 @@ data RelOp
| Limit Int RelOp
| Join RelOp RelOp Expr
deriving (Show, Eq)
-- | 把算子树画成缩进文本(演示和调试用)
renderPlan :: RelOp -> String
renderPlan = go 0
where
go ind op = case op of
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
Sort s x -> pad ++ "Sort " ++ show s ++ "\n" ++ go (ind + 1) x
Limit n x -> pad ++ "Limit " ++ show n ++ "\n" ++ go (ind + 1) x
Join l r c -> pad ++ "Join on " ++ show c ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
where
pad = replicate (ind * 2) ' '
+5 -15
View File
@@ -1,22 +1,12 @@
module ChuSQL.Algebra.Optimize where
module ChuSQL.Algebra.Optimize (optimize, pushProject) where
import ChuSQL.Algebra.Op (RelOp (..))
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST (Expr (..))
import ChuSQL.SQLSyntax.Expr (evalExpr)
import ChuSQL.Syntax.AST (Expr (..))
import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
-- * 谓词下推
-- | 收集表达式里用到的列名;谓词下推判断条件归属、常量折叠判断能否求值,都要用它
colsInExpr :: Expr -> [String]
colsInExpr (Col c) = [c]
colsInExpr (Gt a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Lt a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Eq a b) = colsInExpr a ++ colsInExpr b
colsInExpr (And a b) = colsInExpr a ++ colsInExpr b
colsInExpr (Or a b) = colsInExpr a ++ colsInExpr b
colsInExpr _ = []
-- | 一个算子会产出哪些列;返回 ["*"] 表示"全部列,不用挑"
relOpCols :: Database -> RelOp -> [String]
relOpCols db (Filter _ x) = relOpCols db x
@@ -28,7 +18,7 @@ relOpCols db (Join l r _) = relOpCols db l ++ relOpCols db r
relOpCols db (Scan mAlias tbl) =
case lookup tbl db of
Nothing -> []
Just t -> map (prefix ++) (tableCols t)
Just t -> map (prefix ++) (colNames t)
where
prefix = maybe "" (++ ".") mAlias
@@ -85,7 +75,7 @@ pushOne _ op = op
-- | 工具函数
needsAll :: [String] -> Bool
needsAll = elem "*"
needsAll = elem allColumns
pushProject :: Database -> [String] -> RelOp -> RelOp
pushProject db _ (Project cols x) = case pushProject db cols x of
+4 -45
View File
@@ -1,44 +1,7 @@
module ChuSQL.Algebra.Planner where
module ChuSQL.Algebra.Planner (translate) where
import ChuSQL.Algebra.Op
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
-- * 存在性检查
checkColumns :: [String] -> [String] -> Either String ()
checkColumns available requested =
case [c | c <- requested, c /= "*", c `notElem` available] of
[] -> Right ()
(c : _) -> Left ("unknown column: " ++ c)
checkFrom :: Database -> FromClause -> Either String ()
checkFrom db (FromTable _ tbl) =
case lookup tbl db of
Just _ -> Right ()
Nothing -> Left ("unknown table: " ++ tbl)
checkFrom db (FromJoin left _ tbl _) = do
_ <- checkFrom db left
case lookup tbl db of
Just _ -> Right ()
Nothing -> Left ("unknown table: " ++ tbl)
-- | 收集 FromClause 里所有可用的列名
availableColumns :: Database -> FromClause -> Either String [String]
availableColumns db (FromTable mAlias tbl) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
let prefix = maybe "" (++ ".") mAlias
Right (map (prefix ++) (tableCols table))
availableColumns db (FromJoin left mAlias tbl _) = do
lcols <- availableColumns db left
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
let prefix = maybe "" (++ ".") mAlias
Right (lcols ++ map (prefix ++) (tableCols table))
-- | 检查数据库列明
checkColumnsFrom :: Database -> FromClause -> [String] -> Either String ()
checkColumnsFrom db fromC requested = do
available <- availableColumns db fromC
checkColumns available requested
import ChuSQL.Syntax.AST
-- 内部查询语句转执行计划
fromToRelOp :: FromClause -> RelOp
@@ -46,8 +9,8 @@ fromToRelOp (FromTable mAlias tbl) = Scan mAlias tbl
fromToRelOp (FromJoin left mAlias tbl cond) =
Join (fromToRelOp left) (Scan mAlias tbl) cond
translate :: Database -> Query -> Either String RelOp
translate db q = case q of
translate :: Query -> Either String RelOp
translate q = case q of
Select
{ selectCols = cols
, selectFrom = fromC
@@ -55,10 +18,6 @@ translate db q = case q of
, selectOrderBy = orderBy
, selectLimit = mLimit
} -> do
-- 检查所有表和列
_ <- checkFrom db fromC
_ <- checkColumnsFrom db fromC cols
_ <- checkColumnsFrom db fromC (map fst orderBy)
let base = fromToRelOp fromC
filtered = case mWhere of
Nothing -> base
@@ -1,7 +1,7 @@
module ChuSQL.SQLSyntax.Sort where
module ChuSQL.Algebra.Sort (sortRows) where
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
import ChuSQL.Syntax.AST
import Data.List (sortBy)
-- | 反向排序
@@ -1,19 +1,27 @@
module ChuSQL.SQLSyntax.Executor where
module ChuSQL.Engine (runQuery, rowsOf) where
import ChuSQL.Algebra.Eval (evalRelOp)
import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
import ChuSQL.Algebra.Optimize (optimize)
import ChuSQL.Algebra.Planner (translate)
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Expr (evalCondForRow, evalExpr)
import ChuSQL.Semantic (check)
import ChuSQL.Syntax.AST
import Control.Monad (filterM)
-- 表里加新行
updateTable :: String -> (Table -> Table) -> Database -> Either String Database
updateTable name f db = do
table <- maybe (Left ("unknown table: " ++ name)) Right (lookup name db)
let table' = f table
Right (map (\(n, t) -> if n == name then (n, table') else (n, t)) db)
-- | 带检查的查询入口:先做语义检查,再交给下面的执行
runQuery :: Database -> Query -> Either String (Database, [Row])
runQuery db q = do
_ <- check db q
runQueryUnchecked db q
-- | 只要结果行(丢掉更新后的数据库),给演示和测试用
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))
-- 修改表
applyUpdates :: [(String, Expr)] -> Row -> Either String Row
@@ -25,46 +33,40 @@ applyUpdates ((col, e) : rest) row = do
where
setColumn c v r = map (\(k, val) -> if k == c then (k, v) else (k, val)) r
-- 处理查询
runQuery :: Database -> Query -> Either String (Database, [Row])
runQuery db q@Select{} = do
relOp <- translate db q
-- 实际执行(调用方请确保已过 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)
-- 处理插入
runQuery db (Insert tbl cols vals) = do
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
db' <-
updateTable
tbl
(\t -> t{tableRows = tableRows t ++ [newRow]})
db
Right (db', [])
Right (replaceTable tbl table{tableRows = tableRows table ++ [newRow]} db, [])
-- 处理删除
runQuery db (Delete tbl mWhere) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
runQueryUnchecked db (Delete tbl mWhere) = do
table <- lookupTable db tbl
rows <- case mWhere of
Nothing -> Right []
Just e -> filterM (shouldKeep e) (tableRows table)
db' <- updateTable tbl (\t -> t{tableRows = rows}) db
Right (db', [])
Right (replaceTable tbl table{tableRows = rows} db, [])
where
-- 保留 = 条件不成立
shouldKeep :: Expr -> Row -> Either String Bool
shouldKeep e row = not <$> evalCondForRow e row
-- 处理表更新
runQuery db (Update tbl assigns mWhere) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
runQueryUnchecked db (Update tbl assigns mWhere) = do
table <- lookupTable db tbl
rows <- mapM (updateRow mWhere assigns) (tableRows table)
db' <- updateTable tbl (\t -> t{tableRows = rows}) db
Right (db', [])
Right (replaceTable tbl table{tableRows = rows} db, [])
where
updateRow :: Maybe Expr -> [(String, Expr)] -> Row -> Either String Row
updateRow cond asgns row = do
+25 -2
View File
@@ -1,4 +1,11 @@
module ChuSQL.Model where
module ChuSQL.Model (Column (..), Value (..), Row, Table (..), Database, colNames, colType, lookupTable, allColumns) where
-- 列的类型
data Column
= TInt
| TStr
| TBool
deriving (Show, Eq)
-- 列的值:整数、字符串、布尔
data Value
@@ -13,10 +20,26 @@ type Row = [(String, Value)]
-- 一张表
data Table = Table
{ tableName :: String
, tableCols :: [String]
, tableCols :: [(String, Column)]
, tableRows :: [Row]
}
deriving (Show)
-- 数据库:多张表
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 = "*"
+128
View File
@@ -0,0 +1,128 @@
module ChuSQL.Semantic (check) where
import ChuSQL.Algebra.Expr (colsInExpr)
import ChuSQL.Model
import ChuSQL.Syntax.AST
import Data.List (intercalate)
-- * 表与列名解析
-- | 给一批列加上"别名."前缀
prefixColumns :: Maybe String -> [(String, Column)] -> [(String, Column)]
prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
where
prefix = maybe "" (++ ".") mAlias
-- | 走一遍 FROM:算出可用列(带别名前缀),顺手把每个 ON 条件也查了
checkFrom :: Database -> FromClause -> Either String [(String, Column)]
checkFrom db (FromTable mAlias tbl) = do
t <- lookupTable db tbl
Right (prefixColumns mAlias (tableCols t))
checkFrom db (FromJoin left mAlias tbl cond) = do
lcols <- checkFrom db left
t <- lookupTable db tbl
let env = lcols ++ prefixColumns mAlias (tableCols t)
checkBool "ON" env cond
Right env
-- * 列检查与报错
-- | 统一拼一条带"可用列清单"的报错
missingColumn :: String -> String -> [(String, Column)] -> String
missingColumn place c env =
"unknown column in " ++ place ++ ": " ++ c ++ hint
where
hint
| null env = ""
| otherwise = " (available: " ++ intercalate ", " (map fst env) ++ ")"
-- | 请求的列必须都在可用清单里;哨兵 allColumns 表示"全部列",放行
checkColumns :: String -> [(String, Column)] -> [String] -> Either String ()
checkColumns place env requested =
case [c | c <- requested, c /= allColumns, c `notElem` map fst env] of
[] -> Right ()
(c : _) -> Left (missingColumn place c env)
-- * 表达式类型推导
-- | 推出一个表达式的结果类型;列不存在、或类型对不上,都报错
inferExpr :: String -> [(String, Column)] -> Expr -> Either String Column
inferExpr place env (Col c) = maybe (Left (missingColumn place c env)) Right (lookup c env)
inferExpr _ _ (LitInt _) = Right TInt
inferExpr _ _ (LitStr _) = Right TStr
inferExpr _ _ (LitBool _) = Right TBool
inferExpr place env (Gt a b) = operands place env TInt a b
inferExpr place env (Lt a b) = operands place env TInt a b
inferExpr place env (And a b) = operands place env TBool a b
inferExpr place env (Or a b) = operands place env TBool a b
inferExpr place env (Eq a b) = do
ta <- inferExpr place env a
tb <- inferExpr place env b
if ta == tb
then Right TBool
else Left (place ++ ": both sides of = must have the same type, got " ++ show ta ++ " and " ++ show tb)
-- | 二元运算的通用检查:两边都必须是同一种期望类型,结果都是布尔
operands :: String -> [(String, Column)] -> Column -> Expr -> Expr -> Either String Column
operands place env want a b = do
ta <- inferExpr place env a
tb <- inferExpr place env b
if ta == want && tb == want
then Right TBool
else Left (place ++ ": operator needs " ++ show want ++ " on both sides, got " ++ show ta ++ " and " ++ show tb)
-- | 这个表达式必须能算成一个条件(布尔)
checkBool :: String -> [(String, Column)] -> Expr -> Either String ()
checkBool place env e = do
checkColumns place env (colsInExpr e)
t <- inferExpr place env e
if t == TBool
then Right ()
else Left (place ++ ": condition must be a boolean, got " ++ show t)
-- * 写入语句
-- | 一条赋值的通用检查:目标列必须存在,右边表达式的类型要对得上
checkTyped :: String -> [(String, Column)] -> Table -> (String, Expr) -> Either String ()
checkTyped place env t (c, e) = do
want <- maybe (Left (missingColumn place c (tableCols t))) Right (colType t c)
got <- inferExpr place env e
if want == got
then Right ()
else Left (place ++ ": column " ++ c ++ " needs " ++ show want ++ ", got " ++ show got)
-- | INSERT 的一个值:环境是空的 —— 值必须是字面量,写列名会被拦下
checkValue :: Table -> (String, Expr) -> Either String ()
checkValue = checkTyped "INSERT" []
-- | UPDATE 的一个赋值:环境是整张表 —— 右边可以引用本行的列
checkAssign :: Table -> (String, Expr) -> Either String ()
checkAssign t = checkTyped "UPDATE" (tableCols t) t
-- * 总入口
-- | 语义检查总入口:合法返回 Right (),不合法返回 Left(带人话解释)
check :: Database -> Query -> Either String ()
check db q = case q of
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectOrderBy = orderBy
} -> do
env <- checkFrom db fromC
checkColumns "SELECT" env cols
checkColumns "ORDER BY" env (map fst orderBy)
mapM_ (checkBool "WHERE" env) mWhere
Insert tbl cols vals -> do
t <- lookupTable db tbl
checkColumns "INSERT" (tableCols t) cols
mapM_ (checkValue t) (zip cols vals)
Delete tbl mWhere -> do
t <- lookupTable db tbl
mapM_ (checkBool "WHERE" (tableCols t)) mWhere
Update tbl assigns mWhere -> do
t <- lookupTable db tbl
checkColumns "UPDATE" (tableCols t) (map fst assigns)
mapM_ (checkAssign t) assigns
mapM_ (checkBool "WHERE" (tableCols t)) mWhere
@@ -1,4 +1,4 @@
module ChuSQL.SQLSyntax.AST where
module ChuSQL.Syntax.AST (Query (..), FromClause (..), Expr (..), SortDir (..), makeSelect) where
-- 查询语句
data Query
@@ -1,20 +1,13 @@
{-# LANGUAGE ImportQualifiedPost #-}
{- | SQL 语法分析器:把 SQL 文本解析为 'ChuSQL.SQLSyntax.AST.Query'。
{- | SQL 语法分析器:把 SQL 文本解析为 'ChuSQL.Syntax.AST.Query'。
词法层负责空白、关键字、标识符、字面量与符号;语法层按
优先级 比较 &gt; AND &gt; OR 自底向上组装表达式。
-}
module ChuSQL.SQLSyntax.Parser (
Parser,
parseQuery,
expr,
identifier,
integer,
stringLit,
) where
module ChuSQL.Syntax.Parser (parseQuery) where
import ChuSQL.SQLSyntax.AST
import ChuSQL.Syntax.AST
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
import Data.Char (isAlpha, isAlphaNum, toLower)
import Data.List (intercalate)
+171 -22
View File
@@ -1,13 +1,13 @@
module Main where
import ChuSQL.Algebra.Eval (evalRelOp)
import ChuSQL.Algebra.Op (RelOp (..))
import ChuSQL.Algebra.Op (RelOp (..), renderPlan)
import ChuSQL.Algebra.Optimize (optimize, pushProject)
import ChuSQL.Algebra.Planner (translate)
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Executor
import ChuSQL.SQLSyntax.Parser
import ChuSQL.Syntax.AST
import ChuSQL.Engine
import ChuSQL.Syntax.Parser
import Test.Hspec
-- ============================================================
@@ -17,7 +17,7 @@ users :: Table
users =
Table
{ tableName = "users"
, tableCols = ["id", "name", "age"]
, tableCols = [("id", TInt), ("name", TStr), ("age", TInt)]
, tableRows =
[ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
@@ -29,7 +29,7 @@ orders :: Table
orders =
Table
{ tableName = "orders"
, tableCols = ["id", "user_id", "product"]
, tableCols = [("id", TInt), ("user_id", TInt), ("product", TStr)]
, tableRows =
[ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
, [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
@@ -48,7 +48,7 @@ main = hspec $ do
-- ============================================================
-- AST
-- ============================================================
describe "ChuSQL.Syntax.Ast" $ do
describe "ChuSQL.Syntax.AST" $ do
it "equal Selects are equal" $ do
makeSelect ["name"] "users" Nothing
`shouldBe` makeSelect ["name"] "users" Nothing
@@ -247,7 +247,7 @@ main = hspec $ do
-- ============================================================
-- Engine: SELECT
-- ============================================================
describe "ChuSQL.Eval.Engine (SELECT)" $ do
describe "ChuSQL.Engine (SELECT)" $ do
it "returns all rows without WHERE" $ do
rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
`shouldBe` Right
@@ -304,7 +304,7 @@ main = hspec $ do
-- ============================================================
-- Engine: INSERT
-- ============================================================
describe "ChuSQL.Eval.Engine (INSERT)" $ do
describe "ChuSQL.Engine (INSERT)" $ do
it "parses a simple INSERT" $ do
parseQuery "INSERT INTO users (name, age) VALUES ('Dave', 22)"
`shouldBe` Right (Insert "users" ["name", "age"] [LitStr "Dave", LitInt 22])
@@ -353,7 +353,7 @@ main = hspec $ do
-- ============================================================
-- Engine: DELETE
-- ============================================================
describe "ChuSQL.Eval.Engine (DELETE)" $ do
describe "ChuSQL.Engine (DELETE)" $ do
it "parses DELETE with WHERE" $ do
parseQuery "DELETE FROM users WHERE age < 18"
`shouldBe` Right (Delete "users" (Just (Lt (Col "age") (LitInt 18))))
@@ -403,7 +403,7 @@ main = hspec $ do
-- ============================================================
-- Engine: UPDATE
-- ============================================================
describe "ChuSQL.Eval.Engine (UPDATE)" $ do
describe "ChuSQL.Engine (UPDATE)" $ do
it "parses UPDATE with WHERE" $ do
parseQuery "UPDATE users SET age = 26 WHERE name = 'Alice'"
`shouldBe` Right
@@ -495,7 +495,7 @@ main = hspec $ do
-- ============================================================
-- Engine: ORDER BY
-- ============================================================
describe "ChuSQL.Eval.Engine (ORDER BY)" $ do
describe "ChuSQL.Engine (ORDER BY)" $ do
it "parses ORDER BY ASC" $ do
case parseQuery "SELECT name FROM users ORDER BY age ASC" of
Right q -> selectOrderBy q `shouldBe` [("age", Asc)]
@@ -583,7 +583,7 @@ main = hspec $ do
-- ============================================================
-- Engine: LIMIT
-- ============================================================
describe "ChuSQL.Eval.Engine (LIMIT)" $ do
describe "ChuSQL.Engine (LIMIT)" $ do
it "parses LIMIT" $ do
case parseQuery "SELECT * FROM users LIMIT 2" of
Right q -> selectLimit q `shouldBe` Just 2
@@ -666,7 +666,7 @@ main = hspec $ do
-- ============================================================
-- Engine: JOIN
-- ============================================================
describe "ChuSQL.Eval.Engine (JOIN)" $ do
describe "ChuSQL.Engine (JOIN)" $ do
it "executes a two-table JOIN with aliases" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id" >>= runQuery testDB)
`shouldBe` Right
@@ -834,7 +834,7 @@ main = hspec $ do
case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 20" of
Left err -> expectationFailure err
Right q ->
case translate testDB q of
case translate q of
Left err -> expectationFailure err
Right relOp ->
filterPushedIntoLeft (optimize testDB relOp) `shouldBe` True
@@ -843,7 +843,7 @@ main = hspec $ do
case parseQuery "SELECT * FROM users" of
Left err -> expectationFailure err
Right q ->
case translate testDB q of
case translate q of
Left err -> expectationFailure err
Right relOp ->
optimize testDB relOp `shouldBe` Scan Nothing "users"
@@ -857,7 +857,7 @@ main = hspec $ do
case parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 20" of
Left err -> expectationFailure err
Right q ->
case translate testDB q of
case translate q of
Left err -> expectationFailure err
Right relOp ->
optimize testDB (optimize testDB relOp) `shouldBe` optimize testDB relOp
@@ -980,6 +980,154 @@ main = hspec $ do
it "keeps projection with ORDER BY and LIMIT results identical" $ do
sameResultAsUnoptimized "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id ORDER BY o.product DESC LIMIT 2"
-- ============================================================
-- Semantic
-- ============================================================
describe "ChuSQL.Semantic" $ do
it "rejects an unknown column in WHERE" $ do
(parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in WHERE even when the table is empty" $ do
(parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery emptyDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in an ON condition" $ do
(parseQuery "SELECT u.name FROM users u JOIN orders o ON u.nope = o.user_id" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects a type mismatch inside a comparison" $ do
(parseQuery "SELECT name FROM users WHERE name > 18" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects a type mismatch even when the table is empty" $ do
(parseQuery "SELECT name FROM users WHERE name > 18" >>= runQuery emptyDB)
`shouldSatisfy` isLeft
it "rejects a WHERE clause that is not a condition" $ do
(parseQuery "SELECT name FROM users WHERE age" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects a non-boolean WHERE even when the table is empty" $ do
(parseQuery "SELECT name FROM users WHERE age" >>= runQuery emptyDB)
`shouldSatisfy` isLeft
it "rejects comparing two different types with =" $ do
(parseQuery "SELECT name FROM users WHERE name = 18" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in INSERT" $ do
(parseQuery "INSERT INTO users (nickname) VALUES (1)" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects a value whose type does not match the column" $ do
(parseQuery "INSERT INTO users (name, age) VALUES ('Dave', 'abc')" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in UPDATE SET" $ do
(parseQuery "UPDATE users SET nope = 1" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in DELETE WHERE" $ do
(parseQuery "DELETE FROM users WHERE nope > 1" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "still accepts a valid query" $ do
rowsOf (parseQuery "SELECT name FROM users WHERE age > 18" >>= runQuery testDB)
`shouldBe` Right
[ [("name", VStr "Alice")]
, [("name", VStr "Carol")]
]
it "rejects an UPDATE whose value has the wrong type" $ do
(parseQuery "UPDATE users SET age = 'abc'" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects a type mismatch in an ON condition" $ do
(parseQuery "SELECT u.name FROM users u JOIN orders o ON u.name = o.user_id" >>= runQuery testDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in DELETE WHERE even when the table is empty" $ do
(parseQuery "DELETE FROM users WHERE nope > 1" >>= runQuery emptyDB)
`shouldSatisfy` isLeft
it "rejects an unknown column in UPDATE SET even when the table is empty" $ do
(parseQuery "UPDATE users SET nope = 1" >>= runQuery emptyDB)
`shouldSatisfy` isLeft
it "currently allows an INSERT that leaves a column out (known gap)" $ do
(parseQuery "INSERT INTO users (name) VALUES ('Eve')" >>= runQuery testDB)
`shouldSatisfy` isRight
it "says which clause is wrong and which columns are available" $ do
case parseQuery "SELECT name FROM users WHERE nope > 18" >>= runQuery testDB of
Right _ -> expectationFailure "expected a Left"
Left err -> do
err `shouldContain` "unknown column in WHERE"
err `shouldContain` "available: id, name, age"
it "names INSERT when a target column does not exist" $ do
case parseQuery "INSERT INTO users (nickname) VALUES (1)" >>= runQuery testDB of
Right _ -> expectationFailure "expected a Left"
Left err -> err `shouldContain` "unknown column in INSERT"
it "names ORDER BY when a sort key does not exist" $ do
case parseQuery "SELECT name FROM users ORDER BY nope" >>= runQuery testDB of
Right _ -> expectationFailure "expected a Left"
Left err -> err `shouldContain` "unknown column in ORDER BY"
it "names ON and both types when a join condition mismatches" $ do
case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.name = o.user_id" >>= runQuery testDB of
Right _ -> expectationFailure "expected a Left"
Left err -> do
err `shouldContain` "ON: both sides of ="
err `shouldContain` "TStr and TInt"
it "names the column and the expected type when an assignment has the wrong type" $ do
case parseQuery "UPDATE users SET age = 'abc'" >>= runQuery testDB of
Right _ -> expectationFailure "expected a Left"
Left err -> err `shouldContain` "UPDATE: column age needs TInt, got TStr"
it "accepts SELECT * across a join (the sentinel is not a column)" $ do
(parseQuery "SELECT * FROM users u JOIN orders o ON u.id = o.user_id" >>= runQuery testDB)
`shouldSatisfy` isRight
-- ============================================================
-- Op
-- ============================================================
describe "ChuSQL.Algebra.Op" $ do
it "renders a plan as indented text" $ do
case parseQuery "SELECT name FROM users WHERE age > 18" >>= translate of
Left err -> expectationFailure err
Right plan ->
renderPlan plan
`shouldBe` "Project [\"name\"]\n Filter Gt (Col \"age\") (LitInt 18)\n Scan Nothing \"users\""
it "renders a join plan with indentation" $ do
case parseQuery "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id" >>= translate of
Left err -> expectationFailure err
Right plan ->
lines (renderPlan plan)
`shouldBe` [ "Project [\"u.name\"]"
, " Join on Eq (Col \"u.id\") (Col \"o.user_id\")"
, " Scan Just \"u\" \"users\""
, " Scan Just \"o\" \"orders\""
]
it "renders a sort and limit plan" $ do
case parseQuery "SELECT name FROM users ORDER BY age DESC LIMIT 2" >>= translate of
Left err -> expectationFailure err
Right plan ->
lines (renderPlan plan)
`shouldBe` [ "Project [\"name\"]"
, " Limit 2"
, " Sort [(\"age\",Desc)]"
, " Scan Nothing \"users\""
]
emptyDB :: Database
emptyDB = [(n, t {tableRows = []}) | (n, t) <- testDB]
-- ============================================================
-- Helpers
-- ============================================================
@@ -987,15 +1135,16 @@ isLeft :: Either a b -> Bool
isLeft (Left _) = True
isLeft (Right _) = False
rowsOf :: Either String (Database, [Row]) -> Either String [Row]
rowsOf = fmap snd
isRight :: Either a b -> Bool
isRight (Right _) = True
isRight (Left _) = False
sameResultAsUnoptimized :: String -> Expectation
sameResultAsUnoptimized sql =
case parseQuery sql of
Left err -> expectationFailure err
Right q ->
case translate testDB q of
case translate q of
Left err -> expectationFailure err
Right relOp ->
evalRelOp testDB (optimize testDB relOp) `shouldBe` evalRelOp testDB relOp
@@ -1007,7 +1156,7 @@ filterPushedIntoLeft _ = False
optimizedPlan :: String -> Either String RelOp
optimizedPlan sql = do
q <- parseQuery sql
optimize testDB <$> translate testDB q
optimize testDB <$> translate q
firstFilterCond :: RelOp -> Maybe Expr
firstFilterCond (Filter p _) = Just p
@@ -1038,7 +1187,7 @@ stripProjects (Scan a t) = Scan a t
projectedPlan :: String -> Either String RelOp
projectedPlan sql = do
q <- parseQuery sql
plan <- translate testDB q
plan <- translate q
Right (pushProject testDB ["*"] plan)
sideCols :: RelOp -> Maybe [String]
-87
View File
@@ -1,87 +0,0 @@
# 实现要点
完整的实现原理相对复杂,故不多赘述,这里阐述一些关键的实现要点
## Haskell -- 处理引擎
### 词法分析
词法层与语法层同处 `chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs`,基于 **megaparsec** 实现。解析器类型为
```haskell
type Parser = Parsec Void String
```
即输入是 `String`,词法错误类型取 `Void`(不自定义错误类型),失败信息统一由 `errorBundlePretty` 渲染成人可读的报文。
#### 空白与词法单元骨架
| 组合子 | 定义 | 作用 |
| -------- | ------------------------------ | ------------------------------------ |
| `sc` | `Lxr.space space1 empty empty` | 跳过空白(含换行);暂不解析注释 |
| `lexeme` | `Lxr.lexeme sc` | 解析一个词法单元,并吃掉其后的空白 |
| `symbol` | `Lxr.symbol sc` | 固定符号 `*` `,` `=` `>` `<` `(` `)` |
所有词法单元都从 `lexeme` 出口,游标返回时必定停在下一个 token 的起始位置,因此语法层不需要感知空白。
#### 已实现的 token
| token | 组合子 | 词法规则 | 例 |
| -------- | ------------ | ------------------------------------------ | ------------------------ |
| 关键字 | `keyword` | 大小写不敏感;其后不能紧跟标识符字符 | `SELECT` / `select` |
| 标识符 | `identifier` | 首字符为字母或 `_`,其后为字母、数字或 `_` | `users`、`user1`、`_tmp` |
| 整数 | `integer` | 十进制,委托 `Lxr.decimal` | `18` |
| 字符串 | `stringLit` | 单引号包裹,遵循标准 SQL 转义 | `'Alice'` |
| 符号 | `symbol` | 字面匹配 | `>`、`(` |
| 排序方向 | `sortDir` | `ASC` / `DESC`,缺省 `Asc` | `DESC` |
目前已接入语法的关键字:`SELECT`、`FROM`、`WHERE`、`ORDER`、`BY`、`LIMIT`、`AND`、`OR`、`ASC`、`DESC`、`INSERT`、`INTO`、`VALUES`、`DELETE`、`UPDATE`、`SET`。
#### 三个关键实现点
**1. 关键字要防前缀**
`keyword` 匹配完关键字后追加 `notFollowedBy (satisfy isIdentChar)`,否则 `selection` 会被读成 `SELECT`、`fromage` 会被读成 `FROM`。
**2. 关键字必须可回溯(`try`)**
```haskell
keyword k = lexeme $ try $ do
_ <- string' k
notFollowedBy (satisfy isIdentChar)
```
`string'` 大小写不敏感,匹配 `ORDER` 时会先吃掉前两个字符 `OR`;紧接着的前缀守卫因为遇到 `D` 而失败,此时输入已被消耗,这个失败就成了**已消耗失败**,调用方的 `many`(`AND` / `OR` 运算符层)不会回溯而是直接报错:
```text
SELECT name FROM users WHERE age > 18 ORDER BY age DESC
^ unexpected 'D'
```
把整个 `keyword` 用 `try` 包住,失败即复位,`ORDER BY` 才能被后续子句正常识别。这同时消掉了一整类隐患:任何以 `AND` / `OR` 为前缀的子句关键字跟在表达式后面都不会再炸。
**3. 字符串字面量不能用 `manyTill`**
`manyTill p end` 每一步都先尝试结束符,`'It''s ok'` 会在 `''` 的第一个引号处提前收尾。正确做法是先读内容、再吃结尾引号:
```haskell
stringLit = lexeme $ do
_ <- char '\''
s <- many stringChar
_ <- char '\''
return s
stringChar = choice [ '\'' <$ try (string "''"), satisfy (/= '\'') ]
```
`stringChar` 的两个分支在失败时都不消耗输入,因此可以安全地放进 `many`。
#### 字符串字面量与标准 SQL 转义
| 写法 | 含义 |
| --------- | ------------------------------------------------------- |
| `'it''s'` | `''` 折叠为一个单引号,值为 `it's` |
| `'a\b'` | 反斜杠是普通字符,值为 `a\b`(**不**做 `\n`/`\t` 转义) |
| `''` | 空字符串 |
| `''''` | 只含一个单引号的字符串 |
| `'oops` | 未闭合,解析失败 |