实现基本关系代数运算，JOIN跨表查询

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

@@ -0,0 +1,39 @@
+module ChuSQL.Algebra.Eval where
+
+import ChuSQL.Algebra.Op
+import ChuSQL.Model
+import ChuSQL.SQLSyntax.Expr (evalCondForRow)
+import ChuSQL.SQLSyntax.Sort (sortRows)
+import Control.Monad (filterM)
+
+-- 投影
+project :: [String] -> Row -> Row
+project ["*"] row = row
+project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
+
+-- 执行关系代数运算
+addPrefix :: String -> Row -> Row
+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)
+    let prefix = maybe "" (++ ".") mAlias
+    Right (map (addPrefix prefix) (tableRows table))
+evalRelOp db (Filter e op) = do
+    rows <- evalRelOp db op
+    filterM (evalCondForRow e) rows
+evalRelOp db (Project cols op) = do
+    rows <- evalRelOp db op
+    Right (map (project cols) rows)
+evalRelOp db (Sort spec op) = do
+    rows <- evalRelOp db op
+    Right (sortRows spec rows)
+evalRelOp db (Limit n op) = do
+    rows <- evalRelOp db op
+    Right (take n rows)
+evalRelOp db (Join left right cond) = do
+    lrows <- evalRelOp db left
+    rrows <- evalRelOp db right
+    let cross = [l ++ r | l <- lrows, r <- rrows] -- 笛卡尔积
+    filterM (evalCondForRow cond) cross

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

@@ -0,0 +1,13 @@
+module ChuSQL.Algebra.Op where
+
+import ChuSQL.SQLSyntax.AST (Expr, SortDir)
+
+-- 关系代数算子
+data RelOp
+    = Scan (Maybe String) String
+    | Filter Expr RelOp
+    | Project [String] RelOp
+    | Sort [(String, SortDir)] RelOp
+    | Limit Int RelOp
+    | Join RelOp RelOp Expr
+    deriving (Show, Eq)

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

@@ -0,0 +1,73 @@
+module ChuSQL.Algebra.Planner 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
+
+-- 内部查询语句转执行计划
+fromToRelOp :: FromClause -> RelOp
+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
+    Select
+        { selectCols = cols
+        , selectFrom = fromC
+        , selectWhere = mWhere
+        , 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
+                    Just w -> Filter w base
+                sorted = case orderBy of
+                    [] -> filtered
+                    spec -> Sort spec filtered
+                limited = case mLimit of
+                    Nothing -> sorted
+                    Just n -> Limit n sorted
+            Right (Project cols limited)
+    _ -> Left "only SELECT is supported by translate"

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

@@ -1,10 +1,10 @@
-module ChuSQL.Syntax.Ast where
+module ChuSQL.SQLSyntax.AST where
 
 -- 查询语句
 data Query
     = Select
         { selectCols :: [String]
-        , selectTable :: String
+        , selectFrom :: FromClause
         , selectWhere :: Maybe Expr
         , selectOrderBy :: [(String, SortDir)]
         , selectLimit :: Maybe Int
@@ -14,6 +14,12 @@ data Query
     | Update String [(String, Expr)] (Maybe Expr)
     deriving (Show, Eq)
 
+-- 从句
+data FromClause
+    = FromTable (Maybe String) String
+    | FromJoin FromClause (Maybe String) String Expr
+    deriving (Show, Eq)
+
 -- 条件表达式
 data Expr
     = Col String
@@ -35,7 +41,7 @@ makeSelect :: [String] -> String -> Maybe Expr -> Query
 makeSelect cols tbl w =
     Select
         { selectCols = cols
-        , selectTable = tbl
+        , selectFrom = FromTable Nothing tbl
         , selectWhere = w
         , selectOrderBy = []
         , selectLimit = Nothing

chusql-engine/src/ChuSQL/SQLSyntax/Executor.hs

@@ -1,16 +1,12 @@
-module ChuSQL.Eval.Executor where
+module ChuSQL.SQLSyntax.Executor where
 
-import ChuSQL.Eval.Expr
-import ChuSQL.Eval.Sort
+import ChuSQL.Algebra.Eval (evalRelOp)
+import ChuSQL.Algebra.Planner (translate)
 import ChuSQL.Model
-import ChuSQL.Syntax.Ast
+import ChuSQL.SQLSyntax.AST
+import ChuSQL.SQLSyntax.Expr (evalCondForRow, evalExpr)
 import Control.Monad (filterM)
 
--- | 带限制的排序
-applyLimit :: Maybe Int -> [Row] -> [Row]
-applyLimit Nothing rows = rows
-applyLimit (Just n) rows = take n rows
-
 -- 表里加新行
 updateTable :: String -> (Table -> Table) -> Database -> Either String Database
 updateTable name f db = do
@@ -30,28 +26,10 @@ applyUpdates ((col, e) : rest) row = do
 
 -- 处理查询
 runQuery :: Database -> Query -> Either String (Database, [Row])
-runQuery
-    db
-    Select
-        { selectCols = cols
-        , selectTable = tbl
-        , selectWhere = mWhere
-        , selectOrderBy = orderBy
-        , selectLimit = mLimit
-        } = do
-        table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
-        _ <- checkColumns (tableCols table) cols
-        _ <- checkColumns (tableCols table) (map fst orderBy)
-        rows <- case mWhere of
-            Nothing -> Right (tableRows table)
-            Just e -> filterM (evalCondForRow e) (tableRows table)
-        let sorted = sortRows orderBy rows
-            limited = applyLimit mLimit sorted
-        Right (db, map (project cols) limited)
-      where
-        project :: [String] -> Row -> Row
-        project ["*"] row = row
-        project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
+runQuery db q@Select{} = do
+    relOp <- translate db q
+    rows <- evalRelOp db relOp
+    Right (db, rows)
 
 -- 处理插入
 runQuery db (Insert tbl cols vals) = do
@@ -95,10 +73,3 @@ runQuery db (Update tbl assigns mWhere) = do
         if keep
             then applyUpdates asgns row
             else Right row
-
--- 显式请求的列必须存在（@*@ 表示全部列），避免静默返回一堆空行
-checkColumns :: [String] -> [String] -> Either String ()
-checkColumns available requested =
-    case [c | c <- requested, c /= "*", c `notElem` available] of
-        [] -> Right ()
-        (c : _) -> Left ("unknown column: " ++ c)

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

@@ -1,7 +1,7 @@
-module ChuSQL.Eval.Expr where
+module ChuSQL.SQLSyntax.Expr where
 
 import ChuSQL.Model
-import ChuSQL.Syntax.Ast
+import ChuSQL.SQLSyntax.AST
 import Control.Monad (join)
 
 -- 表达式求值

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

@@ -1,11 +1,11 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
-{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.Syntax.Ast.Query'。
+{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.SQLSyntax.AST.Query'。
 
 词法层负责空白、关键字、标识符、字面量与符号；语法层按
 优先级 比较 > AND > OR 自底向上组装表达式。
 -}
-module ChuSQL.Syntax.Parser (
+module ChuSQL.SQLSyntax.Parser (
     Parser,
     parseQuery,
     expr,
@@ -14,9 +14,10 @@ module ChuSQL.Syntax.Parser (
     stringLit,
 ) where
 
-import ChuSQL.Syntax.Ast
+import ChuSQL.SQLSyntax.AST
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
-import Data.Char (isAlpha, isAlphaNum)
+import Data.Char (isAlpha, isAlphaNum, toLower)
+import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
 import Data.Void (Void)
 import Text.Megaparsec
@@ -88,6 +89,13 @@ limitClause = do
     keyword "limit"
     integer
 
+-- | 解析JOIN和限定列名
+qualifiedName :: Parser String
+qualifiedName = do
+    first <- identifier
+    rest <- many (symbol "." *> identifier)
+    return (intercalate "." (first : rest))
+
 -- * 表达式层
 
 -- | 表达式入口，最低优先级。
@@ -114,7 +122,7 @@ atom =
     choice
         [ LitInt <$> integer
         , LitStr <$> stringLit
-        , Col <$> identifier
+        , Col <$> qualifiedName
         , between (symbol "(") (symbol ")") expr
         ]
 
@@ -123,7 +131,7 @@ atom =
 -- | 显式指定排序的语句
 orderItem :: Parser (String, SortDir)
 orderItem = do
-    col <- identifier
+    col <- qualifiedName
     dir <- sortDir
     return (col, dir)
 
@@ -140,28 +148,82 @@ assignment = do
     e <- expr
     return (col, e)
 
+-- | 从句语法
+
+-- | SQL 保留字，不能用作表别名
+reservedWords :: [String]
+reservedWords =
+    [ "select"
+    , "from"
+    , "where"
+    , "order"
+    , "by"
+    , "limit"
+    , "join"
+    , "on"
+    , "and"
+    , "or"
+    , "asc"
+    , "desc"
+    , "insert"
+    , "into"
+    , "values"
+    , "delete"
+    , "update"
+    , "set"
+    ]
+
+{- | 表别名。别名不能是保留字：否则 @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)
+
+joinClause :: Parser (Maybe String, String, Expr)
+joinClause = do
+    keyword "join"
+    (mAlias, tbl) <- tableRef
+    keyword "on"
+    cond <- expr
+    return (mAlias, tbl, cond)
+
+fromClause :: Parser FromClause
+fromClause = do
+    (mAlias, tbl) <- tableRef
+    joins <- many joinClause
+    return (foldl (\acc (a, t, c) -> FromJoin acc a t c) (FromTable mAlias tbl) joins)
+
 -- | 选择列表：@*@ 或逗号分隔的列名。
 selectList :: Parser [String]
 selectList =
     choice
         [ ["*"] <$ symbol "*"
-        , (:) <$> identifier <*> many (symbol "," *> identifier)
+        , (:) <$> qualifiedName <*> many (symbol "," *> qualifiedName)
         ]
 
 -- | @SELECT ... FROM ... [WHERE ...]@。
 selectQuery :: Parser Query
 selectQuery = do
-    _ <- keyword "select"
+    keyword "select"
     cols <- selectList
-    _ <- keyword "from"
-    tableName <- identifier
+    keyword "from"
+    fromC <- fromClause
     mWhere <- optional (keyword "where" *> expr)
     orderBy <- fromMaybe [] <$> optional orderByClause
     mLimit <- optional limitClause
     return
         Select
             { selectCols = cols
-            , selectTable = tableName
+            , selectFrom = fromC
             , selectWhere = mWhere
             , selectOrderBy = orderBy
             , selectLimit = mLimit

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

@@ -1,7 +1,7 @@
-module ChuSQL.Eval.Sort where
+module ChuSQL.SQLSyntax.Sort where
 
 import ChuSQL.Model
-import ChuSQL.Syntax.Ast
+import ChuSQL.SQLSyntax.AST
 import Data.List (sortBy)
 
 -- | 反向排序