大更新：

1、完善SQL语法
2、移除node前端，只保留静态资源
3、写好安装脚本
4、做好linux适配

chusql-engine/chusql-engine.cabal

@@ -28,6 +28,7 @@ library
                     , bytestring
                     , hashable
                     , megaparsec
+                    , network
                     , parser-combinators
                     , scientific
                     , text

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

@@ -1,147 +1,480 @@
-module ChuSQL.Algebra.Eval (evalRelOp, evalRelOpM) where
+module ChuSQL.Algebra.Eval (evalRelOp, evalRelOpM, evalExprM, evalCondForRowM) where
 
-import ChuSQL.Algebra.Expr (evalCondForRow)
+import ChuSQL.Algebra.Expr (evalCondForRow, evalExpr)
+import ChuSQL.Algebra.Optimize (optimize, relOpCols)
 import ChuSQL.Algebra.Op
-import ChuSQL.Algebra.Sort (sortRows)
+import ChuSQL.Algebra.Planner (translate)
+import ChuSQL.Algebra.Sort (compareValue, sortRows)
 import ChuSQL.Model
 import ChuSQL.Storage (IndexResult (..), MonadStorage (..))
-import ChuSQL.Syntax.AST (Expr (..))
+import ChuSQL.Storage.Memory (runMemoryStorage)
+import ChuSQL.Syntax.AST (Expr (..), JoinKind (..), Subquery (..))
 import Control.Monad (filterM, foldM)
 import qualified Data.HashMap.Strict as HM
 
 -- 执行：按算子树算出结果行（Scan 阶段会加别名前缀）。
+-- 外层行 outer 给相关子查询用：子查询里的列先在本层行里找，找不到再落到外层行。
 
--- | 只保留清单里的列
+-- | 只保留清单里的列，顺序按清单（SELECT 的列序就是结果的列序）
 project :: [String] -> Row -> Row
 project ["*"] row = row
-project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
+project cs row = [(c, v) | c <- cs, Just v <- [lookup c row]]
 
 -- | 给列名加别名前缀
 addPrefix :: Maybe String -> Row -> Row
 addPrefix mAlias = map (\(k, v) -> (qualify mAlias k, v))
 
--- | 扫描一张表
-evalScan :: Database -> Maybe String -> String -> Either String [Row]
-evalScan db mAlias tbl = do
-    table <- lookupTable db tbl
-    Right (map (addPrefix mAlias) (tableRows table))
+prefixRows :: Maybe String -> [Row] -> [Row]
+prefixRows mAlias = map (addPrefix mAlias)
+
+-- | 值 → 字面量
+valueLiteral :: Value -> Expr
+valueLiteral (VInt n) = LitInt n
+valueLiteral (VFloat d) = LitFloat d
+valueLiteral (VStr s) = LitStr s
+valueLiteral (VBool b) = LitBool b
+valueLiteral VNull = LitNull
 
 -- | 点查退化成扫描时用的条件
-lookupCondition :: Maybe String -> String -> Int -> Expr
-lookupCondition mAlias col k = Eq (Col (qualify mAlias col)) (LitInt k)
+lookupCondition :: Maybe String -> String -> Value -> Expr
+lookupCondition mAlias col k = Eq (Col (qualify mAlias col)) (valueLiteral k)
+
+-- | 范围扫描退化成扫描时用的条件（闭端写成 > 或 = 的并）
+rangeCondition :: Maybe String -> String -> Maybe (Value, Bool) -> Maybe (Value, Bool) -> Expr
+rangeCondition mAlias col lo hi = case (lo, hi) of
+    (Just l, Just h) -> And (bound Gt l) (bound Lt h)
+    (Just l, Nothing) -> bound Gt l
+    (Nothing, Just h) -> bound Lt h
+    (Nothing, Nothing) -> LitBool True
+  where
+    c = Col (qualify mAlias col)
+    bound rel (v, inclusive)
+        | inclusive = Or (rel c (valueLiteral v)) (Eq c (valueLiteral v))
+        | otherwise = rel c (valueLiteral v)
+
+-- | 一批行的列名（空批给空清单）
+rowsCols :: [Row] -> [String]
+rowsCols (r : _) = map fst r
+rowsCols [] = []
+
+-- | 参与等值匹配的键：NULL 不参与匹配，整数值的浮点归一到整数
+-- （嵌套循环走 compareValues，哈希要对齐它）
+joinKey :: Value -> Maybe Value
+joinKey VNull = Nothing
+joinKey (VFloat d)
+    | not (isNaN d)
+    , not (isInfinite d)
+    , fromIntegral (rounded :: Integer) == d =
+        Just (VInt (fromIntegral rounded))
+  where
+    rounded = round d :: Integer
+joinKey v = Just v
+
+joinKeyOf :: String -> Row -> Maybe Value
+joinKeyOf c row = lookup c row >>= joinKey
 
 data EquiKeys = EquiKeys
     { ekLeft :: String
     , ekRight :: String
     }
 
--- | 一批行的列名（空批给空清单，此时一律退回嵌套循环）
-rowsCols :: [Row] -> [String]
-rowsCols (r : _) = map fst r
-rowsCols [] = []
-
 -- | 认出 a = b 这种两列等值条件，并且能分清谁在左谁在右
-equiKeys :: [Row] -> [Row] -> Expr -> Maybe EquiKeys
-equiKeys lrows rrows (Eq (Col a) (Col b))
+equiKeys :: [String] -> [String] -> Expr -> Maybe EquiKeys
+equiKeys lcols rcols (Eq (Col a) (Col b))
     | a /= b, a `elem` lcols, b `elem` rcols = Just (EquiKeys a b)
     | a /= b, b `elem` lcols, a `elem` rcols = Just (EquiKeys b a)
-  where
-    lcols = rowsCols lrows
-    rcols = rowsCols rrows
 equiKeys _ _ _ = Nothing
 
--- | 哈希连接，输出顺序同嵌套循环
-hashJoin :: EquiKeys -> [Row] -> [Row] -> [Row]
-hashJoin keys lrows rrows = concatMap probe lrows
+-- | 连接：能认出等值键就走哈希，否则退回嵌套循环；左连接没配上的左行补 NULL
+joinRowsIn ::
+    (MonadStorage m) =>
+    Database ->
+    Row ->
+    JoinKind ->
+    [String] ->
+    Expr ->
+    [Row] ->
+    [Row] ->
+    m (Either String [Row])
+joinRowsIn db outer kind rcols cond lrows rrows =
+    case equiKeys (rowsCols lrows) rcols cond of
+        Just ks -> pure (Right (hashJoin kind ks ncols lrows rrows))
+        Nothing -> filterPairsM db outer kind ncols cond lrows rrows
   where
-    buckets =
-        HM.fromListWith
-            (flip (++))
-            [(v, [r]) | r <- rrows, Just v <- [lookup (ekRight keys) r]]
-    probe l = case lookup (ekLeft keys) l of
-        Nothing -> []
-        Just v -> [l ++ r | r <- HM.lookupDefault [] v buckets]
+    -- 右表为空时行上没有列名，用算子推导出来的列名补 NULL
+    ncols = if null rrows then rcols else rowsCols rrows
+
+-- | 左连接里配不上的左行补右表 NULL；内连接里没有匹配就是没行
+unmatched :: JoinKind -> Row -> [String] -> [Row]
+unmatched InnerJoin _ _ = []
+unmatched LeftJoin l cols = [l ++ [(c, VNull) | c <- cols]]
+
+-- | 哈希连接，输出顺序同嵌套循环
+hashJoin :: JoinKind -> EquiKeys -> [String] -> [Row] -> [Row] -> [Row]
+hashJoin kind ks ncols lrows rrows = concatMap probe lrows
+  where
+    buckets = HM.fromListWith (flip (++)) [(v, [r]) | r <- rrows, Just v <- [joinKeyOf (ekRight ks) r]]
+    probe l =
+        let miss = case kind of
+                InnerJoin -> []
+                LeftJoin -> [l ++ nullRow]
+         in case joinKeyOf (ekLeft ks) l of
+                Nothing -> miss
+                Just v -> case HM.lookupDefault [] v buckets of
+                    [] -> miss
+                    rs -> [l ++ r | r <- rs]
+    nullRow = [(c, VNull) | c <- ncols]
 
 -- | 把两边的行按条件配对（边配边筛，不先建整张积表）
-filterPairs :: (Row -> Either String Bool) -> [Row] -> [Row] -> Either String [Row]
-filterPairs cond lrows rrows = go lrows []
+filterPairsM ::
+    (MonadStorage m) =>
+    Database ->
+    Row ->
+    JoinKind ->
+    [String] ->
+    Expr ->
+    [Row] ->
+    [Row] ->
+    m (Either String [Row])
+filterPairsM db outer kind ncols cond lrows rrows = go lrows []
   where
-    go [] acc = Right (reverse acc)
+    go [] acc = pure (Right (reverse acc))
     go (l : ls) acc = do
-        acc' <- foldM (keep l) acc rrows
-        go ls acc'
-    keep l acc r = do
-        let row = l ++ r
-        ok <- cond row
-        pure (if ok then row : acc else acc)
+        hits <- keep l rrows []
+        case hits of
+            Left e -> pure (Left e)
+            Right hs -> do
+                let hs' = case (kind, hs) of
+                        (LeftJoin, []) -> [l ++ nullRow]
+                        _ -> hs
+                go ls (reverse hs' ++ acc)
+    keep _ [] acc = pure (Right (reverse acc))
+    keep l (r : rs) acc = do
+        ok <- evalCondForRowM db cond (l ++ r ++ outer)
+        case ok of
+            Left e -> pure (Left e)
+            Right True -> keep l rs ((l ++ r) : acc)
+            Right False -> keep l rs acc
+    nullRow = [(c, VNull) | c <- ncols]
 
--- | 一次连接：能认出等值键就走哈希，否则退回嵌套循环
-joinRows :: Expr -> [Row] -> [Row] -> Either String [Row]
-joinRows cond lrows rrows = case equiKeys lrows rrows cond of
-    Just keys -> Right (hashJoin keys lrows rrows)
-    Nothing -> filterPairs (evalCondForRow cond) lrows rrows
+-- | 索引连接：右表是裸 Scan 时逐左行点查，返回 Nothing 表示该走通用路径
+probeIndexJoin ::
+    (MonadStorage m) =>
+    Database ->
+    Row ->
+    JoinKind ->
+    Maybe String ->
+    String ->
+    EquiKeys ->
+    [String] ->
+    Expr ->
+    Row ->
+    m (Either String (Maybe [Row]))
+probeIndexJoin db outer kind mAlias t ks rcols cond l = case lookup (ekLeft ks) l of
+    Nothing -> pure (Right (Just (unmatched kind l rcols)))
+    Just k
+        | not (indexSafe db t (unqualify mAlias (ekRight ks)) k) -> pure (Right Nothing)
+        | otherwise -> do
+            res <- lookupByColumn t (unqualify mAlias (ekRight ks)) k
+            case res of
+                Left e -> pure (Left e)
+                Right NoIndex -> pure (Right Nothing)
+                Right (IndexRows rows) -> do
+                    pairs <- joinRowsIn db outer kind rcols cond [l] (prefixRows mAlias rows)
+                    pure (fmap Just pairs)
 
--- | 纯求值（不需要存储）
+-- | 索引按值的相等匹配，而数值比较会把 2 和 2.0 看成相等，
+-- 所以只有非浮点列 + 非浮点键才敢用索引，保证优化不改变结果语义
+indexSafe :: Database -> String -> String -> Value -> Bool
+indexSafe db t col k = case lookupTable db t of
+    Left _ -> False
+    Right tbl -> case lookup col (tableCols tbl) of
+        Nothing -> False
+        Just c -> not (floatType (columnType c)) && not (floatValue k)
+
+floatType :: ColumnType -> Bool
+floatType CFloat = True
+floatType CDouble = True
+floatType (CDecimal _ _) = True
+floatType _ = False
+
+floatValue :: Value -> Bool
+floatValue (VFloat _) = True
+floatValue _ = False
+
+-- | 分组键的值
+groupKey :: [String] -> Row -> Either String [Value]
+groupKey keys row = mapM get keys
+  where
+    get c = maybe (Left ("unknown column: " ++ c)) Right (lookup c row)
+
+-- | 按分组键把行分组，保留分组首次出现的顺序
+groupRows :: [String] -> [Row] -> Either String [([Value], [Row])]
+groupRows keys rows = go rows (HM.empty, [])
+  where
+    go [] (acc, order) = Right [(k, reverse (HM.lookupDefault [] k acc)) | k <- reverse order]
+    go (r : rs) (acc, order) = do
+        k <- groupKey keys r
+        let order' = if HM.member k acc then order else k : order
+        go rs (HM.insertWith (++) k [r] acc, order')
+
+-- | 一组行上求同一个表达式（外层列从 outer 取）
+valuesOf :: Row -> Expr -> [Row] -> Either String [Value]
+valuesOf outer e rows = mapM (evalExpr e . (++ outer)) rows
+
+-- | 去掉 NULL
+nonNull :: [Value] -> [Value]
+nonNull = filter (/= VNull)
+
+-- | 数值相加：整数配整数还是整数
+addValue :: Value -> Value -> Either String Value
+addValue (VInt a) (VInt b) = Right (VInt (a + b))
+addValue (VInt a) (VFloat b) = Right (VFloat (fromIntegral a + b))
+addValue (VFloat a) (VInt b) = Right (VFloat (a + fromIntegral b))
+addValue (VFloat a) (VFloat b) = Right (VFloat (a + b))
+addValue _ _ = Left "type error: expected two numbers"
+
+-- | 能当数用的值
+numberOf :: Value -> Either String Double
+numberOf (VInt n) = Right (fromIntegral n)
+numberOf (VFloat d) = Right d
+numberOf _ = Left "type error: expected a number"
+
+-- | 一组值里的极值（NULL 已经先剔掉）
+extremeOf :: (Value -> Value -> Value) -> [Value] -> Either String Value
+extremeOf _ [] = Right VNull
+extremeOf pick (x : xs) = Right (foldl pick x xs)
+
+-- | 一个聚合算子在一组行上的结果
+evalAgg :: Row -> Expr -> [Row] -> Either String Value
+evalAgg outer agg rows = case agg of
+    CountAll -> Right (VInt (length rows))
+    CountOf e -> do
+        vs <- valuesOf outer e rows
+        Right (VInt (length (nonNull vs)))
+    SumOf e -> do
+        vs <- valuesOf outer e rows
+        case nonNull vs of
+            [] -> Right VNull
+            xs -> foldM addValue (VInt 0) xs
+    AvgOf e -> do
+        vs <- valuesOf outer e rows
+        case nonNull vs of
+            [] -> Right VNull
+            xs -> do
+                total <- foldM addValue (VInt 0) xs
+                sumOf <- numberOf total
+                Right (VFloat (sumOf / fromIntegral (length xs)))
+    MinOf e -> valuesOf outer e rows >>= extremeOf lower . nonNull
+    MaxOf e -> valuesOf outer e rows >>= extremeOf higher . nonNull
+    _ -> Left "only COUNT, SUM, AVG, MIN and MAX can be aggregated"
+  where
+    lower a b = if compareValue b a == LT then b else a
+    higher a b = if compareValue b a == GT then b else a
+
+-- | 一组的输出行：分组列 + 各聚合值
+oneGroup :: Row -> [String] -> [(String, Expr)] -> ([Value], [Row]) -> Either String Row
+oneGroup outer keys aggs (keyValues, rows) = do
+    values <- mapM (\(_, e) -> evalAgg outer e rows) aggs
+    Right (zip keys keyValues ++ zip (map fst aggs) values)
+
+-- | 分组求值：没有分组列时，即使没有行也要出一行
+evalAggregate :: Row -> [String] -> [(String, Expr)] -> [Row] -> Either String [Row]
+evalAggregate outer keys aggs rows = do
+    groups <- groupRows keys rows
+    let top = if null keys && null groups then [([], [])] else groups
+    mapM (oneGroup outer keys aggs) top
+
+-- | 单子过滤：条件本身是单子求值的
+filterRowsM :: (Monad m) => (Row -> m (Either String Bool)) -> [Row] -> m (Either String [Row])
+filterRowsM p = go []
+  where
+    go acc [] = pure (Right (reverse acc))
+    go acc (r : rs) = do
+        keep <- p r
+        case keep of
+            Left e -> pure (Left e)
+            Right True -> go (r : acc) rs
+            Right False -> go acc rs
+
+-- | 按投影顺序逐项求值（可以带子查询）
+computeM :: (MonadStorage m) => Database -> Row -> [(String, Expr)] -> Row -> m (Either String Row)
+computeM db outer items row = go items []
+  where
+    go [] acc = pure (Right (reverse acc))
+    go ((label, e) : rest) acc = do
+        v <- evalExprM db e (row ++ outer)
+        case v of
+            Left err -> pure (Left err)
+            Right val -> go rest ((label, val) : acc)
+
+-- | 表达式求值（先把子查询求成字面量）
+evalExprM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Value)
+evalExprM db e env = do
+    e' <- substSubqueries db e env
+    pure (e' >>= \x -> evalExpr x env)
+
+-- | 条件求值（先把子查询求成字面量）
+evalCondForRowM :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Bool)
+evalCondForRowM db e env = do
+    e' <- substSubqueries db e env
+    pure (e' >>= \x -> evalCondForRow x env)
+
+-- | 子查询结果里唯一那一列的值
+rowValue :: Row -> Either String Value
+rowValue [(_, v)] = Right v
+rowValue _ = Left "subquery must return exactly one column"
+
+-- | 标量子查询：0 行给 NULL，多行报错
+scalarResult :: Either String [Row] -> Either String Expr
+scalarResult rows = do
+    rs <- rows
+    case rs of
+        [] -> Right LitNull
+        [r] -> valueLiteral <$> rowValue r
+        _ -> Left "scalar subquery returned more than one row"
+
+-- | 把子查询求值成字面量；子查询的错直接往上传
+substSubqueries :: (MonadStorage m) => Database -> Expr -> Row -> m (Either String Expr)
+substSubqueries db e env = case e of
+    ScalarSub sq -> scalarResult <$> runSubqueryRows db sq env
+    InSub a sq negated -> do
+        lhs <- substSubqueries db a env
+        rows <- runSubqueryRows db sq env
+        pure (do
+            a' <- lhs
+            rs <- rows
+            vs <- mapM rowValue rs
+            Right (InList a' (map valueLiteral vs) negated))
+    ExistsSub sq negated -> do
+        rows <- runSubqueryRows db sq env
+        pure (fmap (\rs -> LitBool (if negated then null rs else not (null rs))) rows)
+    InList a es negated -> do
+        lhs <- substSubqueries db a env
+        es' <- mapM (\x -> substSubqueries db x env) es
+        pure (do
+            a' <- lhs
+            items <- sequence es'
+            Right (InList a' items negated))
+    Add a b -> bin Add a b
+    Sub a b -> bin Sub a b
+    Mul a b -> bin Mul a b
+    Div a b -> bin Div a b
+    Neg a -> un Neg a
+    Gt a b -> bin Gt a b
+    Lt a b -> bin Lt a b
+    Eq a b -> bin Eq a b
+    And a b -> bin And a b
+    Or a b -> bin Or a b
+    IsNull a -> un IsNull a
+    IsNotNull a -> un IsNotNull a
+    CountOf a -> un CountOf a
+    SumOf a -> un SumOf a
+    AvgOf a -> un AvgOf a
+    MinOf a -> un MinOf a
+    MaxOf a -> un MaxOf a
+    _ -> pure (Right e)
+  where
+    bin ctor a b = do
+        ra <- substSubqueries db a env
+        case ra of
+            Left err -> pure (Left err)
+            Right a' -> do
+                rb <- substSubqueries db b env
+                pure ((ctor a') <$> rb)
+    un ctor a = do
+        ra <- substSubqueries db a env
+        pure (ctor <$> ra)
+
+-- | 跑子查询：翻译成算子树再求值，外层行做相关子查询的绑定
+runSubqueryRows :: (MonadStorage m) => Database -> Subquery -> Row -> m (Either String [Row])
+runSubqueryRows db sq outer = case translate (subqueryStatement sq) of
+    Left e -> pure (Left e)
+    Right op -> evalRelOpIn db outer (optimize db op)
+
+-- | 单子求值：Scan/点查/范围查都问存储
+evalRelOpM :: (MonadStorage m) => Database -> RelOp -> m (Either String [Row])
+evalRelOpM db = evalRelOpIn db []
+
+-- | 纯求值（内存存储，子查询走同一条路径）
 evalRelOp :: Database -> RelOp -> Either String [Row]
-evalRelOp db (Scan mAlias tbl) = evalScan db mAlias tbl
-evalRelOp db (Lookup mAlias tbl col k) = do
-    rows <- evalScan db mAlias tbl
-    filterM (evalCondForRow (lookupCondition mAlias col k)) rows
-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
-    joinRows cond lrows rrows
+evalRelOp db op = do
+    (result, _) <- runMemoryStorage (evalRelOpIn db [] op) db
+    result
 
--- | 单子求值：点查先问存储有无索引
-evalRelOpM :: (MonadStorage m) => RelOp -> m (Either String [Row])
-evalRelOpM (Scan mAlias t) = do
-    result <- scan t
-    pure $ do
-        rows <- result
-        case mAlias of
-            Nothing -> Right rows
-            Just _ -> Right (map (addPrefix mAlias) rows)
-evalRelOpM (Lookup mAlias t col k) = do
-    result <- lookupByColumn t col k
-    case result of
+-- | 带外层行的执行器
+evalRelOpIn :: (MonadStorage m) => Database -> Row -> RelOp -> m (Either String [Row])
+evalRelOpIn _ _ Unit = pure (Right [[]])
+evalRelOpIn db outer (Compute items op) = do
+    rows <- evalRelOpIn db outer op
+    case rows of
         Left e -> pure (Left e)
-        Right NoIndex -> do
-            rows <- evalRelOpM (Scan mAlias t)
-            pure $ do
-                rs <- rows
-                filterM (evalCondForRow (lookupCondition mAlias col k)) rs
-        Right (IndexRow Nothing) -> pure (Right [])
-        Right (IndexRow (Just row)) -> pure (Right [addPrefix mAlias row])
-evalRelOpM (Filter p x) = do
-    result <- evalRelOpM x
+        Right rs -> do
+            computed <- mapM (computeM db outer items) rs
+            pure (sequence computed)
+evalRelOpIn db outer (Aggregate keys aggs op) = do
+    rows <- evalRelOpIn db outer op
+    pure (rows >>= evalAggregate outer keys aggs)
+evalRelOpIn _ _ (Scan mAlias tbl cols) = do
+    res <- maybe (scan tbl) (scanColumns tbl) cols
+    pure (fmap (prefixRows mAlias) res)
+evalRelOpIn db outer (Lookup mAlias tbl col k) = do
+    res <- lookupByColumn tbl col k
+    case res of
+        Left e -> pure (Left e)
+        Right NoIndex -> scanFiltered db outer mAlias tbl (lookupCondition mAlias col k)
+        Right (IndexRows rows) -> pure (Right (prefixRows mAlias rows))
+evalRelOpIn db outer (Range mAlias tbl col lo hi) = do
+    res <- scanRange tbl col lo hi
+    case res of
+        Left e -> pure (Left e)
+        Right Nothing -> scanFiltered db outer mAlias tbl (rangeCondition mAlias col lo hi)
+        Right (Just rows) -> pure (Right (prefixRows mAlias rows))
+evalRelOpIn db outer (Filter e op) = do
+    rows <- evalRelOpIn db outer op
+    case rows of
+        Left err -> pure (Left err)
+        Right rs -> filterRowsM (\r -> evalCondForRowM db e (r ++ outer)) rs
+evalRelOpIn db outer (Project cols op) = do
+    rows <- evalRelOpIn db outer op
+    pure (fmap (map (project cols)) rows)
+evalRelOpIn db outer (Sort spec op) = do
+    rows <- evalRelOpIn db outer op
+    pure (fmap (sortRows spec) rows)
+evalRelOpIn db outer (Limit n op) = do
+    rows <- evalRelOpIn db outer op
+    pure (fmap (take n) rows)
+evalRelOpIn db outer (Join kind l r c) = do
+    lres <- evalRelOpIn db outer l
+    case lres of
+        Left e -> pure (Left e)
+        Right ls -> do
+            let nested = do
+                    rres <- evalRelOpIn db outer r
+                    case rres of
+                        Left e -> pure (Left e)
+                        Right rs -> joinRowsIn db outer kind (relOpCols db r) c ls rs
+            case (r, equiKeys (relOpCols db l) (relOpCols db r) c) of
+                (Scan mAlias t _, Just ks) -> do
+                    probed <- mapM (probeIndexJoin db outer kind mAlias t ks (relOpCols db r) c) ls
+                    case sequence probed of
+                        Left e -> pure (Left e)
+                        Right ms -> case sequence ms of
+                            Just rows -> pure (Right (concat rows))
+                            Nothing -> nested
+                _ -> nested
+
+-- | 扫描后按条件过滤（点查/范围查退化成扫描时用）
+scanFiltered ::
+    (MonadStorage m) =>
+    Database ->
+    Row ->
+    Maybe String ->
+    String ->
+    Expr ->
+    m (Either String [Row])
+scanFiltered _ outer mAlias tbl cond = do
+    res <- scan tbl
     pure $ do
-        rows <- result
-        filterM (evalCondForRow p) rows
-evalRelOpM (Project cols x) = do
-    result <- evalRelOpM x
-    pure (fmap (map (project cols)) result)
-evalRelOpM (Sort spec x) = do
-    result <- evalRelOpM x
-    pure (fmap (sortRows spec) result)
-evalRelOpM (Limit n x) = do
-    result <- evalRelOpM x
-    pure (fmap (take n) result)
-evalRelOpM (Join l r cond) = do
-    ls <- evalRelOpM l
-    rs <- evalRelOpM r
-    pure $ do
-        left <- ls
-        right <- rs
-        joinRows cond left right
+        rows <- res
+        filterM (evalCondForRow cond . (++ outer)) (prefixRows mAlias rows)

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

@@ -1,40 +1,188 @@
-module ChuSQL.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr) where
+module ChuSQL.Algebra.Expr (evalExpr, evalCondForRow, colsInExpr, aggregatesIn, hasAggregate, bareColumns, hasSubquery, inValues, threeValuedNot) where
 
 import ChuSQL.Model
 import ChuSQL.Syntax.AST
 import Control.Monad (join)
 
--- 表达式求值：拿一行数据算出一个值。
+-- 表达式求值：三值逻辑，NULL 参与运算结果仍是 NULL。
 
 -- | 在一行上求出表达式的值
 evalExpr :: Expr -> Row -> Either String Value
 evalExpr (Col name) row =
     maybe (Left ("unknown column: " ++ name)) Right (lookup name row)
+evalExpr LitNull _ = Right VNull
 evalExpr (LitInt n) _ = Right (VInt n)
+evalExpr (LitFloat d) _ = Right (VFloat d)
 evalExpr (LitStr s) _ = Right (VStr s)
 evalExpr (LitBool b) _ = Right (VBool b)
-evalExpr (Gt a b) row = liftBinOp (intOp (>)) a b row
-evalExpr (Lt a b) row = liftBinOp (intOp (<)) a b row
-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
+evalExpr (LitDate s) _ = Right (VStr s)
+evalExpr (LitTimestamp s) _ = Right (VStr s)
+evalExpr (LitBlob s) _ = Right (VStr s)
+evalExpr (Add a b) row = liftArith addArith a b row
+evalExpr (Sub a b) row = liftArith subArith a b row
+evalExpr (Mul a b) row = liftArith mulArith a b row
+evalExpr (Div a b) row = liftArith divArith a b row
+evalExpr (Neg a) row = do
+    v <- evalExpr a row
+    case v of
+        VNull -> Right VNull
+        VInt n -> Right (VInt (negate n))
+        VFloat d -> Right (VFloat (negate d))
+        _ -> Left "type error: expected a number"
+evalExpr (Gt a b) row = liftCompare (> EQ) a b row
+evalExpr (Lt a b) row = liftCompare (< EQ) a b row
+evalExpr (Eq a b) row = liftCompare (== EQ) a b row
+evalExpr (And a b) row = liftBool andValues a b row
+evalExpr (Or a b) row = liftBool orValues a b row
+evalExpr (IsNull a) row = do
+    v <- evalExpr a row
+    Right (VBool (v == VNull))
+evalExpr (IsNotNull a) row = do
+    v <- evalExpr a row
+    Right (VBool (v /= VNull))
+evalExpr (InList a es negated) row = do
+    v <- evalExpr a row
+    vs <- mapM (\e -> evalExpr e row) es
+    r <- inValues v vs
+    Right (if negated then threeValuedNot r else r)
+evalExpr (ScalarSub _) _ = Left subqueryNeedsDatabase
+evalExpr (InSub _ _ _) _ = Left subqueryNeedsDatabase
+evalExpr (ExistsSub _ _) _ = Left subqueryNeedsDatabase
+evalExpr agg _ = Left ("aggregate functions are not allowed here: " ++ show agg)
+
+-- | 子查询要连上存储才能跑
+subqueryNeedsDatabase :: String
+subqueryNeedsDatabase = "subquery needs a database to run"
+
+-- | IN 的三值逻辑：命中为真，没命中但碰到 NULL 就给 NULL，否则为假
+inValues :: Value -> [Value] -> Either String Value
+inValues VNull _ = Right VNull
+inValues v vs = do
+    results <- mapM (compareValues (== EQ) v) vs
+    Right $
+        if VBool True `elem` results
+            then VBool True
+            else if VNull `elem` results then VNull else VBool False
+
+-- | NOT 的三值取反
+threeValuedNot :: Value -> Value
+threeValuedNot (VBool b) = VBool (not b)
+threeValuedNot _ = VNull
 
 -- | 表达式用到了哪些列
 colsInExpr :: Expr -> [String]
 colsInExpr (Col c) = [c]
+colsInExpr (Add a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Sub a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Mul a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Div a b) = colsInExpr a ++ colsInExpr b
+colsInExpr (Neg a) = colsInExpr a
 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 (IsNull a) = colsInExpr a
+colsInExpr (IsNotNull a) = colsInExpr a
+colsInExpr (CountOf a) = colsInExpr a
+colsInExpr (SumOf a) = colsInExpr a
+colsInExpr (AvgOf a) = colsInExpr a
+colsInExpr (MinOf a) = colsInExpr a
+colsInExpr (MaxOf a) = colsInExpr a
+colsInExpr (ScalarSub sq) = subqueryRefs sq
+colsInExpr (InSub a sq _) = colsInExpr a ++ subqueryRefs sq
+colsInExpr (InList a es _) = colsInExpr a ++ concatMap colsInExpr es
+colsInExpr (ExistsSub sq _) = subqueryRefs sq
 colsInExpr _ = []
 
--- | 判断条件真假
+-- | 表达式里有没有子查询
+hasSubquery :: Expr -> Bool
+hasSubquery e = case e of
+    ScalarSub _ -> True
+    InSub _ _ _ -> True
+    InList a es _ -> any hasSubquery (a : es)
+    ExistsSub _ _ -> True
+    Add a b -> both a b
+    Sub a b -> both a b
+    Mul a b -> both a b
+    Div a b -> both a b
+    Neg a -> hasSubquery a
+    Gt a b -> both a b
+    Lt a b -> both a b
+    Eq a b -> both a b
+    And a b -> both a b
+    Or a b -> both a b
+    IsNull a -> hasSubquery a
+    IsNotNull a -> hasSubquery a
+    CountOf a -> hasSubquery a
+    SumOf a -> hasSubquery a
+    AvgOf a -> hasSubquery a
+    MinOf a -> hasSubquery a
+    MaxOf a -> hasSubquery a
+    _ -> False
+  where
+    both a b = hasSubquery a || hasSubquery b
+
+-- | 表达式里出现的聚合调用（按出现顺序）
+aggregatesIn :: Expr -> [Expr]
+aggregatesIn e = case e of
+    a@CountAll -> [a]
+    a@(CountOf _) -> [a]
+    a@(SumOf _) -> [a]
+    a@(AvgOf _) -> [a]
+    a@(MinOf _) -> [a]
+    a@(MaxOf _) -> [a]
+    Add a b -> both a b
+    Sub a b -> both a b
+    Mul a b -> both a b
+    Div a b -> both a b
+    Neg a -> aggregatesIn a
+    Gt a b -> both a b
+    Lt a b -> both a b
+    Eq a b -> both a b
+    And a b -> both a b
+    Or a b -> both a b
+    IsNull a -> aggregatesIn a
+    IsNotNull a -> aggregatesIn a
+    _ -> []
+  where
+    both a b = aggregatesIn a ++ aggregatesIn b
+
+-- | 表达式里有没有聚合调用
+hasAggregate :: Expr -> Bool
+hasAggregate = not . null . aggregatesIn
+
+-- | 聚合之外的列引用（聚合参数里的列不算）
+bareColumns :: Expr -> [String]
+bareColumns e = case e of
+    Col c -> [c]
+    Add a b -> both a b
+    Sub a b -> both a b
+    Mul a b -> both a b
+    Div a b -> both a b
+    Neg a -> bareColumns a
+    Gt a b -> both a b
+    Lt a b -> both a b
+    Eq a b -> both a b
+    And a b -> both a b
+    Or a b -> both a b
+    IsNull a -> bareColumns a
+    IsNotNull a -> bareColumns a
+    ScalarSub sq -> subqueryRefs sq
+    InSub a sq _ -> bareColumns a ++ subqueryRefs sq
+    InList a es _ -> bareColumns a ++ concatMap bareColumns es
+    ExistsSub sq _ -> subqueryRefs sq
+    _ -> []
+  where
+    both a b = bareColumns a ++ bareColumns b
+
+-- | 判断条件真假：只有 TRUE 通过，NULL 当作不通过
 evalCondForRow :: Expr -> Row -> Either String Bool
 evalCondForRow e row = do
     v <- evalExpr e row
     case v of
         VBool b -> Right b
+        VNull -> Right False
         _ -> Left "type error: WHERE condition must be a boolean"
 
 -- | 把二元运算提升到 Either
@@ -46,16 +194,89 @@ liftBinOp ::
     Either String Value
 liftBinOp f a b row = join (f <$> evalExpr a row <*> evalExpr b row)
 
--- | 整数二元运算
-intOp :: (Int -> Int -> Bool) -> Value -> Value -> Either String Value
-intOp f (VInt x) (VInt y) = Right (VBool (f x y))
-intOp _ _ _ = Left "type error: expected two integers"
+-- | 整数算术与浮点算术成对出现
+data Arith = Arith
+    { arithInt :: Int -> Int -> Either String Int
+    , arithFloat :: Double -> Double -> Either String Double
+    }
+
+-- | 一边是 NULL 就出 NULL，两边都是整数就出整数
+liftArith :: Arith -> Expr -> Expr -> Row -> Either String Value
+liftArith ops a b row = liftBinOp go a b row
+  where
+    go VNull _ = Right VNull
+    go _ VNull = Right VNull
+    go (VInt x) (VInt y) = VInt <$> arithInt ops x y
+    go x y = case (asDouble x, asDouble y) of
+        (Just p, Just q) -> VFloat <$> arithFloat ops p q
+        _ -> Left "type error: expected two numbers"
+
+-- | 能当数用的值
+asDouble :: Value -> Maybe Double
+asDouble (VInt n) = Just (fromIntegral n)
+asDouble (VFloat d) = Just d
+asDouble _ = Nothing
+
+addArith :: Arith
+addArith = Arith (\x y -> Right (x + y)) (\x y -> Right (x + y))
+
+subArith :: Arith
+subArith = Arith (\x y -> Right (x - y)) (\x y -> Right (x - y))
+
+mulArith :: Arith
+mulArith = Arith (\x y -> Right (x * y)) (\x y -> Right (x * y))
+
+-- | 整数除法向零截断，溢出返回错误；浮点除法不能除以零
+divArith :: Arith
+divArith = Arith intDiv floatDiv
+  where
+    intDiv _ 0 = Left "division by zero"
+    intDiv x y
+        | x == minBound && y == -1 = Left "integer division overflow"
+        | otherwise = Right (x `quot` y)
+    floatDiv _ 0 = Left "division by zero"
+    floatDiv x y = Right (x / y)
+
+-- | 比较：任一侧是 NULL 就给 NULL
+liftCompare ::
+    (Ordering -> Bool) ->
+    Expr ->
+    Expr ->
+    Row ->
+    Either String Value
+liftCompare rel a b row = liftBinOp (compareValues rel) a b row
+
+compareValues :: (Ordering -> Bool) -> Value -> Value -> Either String Value
+compareValues rel x y
+    | x == VNull || y == VNull = Right VNull
+    | Just p <- asDouble x, Just q <- asDouble y = Right (VBool (rel (compare p q)))
+    | (VStr p, VStr q) <- (x, y) = Right (VBool (rel (compare p q)))
+    | (VBool p, VBool q) <- (x, y) = Right (VBool (rel (compare p q)))
+    | otherwise = Left "type error: cannot compare these values"
 
 -- | 布尔二元运算
-boolOp :: (Bool -> Bool -> Bool) -> Value -> Value -> Either String Value
-boolOp f (VBool x) (VBool y) = Right (VBool (f x y))
-boolOp _ _ _ = Left "type error: expected two booleans"
+liftBool ::
+    (Value -> Value -> Either String Value) ->
+    Expr ->
+    Expr ->
+    Row ->
+    Either String Value
+liftBool f = liftBinOp f
 
--- | 相等比较
-eqOp :: Value -> Value -> Either String Value
-eqOp x y = Right (VBool (x == y))
+andValues :: Value -> Value -> Either String Value
+andValues (VBool False) _ = Right (VBool False)
+andValues _ (VBool False) = Right (VBool False)
+andValues (VBool True) (VBool True) = Right (VBool True)
+andValues VNull (VBool True) = Right VNull
+andValues (VBool True) VNull = Right VNull
+andValues VNull VNull = Right VNull
+andValues _ _ = Left "type error: expected two booleans"
+
+orValues :: Value -> Value -> Either String Value
+orValues (VBool True) _ = Right (VBool True)
+orValues _ (VBool True) = Right (VBool True)
+orValues (VBool False) (VBool False) = Right (VBool False)
+orValues VNull (VBool False) = Right VNull
+orValues (VBool False) VNull = Right VNull
+orValues VNull VNull = Right VNull
+orValues _ _ = Left "type error: expected two booleans"

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

@@ -1,30 +1,51 @@
 module ChuSQL.Algebra.Op (RelOp (..), renderPlan) where
 
-import ChuSQL.Syntax.AST (Expr, SortDir)
+import ChuSQL.Model (Value)
+import ChuSQL.Syntax.AST (Expr, JoinKind (..), SortDir)
 
 -- 关系代数算子，以及把算子树渲染成文本。
 
 data RelOp
-    = Scan (Maybe String) String
-    | Lookup (Maybe String) String String Int
+    = Scan (Maybe String) String (Maybe [String])
+    | Lookup (Maybe String) String String Value
+    | Range (Maybe String) String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
     | Filter Expr RelOp
     | Project [String] RelOp
+    | Compute [(String, Expr)] RelOp
+    | Aggregate [String] [(String, Expr)] RelOp
+    | Unit
     | Sort [(String, SortDir)] RelOp
     | Limit Int RelOp
-    | Join RelOp RelOp Expr
+    | Join JoinKind RelOp RelOp Expr
     deriving (Show, Eq)
 
+-- | 连接的显示名
+kindLabel :: JoinKind -> String
+kindLabel InnerJoin = "Join"
+kindLabel LeftJoin = "LeftJoin"
+
 -- | 渲染成缩进文本
 renderPlan :: RelOp -> String
 renderPlan = go 0
   where
     go ind op = case op of
-        Scan a t -> pad ++ "Scan " ++ show a ++ " " ++ show t
+        Scan a t cols -> pad ++ "Scan " ++ show a ++ " " ++ show t ++ maybe "" ((" columns=" ++) . show) cols
         Lookup _ t c k -> pad ++ "Lookup " ++ show t ++ "." ++ show c ++ " = " ++ show k
+        Range _ t c lo hi -> pad ++ "Range " ++ show t ++ "." ++ show c ++ " " ++ show lo ++ " .. " ++ show hi
         Filter e x -> pad ++ "Filter " ++ show e ++ "\n" ++ go (ind + 1) x
         Project c x -> pad ++ "Project " ++ show c ++ "\n" ++ go (ind + 1) x
+        Compute c x -> pad ++ "Compute " ++ show c ++ "\n" ++ go (ind + 1) x
+        Aggregate keys aggs x ->
+            pad
+                ++ "Aggregate keys="
+                ++ show keys
+                ++ " aggs="
+                ++ show [label ++ " <- " ++ show e | (label, e) <- aggs]
+                ++ "\n"
+                ++ go (ind + 1) x
+        Unit -> pad ++ "Unit"
         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
+        Join k l r c -> pad ++ kindLabel k ++ " on " ++ show c ++ "\n" ++ go (ind + 1) l ++ "\n" ++ go (ind + 1) r
       where
         pad = replicate (ind * 2) ' '

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

@@ -1,27 +1,33 @@
-module ChuSQL.Algebra.Optimize (optimize, pushProject) where
+module ChuSQL.Algebra.Optimize (optimize, pushProject, relOpCols) where
 
 import ChuSQL.Algebra.Expr (colsInExpr, evalExpr)
 import ChuSQL.Algebra.Op (RelOp (..))
 import ChuSQL.Model
-import ChuSQL.Syntax.AST (Expr (..))
+import ChuSQL.Syntax.AST (Expr (..), JoinKind (..))
+import Data.List (nub)
 
 -- 查询优化：谓词下推 + 投影下推 + 常量折叠，跑到不动点。
 
 -- | 算子会产出哪些列
 relOpCols :: Database -> RelOp -> [String]
-relOpCols db (Scan mAlias tbl) =
+relOpCols _ Unit = []
+relOpCols _ (Compute items _) = map fst items
+relOpCols _ (Aggregate keys aggs _) = keys ++ map fst aggs
+relOpCols _ (Scan mAlias _ (Just cols)) = map (qualify mAlias) cols
+relOpCols db (Scan mAlias tbl Nothing) =
     case lookup tbl db of
         Nothing -> []
         Just t -> map (prefix ++) (colNames t)
   where
     prefix = maybe "" (++ ".") mAlias
-relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl)
+relOpCols db (Lookup mAlias tbl _ _) = relOpCols db (Scan mAlias tbl Nothing)
+relOpCols db (Range mAlias tbl _ _ _) = relOpCols db (Scan mAlias tbl Nothing)
 relOpCols db (Filter _ x) = relOpCols db x
 relOpCols _ (Project ["*"] _) = ["*"]
 relOpCols _ (Project cols _) = cols
 relOpCols db (Sort _ x) = relOpCols db x
 relOpCols db (Limit _ x) = relOpCols db x
-relOpCols db (Join l r _) = relOpCols db l ++ relOpCols db r
+relOpCols db (Join _ l r _) = relOpCols db l ++ relOpCols db r
 
 -- | need 是否都在 have 里
 isSubsetOf :: [String] -> [String] -> Bool
@@ -51,7 +57,7 @@ applyFilters :: [Expr] -> RelOp -> RelOp
 applyFilters [] op = op
 applyFilters (e : es) op = applyFilters es (Filter e op)
 
--- | Filter 压在 Join 上时下推
+-- | Filter 压在内连接上时下推
 pushJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
 pushJoin db p l r c =
     let preds = splitConj p
@@ -61,17 +67,56 @@ pushJoin db p l r c =
         (rPs, bothPs) = partitionPred rCols rest1
         l' = applyFilters lPs l
         r' = applyFilters rPs r
-        joined = Join l' r' c
+        joined = Join InnerJoin l' r' c
      in case combineConj bothPs of
             Nothing -> joined
             Just p' -> Filter p' joined
 
+-- | Filter 压在左连接上时，只把纯左表的谓词下推到左表；
+-- 右表没配上会补 NULL，右表谓词不能提前算。
+pushLeftJoin :: Database -> Expr -> RelOp -> RelOp -> Expr -> RelOp
+pushLeftJoin db p l r c =
+    let (lPs, rest) = partitionPred (relOpCols db l) (splitConj p)
+        joined = Join LeftJoin (applyFilters lPs l) r c
+     in case combineConj rest of
+            Nothing -> joined
+            Just p' -> Filter p' joined
+
 -- | 合并两层 Filter 或挪到 Sort 下
 pushOne :: Database -> RelOp -> RelOp
-pushOne _ (Filter p (Filter q x)) = Filter (And p q) x
-pushOne _ (Filter p (Sort spec x)) = Sort spec (Filter p x)
+pushOne _ (Filter p (Filter q x))
+    | not (hasDivision p || hasDivision q) = Filter (And p q) x
+pushOne _ (Filter p (Sort spec x))
+    | not (hasDivision p) = Sort spec (Filter p x)
 pushOne _ op = op
 
+-- | 除法可能报错，不能提前或延后求值
+hasDivision :: Expr -> Bool
+hasDivision e = case e of
+    Div _ _ -> True
+    Neg a -> hasDivision a
+    Add a b -> both a b
+    Sub a b -> both a b
+    Mul a b -> both a b
+    Gt a b -> both a b
+    Lt a b -> both a b
+    Eq a b -> both a b
+    And a b -> both a b
+    Or a b -> both a b
+    _ -> False
+  where
+    both a b = hasDivision a || hasDivision b
+
+-- | 检查子计划中可能报错的除法
+planHasDivision :: RelOp -> Bool
+planHasDivision (Filter p x) = hasDivision p || planHasDivision x
+planHasDivision (Join _ l r c) = hasDivision c || planHasDivision l || planHasDivision r
+planHasDivision (Compute items x) = any (hasDivision . snd) items || planHasDivision x
+planHasDivision (Project _ x) = planHasDivision x
+planHasDivision (Sort _ x) = planHasDivision x
+planHasDivision (Limit _ x) = planHasDivision x
+planHasDivision _ = False
+
 -- | 是否要全部列
 needsAll :: [String] -> Bool
 needsAll = elem allColumns
@@ -85,29 +130,39 @@ pushProjectLeaf db need leaf
 
 -- | 把需要哪些列往下传
 pushProject :: Database -> [String] -> RelOp -> RelOp
+pushProject _ _ Unit = Unit
+pushProject db _ (Compute items x) = Compute items (pushProject db (concatMap (colsInExpr . snd) items) x)
+pushProject db _ (Aggregate keys aggs x) =
+    Aggregate keys aggs (pushProject db (keys ++ concatMap (colsInExpr . snd) aggs) x)
 pushProject db _ (Project cols x) = case pushProject db cols x of
     Project cols' y | cols' == cols -> Project cols y
     other -> Project cols other
 pushProject db need (Filter p x) = Filter p (pushProject db (need ++ colsInExpr p) x)
 pushProject db need (Sort spec x) = Sort spec (pushProject db (need ++ map fst spec) x)
 pushProject db need (Limit n x) = Limit n (pushProject db need x)
-pushProject db need (Join l r c)
-    | needsAll need = Join (pushProject db need l) (pushProject db need r) c
+pushProject db need (Join kind l r c)
+    | needsAll need = Join kind (pushProject db need l) (pushProject db need r) c
     | otherwise =
         let tot = need ++ colsInExpr c
             lCols = relOpCols db l
             rCols = relOpCols db r
             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 leaf@(Scan _ _) = pushProjectLeaf db need leaf
+         in Join kind (pushProject db lNeed l) (pushProject db rNeed r) c
+pushProject db need leaf@(Scan a t _)
+    | needsAll need = leaf
+    | all (`elem` need) (relOpCols db leaf) = leaf
+    | otherwise = Scan a t (Just (nub (map (unqualify a) need)))
 pushProject db need leaf@(Lookup _ _ _ _) = pushProjectLeaf db need leaf
+pushProject db need leaf@(Range _ _ _ _ _) = pushProjectLeaf db need leaf
 
 -- | 折一个表达式节点
 foldNode :: Expr -> Expr
 foldNode e
     | null (colsInExpr e) = case evalExpr e [] of
+        Right VNull -> LitNull
         Right (VInt n) -> LitInt n
+        Right (VFloat d) -> LitFloat d
         Right (VStr s) -> LitStr s
         Right (VBool b) -> LitBool b
         Left _ -> e
@@ -115,6 +170,11 @@ foldNode e
 
 -- | 自底向上折整棵表达式
 foldConstants :: Expr -> Expr
+foldConstants (Add a b) = foldNode (Add (foldConstants a) (foldConstants b))
+foldConstants (Sub a b) = foldNode (Sub (foldConstants a) (foldConstants b))
+foldConstants (Mul a b) = foldNode (Mul (foldConstants a) (foldConstants b))
+foldConstants (Div a b) = foldNode (Div (foldConstants a) (foldConstants b))
+foldConstants (Neg a) = foldNode (Neg (foldConstants a))
 foldConstants (Gt a b) = foldNode (Gt (foldConstants a) (foldConstants b))
 foldConstants (Lt a b) = foldNode (Lt (foldConstants a) (foldConstants b))
 foldConstants (Eq a b) = foldNode (Eq (foldConstants a) (foldConstants b))
@@ -124,13 +184,32 @@ foldConstants e = e
 
 -- | 单节点重写
 rewriteNode :: Database -> RelOp -> RelOp
-rewriteNode _ (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t)) =
-    Lookup mAlias t (unqualify mAlias k) v
-rewriteNode db (Filter p (Join l r c)) = pushJoin db p l r c
+rewriteNode _ (Filter (Eq (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
+    Lookup mAlias t (unqualify mAlias k) (VInt v)
+rewriteNode _ (Filter (Eq (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
+    Lookup mAlias t (unqualify mAlias k) (VStr v)
+rewriteNode _ (Filter (And (Gt (Col k1) (LitInt lo)) (Lt (Col k2) (LitInt hi))) (Scan mAlias t Nothing))
+    | k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VInt lo, False)) (Just (VInt hi, False))
+rewriteNode _ (Filter (And (Gt (Col k1) (LitStr lo)) (Lt (Col k2) (LitStr hi))) (Scan mAlias t Nothing))
+    | k1 == k2 = Range mAlias t (unqualify mAlias k1) (Just (VStr lo, False)) (Just (VStr hi, False))
+rewriteNode _ (Filter (Gt (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
+    Range mAlias t (unqualify mAlias k) (Just (VInt v, False)) Nothing
+rewriteNode _ (Filter (Gt (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
+    Range mAlias t (unqualify mAlias k) (Just (VStr v, False)) Nothing
+rewriteNode _ (Filter (Lt (Col k) (LitInt v)) (Scan mAlias t Nothing)) =
+    Range mAlias t (unqualify mAlias k) Nothing (Just (VInt v, False))
+rewriteNode _ (Filter (Lt (Col k) (LitStr v)) (Scan mAlias t Nothing)) =
+    Range mAlias t (unqualify mAlias k) Nothing (Just (VStr v, False))
+rewriteNode db (Filter p (Join kind l r c))
+    | not (hasDivision p || planHasDivision (Join kind l r c)) =
+        case kind of
+            InnerJoin -> pushJoin db p l r c
+            LeftJoin -> pushLeftJoin db p l r c
 rewriteNode db (Filter p x) = case foldConstants p of
     LitBool True -> x
     p' -> pushOne db (Filter p' x)
 rewriteNode _ (Project ["*"] x) = x
+rewriteNode _ (Compute items x) = Compute [(label, foldConstants e) | (label, e) <- items] x
 rewriteNode db op = pushOne db op
 
 -- | 自底向上遍历一次
@@ -139,9 +218,11 @@ optimizeRelOp db = rewriteNode db . descend
   where
     descend (Filter p x) = Filter p (optimizeRelOp db x)
     descend (Project cols x) = Project cols (optimizeRelOp db x)
+    descend (Compute items x) = Compute items (optimizeRelOp db x)
+    descend (Aggregate keys aggs x) = Aggregate keys aggs (optimizeRelOp db x)
     descend (Sort spec x) = Sort spec (optimizeRelOp db x)
     descend (Limit n x) = Limit n (optimizeRelOp db x)
-    descend (Join l r c) = Join (optimizeRelOp db l) (optimizeRelOp db r) c
+    descend (Join kind l r c) = Join kind (optimizeRelOp db l) (optimizeRelOp db r) c
     descend x = x
 
 -- | 反复跑到不动点

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

@@ -1,5 +1,6 @@
 module ChuSQL.Algebra.Planner (translate) where
 
+import ChuSQL.Algebra.Expr (aggregatesIn)
 import ChuSQL.Algebra.Op
 import ChuSQL.Syntax.AST
 
@@ -7,29 +8,80 @@ import ChuSQL.Syntax.AST
 
 -- | 把 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
+fromToRelOp FromUnit = Unit
+fromToRelOp (FromTable mAlias tbl) = Scan mAlias tbl Nothing
+fromToRelOp (FromJoin kind left mAlias tbl cond) =
+    Join kind (fromToRelOp left) (Scan mAlias tbl Nothing) cond
 
--- | 翻成：过滤 -> 排序 -> 截断 -> 取列
+-- | 带上 WHERE 的来源
+source :: FromClause -> Maybe Expr -> RelOp
+source fromC mWhere = case mWhere of
+    Nothing -> fromToRelOp fromC
+    Just w -> Filter w (fromToRelOp fromC)
+
+-- | 给用到的聚合起内部列名，同一个聚合只算一次
+nameAggs :: [(String, Expr)] -> [(String, Expr)]
+nameAggs items = go (1 :: Int) [] (concatMap (aggregatesIn . snd) items)
+  where
+    go :: Int -> [(String, Expr)] -> [Expr] -> [(String, Expr)]
+    go _ acc [] = reverse acc
+    go n acc (e : es)
+        | any ((== e) . snd) acc = go n acc es
+        | otherwise = go (n + 1) (("agg" ++ show n, e) : acc) es
+
+-- | 把聚合调用换成对聚合结果的引用
+rewriteAggs :: [(String, Expr)] -> Expr -> Expr
+rewriteAggs aggs e = case [label | (label, agg) <- aggs, agg == e] of
+    (label : _) -> Col label
+    [] -> case e of
+        Add a b -> Add (go a) (go b)
+        Sub a b -> Sub (go a) (go b)
+        Mul a b -> Mul (go a) (go b)
+        Div a b -> Div (go a) (go b)
+        Neg a -> Neg (go a)
+        Gt a b -> Gt (go a) (go b)
+        Lt a b -> Lt (go a) (go b)
+        Eq a b -> Eq (go a) (go b)
+        And a b -> And (go a) (go b)
+        Or a b -> Or (go a) (go b)
+        IsNull a -> IsNull (go a)
+        IsNotNull a -> IsNotNull (go a)
+        other -> other
+  where
+    go = rewriteAggs aggs
+
+-- | 过滤 + 分组：没有分组也没有聚合时原样返回
+grouped :: [String] -> [(String, Expr)] -> RelOp -> (RelOp, [(String, Expr)])
+grouped keys items base
+    | null keys && null aggs = (base, items)
+    | otherwise = (Aggregate keys aggs base, [(label, rewriteAggs aggs e) | (label, e) <- items])
+  where
+    aggs = nameAggs items
+
+-- | 排序 + 截断
+limited :: [(String, SortDir)] -> Maybe Int -> RelOp -> RelOp
+limited orderBy mLimit op = case mLimit of
+    Nothing -> sorted
+    Just n -> Limit n sorted
+  where
+    sorted = case orderBy of
+        [] -> op
+        spec -> Sort spec op
+
+-- | 翻成：过滤 -> 分组 -> 排序 -> 截断 -> 取列
 translate :: Statement -> Either String RelOp
 translate q = case q of
     Select
         { selectCols = cols
         , selectFrom = fromC
         , selectWhere = mWhere
+        , selectGroupBy = groupBy
         , selectOrderBy = orderBy
         , selectLimit = mLimit
         } -> do
-            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)
+            let (plan, _) = grouped groupBy [] (source fromC mWhere)
+            Right (Project cols (limited orderBy mLimit plan))
+    SelectExpr items fromC mWhere groupBy orderBy mLimit -> do
+        let (plan, items') = grouped groupBy items (source fromC mWhere)
+        Right (Compute items' (limited orderBy mLimit plan))
     _ -> Left "only SELECT is supported by translate"

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

@@ -1,4 +1,4 @@
-module ChuSQL.Algebra.Sort (sortRows) where
+module ChuSQL.Algebra.Sort (sortRows, compareValue) where
 
 import ChuSQL.Model
 import ChuSQL.Syntax.AST
@@ -12,9 +12,15 @@ flipOrdering LT = GT
 flipOrdering GT = LT
 flipOrdering EQ = EQ
 
--- | 比较两个值
+-- | 比较两个值：NULL 最小，数值跨整数与小数比较
 compareValue :: Value -> Value -> Ordering
+compareValue VNull VNull = EQ
+compareValue VNull _ = LT
+compareValue _ VNull = GT
 compareValue (VInt a) (VInt b) = compare a b
+compareValue (VFloat a) (VFloat b) = compare a b
+compareValue (VInt a) (VFloat b) = compare (fromIntegral a) b
+compareValue (VFloat a) (VInt b) = compare a (fromIntegral b)
 compareValue (VStr a) (VStr b) = compare a b
 compareValue (VBool a) (VBool b) = compare a b
 compareValue _ _ = EQ

chusql-engine/src/ChuSQL/Engine.hs

@@ -1,14 +1,16 @@
 module ChuSQL.Engine (runStatement, runStatementM, rowsOf) where
 
-import ChuSQL.Algebra.Eval (evalRelOpM)
+import ChuSQL.Algebra.Eval (evalCondForRowM, evalExprM, 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.Semantic (prepare)
 import ChuSQL.Storage (MonadStorage (..))
 import ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage))
 import ChuSQL.Syntax.AST
+import ChuSQL.Syntax.Parser (parseExpression)
+import Data.Maybe (mapMaybe)
 
 -- 引擎入口：语义检查 + 分发执行，以及内存实现与泛型版本。
 
@@ -25,71 +27,71 @@ rowsOf = fmap snd
 
 -- | 泛型入口：先检查再执行
 runStatementM :: (MonadStorage m) => Statement -> m (Either String [Row])
+runStatementM (CreateDatabase name) = fmap (fmap (const [])) (createDatabase name)
+runStatementM (DropDatabase name) = fmap (fmap (const [])) (dropDatabase name)
+runStatementM (UseDatabase name) = fmap (fmap (const [])) (useDatabase name)
+runStatementM ShowDatabases = fmap (fmap (map (\name -> [("database", VStr name)]))) listDatabases
 runStatementM q = do
     db <- schema
-    case check db q of
+    case prepare db q of
         Left err -> pure (Left err)
-        Right _ -> runStatementUncheckedM db q
+        Right resolved -> runStatementUncheckedM db resolved
 
 -- | 按语句类型分发（已检查过）
 runStatementUncheckedM :: (MonadStorage m) => Database -> Statement -> m (Either String [Row])
 runStatementUncheckedM db q@Select{} =
     case translate q of
         Left e -> pure (Left e)
-        Right relOp -> evalRelOpM (optimize db relOp)
-runStatementUncheckedM _ (Insert tbl cols rows) =
-    case mapM toRow rows of
-        Left err -> pure (Left err)
-        Right rs -> do
-            result <- insertMany tbl rs
-            pure (result >> Right [])
-  where
-    -- \| 一行字面量求值成一行数据
-    toRow :: [Expr] -> Either String Row
-    toRow vals = do
-        values <- mapM (\e -> evalExpr e []) vals
-        if length cols /= length values
-            then Left "column count does not match value count"
-            else Right (zip cols values)
-runStatementUncheckedM _ (Delete tbl mWhere) = do
-    rowsResult <- scan tbl
-    case rowsResult of
-        Left err -> pure (Left err)
-        Right rows -> case splitByCondition mWhere rows of
-            Left err -> pure (Left err)
-            Right (doomed, kept) ->
-                case mapM rowId doomed of
-                    Right ids -> do
-                        result <- deleteKeys tbl ids
-                        pure (result >> Right [])
-                    Left _ -> do
-                        result <- replaceAll tbl kept
-                        pure (result >> Right [])
-  where
-    -- \| 这一行的 id（要拿来当删除键）
-    rowId :: Row -> Either String Int
-    rowId r = case lookup "id" r of
-        Just (VInt k) -> Right k
-        _ -> Left "row has no integer id"
-runStatementUncheckedM _ (Update tbl assigns mWhere) = do
+        Right relOp -> evalRelOpM db (optimize db relOp)
+runStatementUncheckedM db q@SelectExpr{} =
+    case translate q of
+        Left e -> pure (Left e)
+        Right relOp -> evalRelOpM db (optimize db relOp)
+runStatementUncheckedM db (Insert tbl cols rows) =
+    case lookupTable db tbl of
+        Left e -> pure (Left e)
+        Right table -> do
+            current <- existingRows tbl table
+            case current >>= \current' -> buildRows table current' cols rows of
+                Left err -> pure (Left err)
+                Right rs -> do
+                    result <- insertMany tbl rs
+                    pure (result >> Right [])
+runStatementUncheckedM db (Delete tbl 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
+            split <- splitByConditionM db mWhere rows
+            case split of
                 Left err -> pure (Left err)
-                Right rs -> do
-                    result <- replaceAll tbl rs
-                    pure (result >> Right [])
+                Right (doomed, kept) ->
+                    case mapM rowId doomed of
+                        Right ids -> do
+                            result <- deleteKeys tbl ids
+                            pure (result >> Right [])
+                        Left _ -> do
+                            result <- replaceAll tbl kept
+                            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
+    rowId :: Row -> Either String Int
+    rowId r = case lookup "id" r of
+        Just (VInt k) -> Right k
+        _ -> Left "row has no integer id"
+runStatementUncheckedM db (Update tbl assigns mWhere) =
+    case lookupTable db tbl of
+        Left e -> pure (Left e)
+        Right table -> do
+            rowsResult <- scan tbl
+            case rowsResult of
+                Left err -> pure (Left err)
+                Right rows -> do
+                    newRows <- mapM (updateRowM db table mWhere assigns) rows
+                    case sequence newRows of
+                        Left err -> pure (Left err)
+                        Right rs -> do
+                            result <- replaceAll tbl rs
+                            pure (result >> Right [])
 runStatementUncheckedM _ (CreateTable name cols) = do
     result <- createTable name cols
     pure (result >> Right [])
@@ -105,23 +107,251 @@ runStatementUncheckedM _ (DropIndex tbl col) = do
 runStatementUncheckedM _ (DropColumn tbl col) = do
     result <- dropColumn tbl col
     pure (result >> Right [])
+runStatementUncheckedM db (AddColumn tbl def) =
+    alterTable db tbl (\table -> addColumnTo def (tableCols table) (tableRows table))
+runStatementUncheckedM db (RenameColumn tbl old new) =
+    alterTable db tbl (\table -> renameColumnIn old new (tableCols table) (tableRows table))
+runStatementUncheckedM db (AlterColumnType tbl col ty) =
+    alterTable db tbl (\table -> retypeColumn col ty (tableCols table) (tableRows table))
+runStatementUncheckedM db (AlterColumnDefault tbl col def) =
+    alterTable db tbl (\table -> setColumnDefault col def (tableCols table) (tableRows table))
+runStatementUncheckedM db (AlterColumnNull tbl col nullable) =
+    alterTable db tbl (\table -> setColumnNullable col nullable (tableCols table) (tableRows table))
+runStatementUncheckedM _ CreateUser{} = pure (Left "CREATE USER is executed by the account service")
+runStatementUncheckedM _ AlterUser{} = pure (Left "ALTER USER is executed by the account service")
+runStatementUncheckedM _ DropUser{} = pure (Left "DROP USER is executed by the account service")
+runStatementUncheckedM _ CreateRole{} = pure (Left "CREATE ROLE is executed by the privilege service")
+runStatementUncheckedM _ DropRole{} = pure (Left "DROP ROLE is executed by the privilege service")
+runStatementUncheckedM _ GrantPrivileges{} = pure (Left "GRANT is executed by the privilege service")
+runStatementUncheckedM _ RevokePrivileges{} = pure (Left "REVOKE is executed by the privilege service")
+runStatementUncheckedM _ GrantRole{} = pure (Left "GRANT is executed by the privilege service")
+runStatementUncheckedM _ RevokeRole{} = pure (Left "REVOKE is executed by the privilege service")
+runStatementUncheckedM _ q@CreateDatabase{} = runStatementM q
+runStatementUncheckedM _ q@DropDatabase{} = runStatementM q
+runStatementUncheckedM _ q@UseDatabase{} = runStatementM q
+runStatementUncheckedM _ ShowDatabases = runStatementM ShowDatabases
 
--- | 按条件把行分成待删和保留两拨
-splitByCondition :: Maybe Expr -> [Row] -> Either String ([Row], [Row])
-splitByCondition cond = go [] []
+-- | 只有需要读全表才能判断约束时才扫表
+existingRows :: (MonadStorage m) => String -> Table -> m (Either String [Row])
+existingRows tbl table
+    | needsRows table = scan tbl
+    | otherwise = pure (Right [])
   where
-    -- \| 逐行过，保持原顺序
-    go doomed kept [] = Right (reverse doomed, reverse kept)
+    needsRows t = any (constraintColumn . snd) (tableCols t)
+    constraintColumn c = columnAutoIncrement c || columnUnique c || columnPrimaryKey c
+
+-- | 插一行：补齐缺列、给自增值、收类型、查约束
+buildRows :: Table -> [Row] -> [String] -> [[Expr]] -> Either String [Row]
+buildRows table current cols rows = do
+    values <- mapM (mapM (\e -> evalExpr e [])) rows
+    if any (\vals -> length vals /= length cols) values
+        then Left "column count does not match value count"
+        else do
+            let auto = autoColumn table
+            go auto (autoStart auto current) values []
+  where
+    go _ _ [] acc = do
+        let built = reverse acc
+        mapM_ (runChecks table) built
+        enforceNotNull (tableCols table) built
+        enforceUnique (tableCols table) (current ++ built)
+        Right built
+    go auto counter (vals : rest) acc = do
+        (row, counter') <- buildRow table auto cols counter vals
+        go auto counter' rest (row : acc)
+
+-- | 按列定义补出一行
+buildRow :: Table -> Maybe (String, Column) -> [String] -> Int -> [Value] -> Either String (Row, Int)
+buildRow table auto cols counter vals = go (tableCols table) counter []
+  where
+    provided = zip cols vals
+    go [] c acc = Right (reverse acc, c)
+    go ((name, col) : rest) c acc = do
+        (v, c') <- pick name col c
+        v' <- coerceValue (columnType col) v
+        go rest c' ((name, v') : acc)
+    pick name col c
+        | Just (autoName, _) <- auto
+        , name == autoName
+        , maybe True (== VNull) (lookup name provided) = Right (VInt c, c + 1)
+        | Just v <- lookup name provided = Right (v, bump name col c v)
+        | Just d <- columnDefault col = Right (d, c)
+        | columnNullable col = Right (VNull, c)
+        | otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
+    bump name _ c v
+        | Just (autoName, _) <- auto
+        , name == autoName = max (c + 1) (valueInt v + 1)
+        | otherwise = c
+
+valueInt :: Value -> Int
+valueInt (VInt n) = n
+valueInt _ = 0
+
+-- | 自增列（至多一个）
+autoColumn :: Table -> Maybe (String, Column)
+autoColumn table = case [(n, c) | (n, c) <- tableCols table, columnAutoIncrement c] of
+    (entry : _) -> Just entry
+    [] -> Nothing
+
+-- | 下一个自增值
+autoStart :: Maybe (String, Column) -> [Row] -> Int
+autoStart Nothing _ = 1
+autoStart (Just (name, _)) rows = case [n | r <- rows, Just (VInt n) <- [lookup name r]] of
+    [] -> 1
+    ns -> maximum ns + 1
+
+-- | 执行 CHECK 约束
+runChecks :: Table -> Row -> Either String ()
+runChecks table row = mapM_ check (tableCols table)
+  where
+    check (name, col) = case columnCheck col of
+        Nothing -> Right ()
+        Just text -> case parseExpression text of
+            Left err -> Left ("CHECK on " ++ name ++ ": " ++ firstLine err)
+            Right e -> case evalCondForRow e row of
+                Left err -> Left ("CHECK on " ++ name ++ ": " ++ err)
+                Right True -> Right ()
+                Right False -> Left ("CHECK on " ++ name ++ " failed")
+
+firstLine :: String -> String
+firstLine = takeWhile (/= '\n')
+
+-- | NOT NULL 检查
+enforceNotNull :: [(String, Column)] -> [Row] -> Either String ()
+enforceNotNull cols rows = mapM_ check cols
+  where
+    check (name, col)
+        | columnNullable col = Right ()
+        | any (\r -> lookup name r == Just VNull) rows = Left ("NOT NULL: column " ++ name ++ " cannot be null")
+        | otherwise = Right ()
+
+-- | 唯一性检查（NULL 之间不算冲突）
+enforceUnique :: [(String, Column)] -> [Row] -> Either String ()
+enforceUnique cols rows = mapM_ check targets
+  where
+    targets = [(n, c) | (n, c) <- cols, columnUnique c || columnPrimaryKey c]
+    check (name, _) = go name [] (mapMaybe (lookup name) rows)
+    go _ _ [] = Right ()
+    go name seen (VNull : rest) = go name seen rest
+    go name seen (v : rest)
+        | v `elem` seen = Left ("UNIQUE: duplicate value in column " ++ name)
+        | otherwise = go name (v : seen) rest
+
+-- | UPDATE 的一行（条件与赋值都可能带子查询）
+updateRowM :: (MonadStorage m) => Database -> Table -> Maybe Expr -> [(String, Expr)] -> Row -> m (Either String Row)
+updateRowM db table cond asgns row = do
+    keep <- case cond of
+        Nothing -> pure (Right True)
+        Just e -> evalCondForRowM db e row
+    case keep of
+        Left err -> pure (Left err)
+        Right False -> pure (Right row)
+        Right True -> do
+            row' <- applyUpdatesM db table asgns row
+            pure (row' >>= \r -> runChecks table r >> Right r)
+
+-- | 依次求值、收类型并覆盖列（表达式可以带子查询）
+applyUpdatesM :: (MonadStorage m) => Database -> Table -> [(String, Expr)] -> Row -> m (Either String Row)
+applyUpdatesM _ _ [] row = pure (Right row)
+applyUpdatesM db table ((col, e) : rest) row = do
+    v <- evalExprM db e row
+    case v of
+        Left err -> pure (Left err)
+        Right val -> case colType table col of
+            Just def -> case coerceValue (columnType def) val of
+                Left err -> pure (Left err)
+                Right v' -> applyUpdatesM db table rest (setColumn col v' row)
+            Nothing -> applyUpdatesM db table rest (setColumn col val row)
+
+-- | 覆盖一列
+setColumn :: String -> Value -> Row -> Row
+setColumn col v = map (\(k, val) -> if k == col then (k, v) else (k, val))
+
+-- | 按条件把行分成待删和保留两拨（条件可以带子查询）
+splitByConditionM :: (MonadStorage m) => Database -> Maybe Expr -> [Row] -> m (Either String ([Row], [Row]))
+splitByConditionM db cond = go [] []
+  where
+    go doomed kept [] = pure (Right (reverse doomed, reverse kept))
     go doomed kept (r : rs) = do
         hit <- case cond of
-            Nothing -> Right True
-            Just e -> evalCondForRow e r
-        go (if hit then r : doomed else doomed) (if hit then kept else r : kept) rs
+            Nothing -> pure (Right True)
+            Just e -> evalCondForRowM db e r
+        case hit of
+            Left err -> pure (Left err)
+            Right h -> go (if h then r : doomed else doomed) (if h then kept else r : kept) rs
 
--- | 依次求值并覆盖列
-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'
+-- | 表结构变更的统一入口：扫全表，改完整体回写
+alterTable ::
+    (MonadStorage m) =>
+    Database ->
+    String ->
+    (Table -> Either String ([(String, Column)], [Row])) ->
+    m (Either String [Row])
+alterTable db tbl change = case lookupTable db tbl of
+    Left e -> pure (Left e)
+    Right table -> do
+        rowsResult <- scan tbl
+        case rowsResult of
+            Left e -> pure (Left e)
+            Right rows -> case change table{tableRows = rows} >>= checkAltered of
+                Left e -> pure (Left e)
+                Right (cols, newRows) -> do
+                    result <- replaceSchema tbl cols newRows
+                    pure (result >> Right [])
+  where
+    checkAltered (cols, rows) = do
+        let table = Table tbl cols rows
+        mapM_ (runChecks table) rows
+        enforceNotNull cols rows
+        enforceUnique cols rows
+        Right (cols, rows)
+
+-- | ADD COLUMN：老行补默认值或 NULL，自增列从 1 开始
+addColumnTo :: (String, Column) -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+addColumnTo (name, col) cols rows
+    | name `elem` map fst cols = Left ("ADD COLUMN: column already exists: " ++ name)
+    | otherwise = do
+        values <- fill
+        Right (cols ++ [(name, col)], [r ++ [(name, v)] | (r, v) <- zip rows values])
+  where
+    fill
+        | columnAutoIncrement col = mapM (coerceValue (columnType col) . VInt) [1 .. length rows]
+        | Just d <- columnDefault col = mapM (\_ -> coerceValue (columnType col) d) rows
+        | columnNullable col = mapM (\_ -> coerceValue (columnType col) VNull) rows
+        | null rows = Right []
+        | otherwise = Left ("ADD COLUMN: column " ++ name ++ " is NOT NULL and has no default")
+
+-- | RENAME COLUMN：列定义与每一行的键一起改
+renameColumnIn :: String -> String -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+renameColumnIn old new cols rows
+    | old `notElem` map fst cols = Left ("RENAME COLUMN: unknown column: " ++ old)
+    | new `elem` map fst cols = Left ("RENAME COLUMN: column already exists: " ++ new)
+    | otherwise = Right (renameKeys cols, map renameKeys rows)
+  where
+    renameKeys = map (\(k, v) -> if k == old then (new, v) else (k, v))
+
+-- | ALTER COLUMN TYPE：老值收进新类型
+retypeColumn :: String -> ColumnType -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+retypeColumn col ty cols rows
+    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
+    | otherwise = do
+        rows' <- mapM convert rows
+        Right (map (\entry@(n, c) -> if n == col then (n, c{columnType = ty}) else entry) cols, rows')
+  where
+    convert row = case lookup col row of
+        Nothing -> Right row
+        Just v -> do
+            v' <- coerceValue ty v
+            Right (map (\(k, x) -> if k == col then (k, v') else (k, x)) row)
+
+-- | ALTER COLUMN SET/DROP DEFAULT
+setColumnDefault :: String -> Maybe Value -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+setColumnDefault col def cols rows
+    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
+    | otherwise = Right (map (\entry@(n, c) -> if n == col then (n, c{columnDefault = def}) else entry) cols, rows)
+
+-- | ALTER COLUMN SET/DROP NOT NULL
+setColumnNullable :: String -> Bool -> [(String, Column)] -> [Row] -> Either String ([(String, Column)], [Row])
+setColumnNullable col nullable cols rows
+    | col `notElem` map fst cols = Left ("ALTER COLUMN: unknown column: " ++ col)
+    | otherwise = Right (map (\entry@(n, c) -> if n == col then (n, c{columnNullable = nullable}) else entry) cols, rows)

chusql-engine/src/ChuSQL/Model.hs

@@ -1,27 +1,354 @@
-module ChuSQL.Model (Column (..), Value (..), Row, Table (..), Database, colNames, colType, lookupTable, allColumns, qualify, unqualify) where
+{-# LANGUAGE PatternSynonyms #-}
 
+module ChuSQL.Model
+    ( ColumnType (..)
+    , Column (..)
+    , pattern TInt
+    , pattern TStr
+    , pattern TBool
+    , TypeClass (..)
+    , Value (..)
+    , Row
+    , Table (..)
+    , Database
+    , colNames
+    , colType
+    , lookupTable
+    , allColumns
+    , qualify
+    , unqualify
+    , resolveColumn
+    , plainColumn
+    , typeLabel
+    , typeName
+    , parseColumnType
+    , typeClassOf
+    , assignable
+    , integerType
+    , numericType
+    , valueFits
+    , coerceValue
+    ) where
+
+import Data.Char (isDigit, isSpace, toLower)
 import Data.Hashable (Hashable (..))
-import Data.List (stripPrefix)
+import Data.List (isSuffixOf, stripPrefix)
 import Data.Maybe (fromMaybe)
 
--- 数据模型：列类型、值、行、表、数据库，外加几个查表小工具。
+-- 数据模型：列类型、列约束、值、行、表、数据库，外加几个查表小工具。
 
-data Column
-    = TInt
-    | TStr
-    | TBool
+-- | 列的基础类型
+data ColumnType
+    = CInt
+    | CBigInt
+    | CSmallInt
+    | CStr
+    | CVarchar Int
+    | CChar Int
+    | CBool
+    | CFloat
+    | CDouble
+    | CDecimal Int Int
+    | CDate
+    | CTimestamp
+    | CBlob
     deriving (Show, Eq)
 
+-- | 列定义：类型 + 约束；约束全部取默认值就是普通可空列。
+data Column = Column
+    { columnType :: ColumnType
+    , columnNullable :: Bool
+    , columnDefault :: Maybe Value
+    , columnAutoIncrement :: Bool
+    , columnUnique :: Bool
+    , columnPrimaryKey :: Bool
+    , columnCheck :: Maybe String
+    }
+    deriving (Eq)
+
+-- | 普通可空列
+plainColumn :: ColumnType -> Column
+plainColumn t = Column t True Nothing False False False Nothing
+
+pattern TInt :: Column
+pattern TInt <- Column CInt _ _ _ _ _ _
+  where
+    TInt = plainColumn CInt
+
+pattern TStr :: Column
+pattern TStr <- Column CStr _ _ _ _ _ _
+  where
+    TStr = plainColumn CStr
+
+pattern TBool :: Column
+pattern TBool <- Column CBool _ _ _ _ _ _
+  where
+    TBool = plainColumn CBool
+
+-- | 错误消息里用的类型名
+typeLabel :: ColumnType -> String
+typeLabel CInt = "TInt"
+typeLabel CBigInt = "TBigInt"
+typeLabel CSmallInt = "TSmallInt"
+typeLabel CStr = "TStr"
+typeLabel (CVarchar n) = "TVarchar " ++ show n
+typeLabel (CChar n) = "TChar " ++ show n
+typeLabel CBool = "TBool"
+typeLabel CFloat = "TFloat"
+typeLabel CDouble = "TDouble"
+typeLabel (CDecimal p s) = "TDecimal " ++ show p ++ " " ++ show s
+typeLabel CDate = "TDate"
+typeLabel CTimestamp = "TTimestamp"
+typeLabel CBlob = "TBlob"
+
+-- | 线上/磁盘上的类型名
+typeName :: ColumnType -> String
+typeName CInt = "int"
+typeName CBigInt = "bigint"
+typeName CSmallInt = "smallint"
+typeName CStr = "str"
+typeName (CVarchar n) = "varchar(" ++ show n ++ ")"
+typeName (CChar n) = "char(" ++ show n ++ ")"
+typeName CBool = "bool"
+typeName CFloat = "float"
+typeName CDouble = "double"
+typeName (CDecimal p s) = "decimal(" ++ show p ++ "," ++ show s ++ ")"
+typeName CDate = "date"
+typeName CTimestamp = "timestamp"
+typeName CBlob = "blob"
+
+-- | 解析类型名，可带长度/精度参数；不认识的给 Nothing
+parseColumnType :: String -> Maybe ColumnType
+parseColumnType raw = case (base, args) of
+    ("int", []) -> Just CInt
+    ("integer", []) -> Just CInt
+    ("bigint", []) -> Just CBigInt
+    ("smallint", []) -> Just CSmallInt
+    ("str", []) -> Just CStr
+    ("text", []) -> Just CStr
+    ("varchar", []) -> Just CStr
+    ("varchar", [n]) -> CVarchar <$> positive n
+    ("char", []) -> Just (CChar 1)
+    ("char", [n]) -> CChar <$> positive n
+    ("bool", []) -> Just CBool
+    ("boolean", []) -> Just CBool
+    ("float", []) -> Just CFloat
+    ("real", []) -> Just CFloat
+    ("double", []) -> Just CDouble
+    ("decimal", []) -> Just (CDecimal 10 0)
+    ("numeric", []) -> Just (CDecimal 10 0)
+    ("decimal", [p]) -> flip CDecimal 0 <$> positive p
+    ("numeric", [p]) -> flip CDecimal 0 <$> positive p
+    ("decimal", [p, s]) -> CDecimal <$> positive p <*> plain s
+    ("numeric", [p, s]) -> CDecimal <$> positive p <*> plain s
+    ("date", []) -> Just CDate
+    ("timestamp", []) -> Just CTimestamp
+    ("blob", []) -> Just CBlob
+    _ -> Nothing
+  where
+    cleaned = map toLower (filter (not . isSpace) raw)
+    (base, rest) = span (/= '(') cleaned
+    args = case stripSuffixMaybe ")" (drop 1 rest) of
+        Nothing -> []
+        Just inner -> map (filter (not . isSpace)) (splitOn ',' inner)
+
+-- | 去掉结尾
+stripSuffixMaybe :: String -> String -> Maybe String
+stripSuffixMaybe suffix s
+    | suffix `isSuffixOf` s = Just (take (length s - length suffix) s)
+    | otherwise = Nothing
+
+-- | 按逗号切开
+splitOn :: Char -> String -> [String]
+splitOn sep s = case break (== sep) s of
+    (part, []) -> [part]
+    (part, _ : rest) -> part : splitOn sep rest
+
+-- | 正数参数
+positive :: String -> Maybe Int
+positive s
+    | not (null s) && all isDigit s = Just (read s)
+    | otherwise = Nothing
+
+-- | 非负整数参数
+plain :: String -> Maybe Int
+plain = positive
+
+-- | 写出普通列就只说类型名，带约束才补在后面
+instance Show Column where
+    show c = typeLabel (columnType c) ++ notNull ++ def ++ auto ++ uni ++ key ++ check
+      where
+        notNull = if columnNullable c then "" else " NOT NULL"
+        def = maybe "" (\v -> " DEFAULT " ++ show v) (columnDefault c)
+        auto = if columnAutoIncrement c then " AUTO_INCREMENT" else ""
+        uni = if columnUnique c then " UNIQUE" else ""
+        key = if columnPrimaryKey c then " PRIMARY KEY" else ""
+        check = maybe "" (\s -> " CHECK (" ++ s ++ ")") (columnCheck c)
+
+-- | 类型大类
+data TypeClass
+    = NumericClass
+    | TextClass
+    | TemporalClass
+    | BooleanClass
+    deriving (Show, Eq)
+
+typeClassOf :: ColumnType -> TypeClass
+typeClassOf CInt = NumericClass
+typeClassOf CBigInt = NumericClass
+typeClassOf CSmallInt = NumericClass
+typeClassOf CFloat = NumericClass
+typeClassOf CDouble = NumericClass
+typeClassOf CDecimal{} = NumericClass
+typeClassOf CStr = TextClass
+typeClassOf CVarchar{} = TextClass
+typeClassOf CChar{} = TextClass
+typeClassOf CBlob = TextClass
+typeClassOf CDate = TemporalClass
+typeClassOf CTimestamp = TemporalClass
+typeClassOf CBool = BooleanClass
+
+-- | 同大类可赋值；日期/时间列接受字符串字面量
+assignable :: ColumnType -> ColumnType -> Bool
+assignable target source
+    | target == source = True
+    | typeClassOf target == typeClassOf source = True
+    | typeClassOf target == TemporalClass && typeClassOf source == TextClass = True
+    | otherwise = False
+
+integerType :: ColumnType -> Bool
+integerType CInt = True
+integerType CBigInt = True
+integerType CSmallInt = True
+integerType _ = False
+
+numericType :: ColumnType -> Bool
+numericType t = typeClassOf t == NumericClass
+
+-- | 值能不能放进这一列（先不看可空）
+valueFits :: ColumnType -> Value -> Bool
+valueFits _ VNull = True
+valueFits CInt (VInt _) = True
+valueFits CBigInt (VInt _) = True
+valueFits CSmallInt (VInt _) = True
+valueFits CFloat (VInt _) = True
+valueFits CFloat (VFloat _) = True
+valueFits CDouble (VInt _) = True
+valueFits CDouble (VFloat _) = True
+valueFits CDecimal{} (VInt _) = True
+valueFits CDecimal{} (VFloat _) = True
+valueFits CStr (VStr _) = True
+valueFits CVarchar{} (VStr _) = True
+valueFits CChar{} (VStr _) = True
+valueFits CBool (VBool _) = True
+valueFits CDate (VStr _) = True
+valueFits CTimestamp (VStr _) = True
+valueFits CBlob (VStr _) = True
+valueFits _ _ = False
+
+-- | 把值收进列类型：NULL 原样通过，类型不符报错
+coerceValue :: ColumnType -> Value -> Either String Value
+coerceValue _ VNull = Right VNull
+coerceValue t v = case t of
+    CInt -> toInt t v
+    CBigInt -> toInt t v
+    CSmallInt -> toInt t v
+    CFloat -> toFloat t v
+    CDouble -> toFloat t v
+    CDecimal p s -> toDecimal p s v
+    CStr -> toText t v
+    CVarchar n -> toSized n v
+    CChar n -> toSized n v
+    CBool -> toBool t v
+    CDate -> toDate v
+    CTimestamp -> toTimestamp v
+    CBlob -> toText t v
+
+toInt :: ColumnType -> Value -> Either String Value
+toInt _ (VInt n) = Right (VInt n)
+toInt t (VFloat d) = case properFraction d :: (Int, Double) of
+    (n, frac)
+        | frac == 0 -> Right (VInt n)
+        | otherwise -> Left ("cannot put a fractional number into " ++ typeLabel t)
+toInt t _ = Left ("cannot put this value into " ++ typeLabel t)
+
+toFloat :: ColumnType -> Value -> Either String Value
+toFloat _ (VInt n) = Right (VFloat (fromIntegral n))
+toFloat _ (VFloat d) = Right (VFloat d)
+toFloat t _ = Left ("cannot put this value into " ++ typeLabel t)
+
+-- | DECIMAL 按小数位四舍五入
+toDecimal :: Int -> Int -> Value -> Either String Value
+toDecimal p s v = case v of
+    VInt n -> rounded (fromIntegral n)
+    VFloat d -> rounded d
+    _ -> Left ("cannot put this value into " ++ typeLabel (CDecimal p s))
+  where
+    scale = (10 :: Double) ^ max 0 s
+    rounded d = Right (VFloat (fromIntegral (round (d * scale) :: Integer) / scale))
+
+toText :: ColumnType -> Value -> Either String Value
+toText _ (VStr s) = Right (VStr s)
+toText t _ = Left ("cannot put this value into " ++ typeLabel t)
+
+toSized :: Int -> Value -> Either String Value
+toSized n (VStr s)
+    | length s <= n = Right (VStr s)
+    | otherwise = Left ("value is longer than " ++ show n ++ " characters")
+toSized _ _ = Left "cannot put this value into a character column"
+
+toBool :: ColumnType -> Value -> Either String Value
+toBool _ (VBool b) = Right (VBool b)
+toBool t _ = Left ("cannot put this value into " ++ typeLabel t)
+
+toDate :: Value -> Either String Value
+toDate (VStr s)
+    | validDateText s = Right (VStr s)
+    | otherwise = Left "date must look like YYYY-MM-DD"
+toDate _ = Left "date must be a string"
+
+toTimestamp :: Value -> Either String Value
+toTimestamp (VStr s)
+    | validTimestampText s = Right (VStr s)
+    | otherwise = Left "timestamp must look like YYYY-MM-DD HH:MM:SS"
+toTimestamp _ = Left "timestamp must be a string"
+
+-- | YYYY-MM-DD
+validDateText :: String -> Bool
+validDateText s = case splitOn '-' s of
+    [y, m, d] -> allOf 4 y && allOf 2 m && allOf 2 d
+    _ -> False
+
+-- | YYYY-MM-DD HH:MM:SS，日期与时间之间允许空格或 T
+validTimestampText :: String -> Bool
+validTimestampText s = case break (\c -> c == ' ' || c == 'T') s of
+    (d, _ : tm) -> validDateText d && validTimeText tm
+    _ -> False
+
+-- | HH:MM:SS
+validTimeText :: String -> Bool
+validTimeText t = case splitOn ':' t of
+    [h, m, sec] -> allOf 2 h && allOf 2 m && allOf 2 sec
+    _ -> False
+
+allOf :: Int -> String -> Bool
+allOf n s = length s == n && all isDigit s
+
+
 data Value
-    = VInt Int
+    = VNull
+    | VInt Int
+    | VFloat Double
     | VStr String
     | VBool Bool
     deriving (Show, Eq)
 
 instance Hashable Value where
-    hashWithSalt s (VInt n) = hashWithSalt (hashWithSalt s (0 :: Int)) n
-    hashWithSalt s (VStr t) = hashWithSalt (hashWithSalt s (1 :: Int)) t
-    hashWithSalt s (VBool b) = hashWithSalt (hashWithSalt s (2 :: Int)) b
+    hashWithSalt s VNull = hashWithSalt (hashWithSalt s (0 :: Int)) ()
+    hashWithSalt s (VInt n) = hashWithSalt (hashWithSalt s (1 :: Int)) n
+    hashWithSalt s (VFloat d) = hashWithSalt (hashWithSalt s (2 :: Int)) d
+    hashWithSalt s (VStr t) = hashWithSalt (hashWithSalt s (3 :: Int)) t
+    hashWithSalt s (VBool b) = hashWithSalt (hashWithSalt s (4 :: Int)) b
 
 type Row = [(String, Value)]
 
@@ -38,7 +365,7 @@ type Database = [(String, Table)]
 colNames :: Table -> [String]
 colNames = map fst . tableCols
 
--- | 查某列的类型
+-- | 查某列的定义
 colType :: Table -> String -> Maybe Column
 colType t c = lookup c (tableCols t)
 
@@ -58,3 +385,12 @@ qualify (Just a) c = a ++ "." ++ c
 unqualify :: Maybe String -> String -> String
 unqualify Nothing c = c
 unqualify (Just a) c = fromMaybe c (stripPrefix (a ++ ".") c)
+
+-- | 裸列仅允许唯一匹配，限定名必须精确匹配
+resolveColumn :: String -> [(String, a)] -> Either String (String, a)
+resolveColumn name env = case [(k, v) | (k, v) <- env, matches k] of
+    [entry] -> Right entry
+    [] -> Left ("unknown column: " ++ name)
+    _ -> Left ("ambiguous column: " ++ name)
+  where
+    matches k = k == name || ('.' : name) `isSuffixOf` k

chusql-engine/src/ChuSQL/Semantic.hs

@@ -1,30 +1,65 @@
-module ChuSQL.Semantic (check) where
+module ChuSQL.Semantic (check, prepare) where
 
-import ChuSQL.Algebra.Expr (colsInExpr)
+import ChuSQL.Algebra.Expr (bareColumns, colsInExpr, hasAggregate)
 import ChuSQL.Model
 import ChuSQL.Syntax.AST
-import Data.List (intercalate, nub)
+import ChuSQL.Syntax.Parser (parseExpression)
+import Data.Char (isAlphaNum, isAscii, toLower)
+import Data.List (intercalate, isInfixOf, isPrefixOf, nub)
+import Data.Maybe (fromMaybe)
 
 -- 语义检查：表和列在不在、类型对不对，全部在执行前查。
 
+-- | 推导出来的类型：NULL 没有类型，可以放进任何列
+data InferredType
+    = InferNull
+    | InferType ColumnType
+    deriving (Show, Eq)
+
 -- | 给列名加上别名前缀
 prefixColumns :: Maybe String -> [(String, Column)] -> [(String, Column)]
 prefixColumns mAlias cols = [(prefix ++ c, ty) | (c, ty) <- cols]
   where
     prefix = maybe "" (++ ".") mAlias
 
--- | 收集 FROM 能提供的列
-checkFrom :: Database -> FromClause -> Either String [(String, Column)]
-checkFrom db (FromTable mAlias tbl) = do
+-- | 检查期的作用域：本层优先，外层兜底。
+-- 不能把两层平铺成一个列表：同名裸列会出现两次，被误报成 ambiguous。
+data Scope = Scope
+    { scopeInner :: [(String, Column)]
+    , scopeOuter :: [(String, Column)]
+    }
+
+-- | 本层先查，查不到再落外层；本层同名引起歧义时不往外层让
+scopeAt :: String -> Scope -> String -> Either String (String, Column)
+scopeAt place scope c
+    | null (scopeOuter scope) = columnAt place (scopeInner scope) c
+    | otherwise = case columnAt place (scopeInner scope) c of
+        Right entry -> Right entry
+        Left err
+            | "ambiguous column:" `isInfixOf` err -> Left err
+            | otherwise -> columnAt place (scopeOuter scope) c
+
+-- | 收集 FROM 能提供的列；outer 是外层作用域，给 ON 里的相关子查询用
+checkFrom :: Database -> [(String, Column)] -> FromClause -> Either String [(String, Column)]
+checkFrom _ _ FromUnit = Right []
+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
+    Right (prefixColumns (Just (fromMaybe tbl mAlias)) (tableCols t))
+checkFrom db outer (FromJoin _ left mAlias tbl cond) = do
+    lcols <- checkFrom db outer left
     t <- lookupTable db tbl
-    let env = lcols ++ prefixColumns mAlias (tableCols t)
-    checkBool "ON" env cond
+    let env = lcols ++ prefixColumns (Just (fromMaybe tbl mAlias)) (tableCols t)
+    checkBool db "ON" (Scope env outer) cond
     Right env
 
+-- | 本层作用域优先：外层已有的同名键不再重复堆进来（否则同一个键被数两次，误报 ambiguous）
+scopedEnv :: [(String, Column)] -> [(String, Column)] -> [(String, Column)]
+scopedEnv env outer = env ++ [o | o <- outer, o `notElem` env]
+
+-- | 作用域摊平成一层（只用于继续往外传，查找仍走 scopeAt 的本层优先）
+scopeFlat :: Scope -> [(String, Column)]
+scopeFlat scope = scopedEnv (scopeInner scope) (scopeOuter scope)
+
 -- | 拼“列不存在”的报错
 missingColumn :: String -> String -> [(String, Column)] -> String
 missingColumn place c env =
@@ -32,94 +67,287 @@ missingColumn place c env =
   where
     hint
         | null env = ""
-        | otherwise = " (available: " ++ intercalate ", " (map fst env) ++ ")"
+        | otherwise = " (available: " ++ intercalate ", " (map (reverse . takeWhile (/= '.') . reverse . fst) env) ++ "; qualified: " ++ intercalate ", " (map fst env) ++ ")"
 
 -- | 检查列是否都在环境里
-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)
+checkColumns :: String -> Scope -> [String] -> Either String ()
+checkColumns place env = mapM_ (\c -> if c == allColumns then Right () else () <$ scopeAt place env c)
 
--- | 推导表达式的类型
-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)
+-- | 保留子句名与可用列提示
+columnAt :: String -> [(String, Column)] -> String -> Either String (String, Column)
+columnAt place env c = case resolveColumn c env of
+    Right entry -> Right entry
+    Left err | "ambiguous column:" `isPrefixOf` err -> Left (place ++ ": " ++ err)
+    Left _ -> Left (missingColumn place c env)
 
--- | 检查二元运算两边的类型
-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)
+-- | 聚合不能出现在 WHERE 里
+checkNoAggregate :: String -> Expr -> Either String ()
+checkNoAggregate place e
+    | hasAggregate e = Left (place ++ ": aggregate functions are not allowed here")
+    | otherwise = Right ()
+
+-- | 分组查询里，没被聚合的列必须出现在 GROUP BY 里
+checkGrouping :: Scope -> [String] -> [(String, Expr)] -> Either String ()
+checkGrouping env keys items
+    | null keys && not (any (hasAggregate . snd) items) = Right ()
+    | otherwise = do
+        checkColumns "GROUP BY" env keys
+        mapM_ okCol (nub (concatMap (bareColumns . snd) items))
+  where
+    okCol c
+        | c == allColumns = Left "SELECT: * cannot be selected together with GROUP BY"
+        | c `elem` keys = Right ()
+        | otherwise = Left ("SELECT: column " ++ c ++ " must appear in GROUP BY or be aggregated")
+
+-- | 渲染一个推导类型
+renderType :: InferredType -> String
+renderType InferNull = "NULL"
+renderType (InferType t) = typeLabel t
+
+-- | 推导表达式的类型（子查询也在这里整条查一遍）
+inferExpr :: Database -> String -> Scope -> Expr -> Either String InferredType
+inferExpr _ place env (Col c) = InferType . columnType . snd <$> scopeAt place env c
+inferExpr _ _ _ LitNull = Right InferNull
+inferExpr _ _ _ (LitInt _) = Right (InferType CInt)
+inferExpr _ _ _ (LitFloat _) = Right (InferType CFloat)
+inferExpr _ _ _ (LitStr _) = Right (InferType CStr)
+inferExpr _ _ _ (LitBool _) = Right (InferType CBool)
+inferExpr _ _ _ (LitDate _) = Right (InferType CDate)
+inferExpr _ _ _ (LitTimestamp _) = Right (InferType CTimestamp)
+inferExpr _ _ _ (LitBlob _) = Right (InferType CBlob)
+inferExpr db place env (Add a b) = arithmetic db place env a b
+inferExpr db place env (Sub a b) = arithmetic db place env a b
+inferExpr db place env (Mul a b) = arithmetic db place env a b
+inferExpr db place env (Div a b) = arithmetic db place env a b
+inferExpr db place env (Neg a) = do
+    t <- inferExpr db place env a
+    case t of
+        InferNull -> Right InferNull
+        InferType x
+            | numericType x -> Right t
+            | otherwise -> Left (place ++ ": operator needs TInt on both sides, got TInt and " ++ typeLabel x)
+inferExpr db place env (Gt a b) = comparison db place env a b
+inferExpr db place env (Lt a b) = comparison db place env a b
+inferExpr db place env (Eq a b) = comparison db place env a b
+inferExpr db place env (And a b) = boolean db place env a b
+inferExpr db place env (Or a b) = boolean db place env a b
+inferExpr db place env (IsNull a) = inferExpr db place env a >> Right (InferType CBool)
+inferExpr db place env (IsNotNull a) = inferExpr db place env a >> Right (InferType CBool)
+inferExpr _ _ _ CountAll = Right (InferType CInt)
+inferExpr db place env (CountOf a) = do
+    _ <- aggregateArg db place env a
+    Right (InferType CInt)
+inferExpr db place env (SumOf a) = aggregateArg db place env a >>= numericResult "SUM" place
+inferExpr db place env (AvgOf a) = do
+    t <- aggregateArg db place env a
+    case t of
+        InferNull -> Right InferNull
+        InferType x
+            | numericType x -> Right (InferType CFloat)
+            | otherwise -> Left (place ++ ": AVG needs a number, got " ++ typeLabel x)
+inferExpr db place env (MinOf a) = aggregateArg db place env a
+inferExpr db place env (MaxOf a) = aggregateArg db place env a
+inferExpr db place env (ScalarSub sq) = do
+    cols <- inferSubqueryOutput db env sq
+    case cols of
+        [(_, t)] -> Right t
+        _ -> Left (place ++ ": scalar subquery must return exactly one column")
+inferExpr db place env (InSub a sq _) = do
+    ta <- inferExpr db place env a
+    cols <- inferSubqueryOutput db env sq
+    case cols of
+        [(_, t)]
+            | compatible ta t -> Right (InferType CBool)
+            | otherwise -> Left (place ++ ": IN subquery column has type " ++ renderType t ++ ", expected " ++ renderType ta)
+        _ -> Left (place ++ ": IN subquery must return exactly one column")
+inferExpr db place env (InList a es _) = do
+    ta <- inferExpr db place env a
+    ts <- mapM (inferExpr db place env) es
+    mapM_ (itemType place ta) ts
+    Right (InferType CBool)
+inferExpr _ _ _ (ExistsSub _ _) = Right (InferType CBool)
+
+-- | IN 列表里的每一项都要跟左边的类型对得上
+itemType :: String -> InferredType -> InferredType -> Either String ()
+itemType place want got
+    | compatible want got = Right ()
+    | otherwise = Left (place ++ ": IN list item has type " ++ renderType got ++ ", expected " ++ renderType want)
+
+-- | 子查询的输出列与类型（外层作用域 outerScope 可做相关引用，内层整条查一遍）
+inferSubqueryOutput :: Database -> Scope -> Subquery -> Either String [(String, InferredType)]
+inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
+    q@Select { selectCols = cols } -> do
+        env <- checkFrom db enclosing (selectFrom q)
+        checkResolvedWith db enclosing q
+        mapM (columnTypeOf env) cols
+    q@SelectExpr { selectItems = items } -> do
+        env <- checkFrom db enclosing (selectFrom q)
+        checkResolvedWith db enclosing q
+        mapM (\(l, e) -> (\t -> (l, t)) <$> inferExpr db "SELECT" (Scope env enclosing) e) items
+    _ -> Left "subquery must be a SELECT"
+  where
+    enclosing = scopeFlat outerScope
+    columnTypeOf env c = do
+        (_, col) <- scopeAt "SELECT" (Scope env enclosing) c
+        Right (c, InferType (columnType col))
+
+-- | 聚合的参数：列要在，且不能嵌套聚合
+aggregateArg :: Database -> String -> Scope -> Expr -> Either String InferredType
+aggregateArg db place env a
+    | hasAggregate a = Left (place ++ ": nested aggregates are not allowed")
+    | otherwise = inferExpr db place env a
+
+-- | 数值聚合的结果类型：整数进整数出，其它往浮点靠
+numericResult :: String -> String -> InferredType -> Either String InferredType
+numericResult fn place t = case t of
+    InferNull -> Right InferNull
+    InferType x
+        | numericType x -> Right (if integerType x then InferType x else InferType CFloat)
+        | otherwise -> Left (place ++ ": " ++ fn ++ " needs a number, got " ++ typeLabel x)
+
+-- | 算术结果：有小数就出小数，否则是整数
+arithResult :: InferredType -> InferredType -> InferredType
+arithResult InferNull _ = InferNull
+arithResult _ InferNull = InferNull
+arithResult (InferType a) (InferType b)
+    | integerType a && integerType b = InferType CInt
+    | otherwise = InferType CFloat
+
+-- | 算术两边的类型检查
+arithmetic :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
+arithmetic db place env a b = do
+    ta <- inferExpr db place env a
+    tb <- inferExpr db place env b
+    let want = if any isFloatSide [ta, tb] then CFloat else CInt
+    mapM_ (numericOperand place (InferType want) (InferType want)) [ta, tb]
+    Right (arithResult ta tb)
+  where
+    isFloatSide (InferType x) = numericType x && not (integerType x)
+    isFloatSide _ = False
+
+-- | 一侧必须是数
+numericOperand :: String -> InferredType -> InferredType -> InferredType -> Either String ()
+numericOperand place want other t = case t of
+    InferNull -> Right ()
+    InferType x | numericType x -> Right ()
+    _ -> Left (place ++ ": operator needs " ++ renderType want ++ " on both sides, got " ++ renderType other ++ " and " ++ renderType t)
+
+-- | 比较两边的类型检查
+comparison :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
+comparison db place env a b = do
+    ta <- inferExpr db place env a
+    tb <- inferExpr db place env b
+    if compatible ta tb
+        then Right (InferType CBool)
+        else Left (place ++ ": both sides of = must have the same type, got " ++ renderType ta ++ " and " ++ renderType tb)
+
+-- | 两类能不能比
+compatible :: InferredType -> InferredType -> Bool
+compatible InferNull _ = True
+compatible _ InferNull = True
+compatible (InferType a) (InferType b)
+    | numericType a && numericType b = True
+    | typeClassOf a == typeClassOf b = True
+    | typeClassOf a == TemporalClass && typeClassOf b == TextClass = True
+    | typeClassOf b == TemporalClass && typeClassOf a == TextClass = True
+    | otherwise = False
+
+-- | 逻辑运算两边的类型检查
+boolean :: Database -> String -> Scope -> Expr -> Expr -> Either String InferredType
+boolean db place env a b = do
+    ta <- inferExpr db place env a
+    tb <- inferExpr db place env b
+    mapM_ (boolOperand place ta) [ta, tb]
+    Right (InferType CBool)
+  where
+    boolOperand _ _ InferNull = Right ()
+    boolOperand _ _ (InferType CBool) = Right ()
+    boolOperand p other t = Left (p ++ ": operator needs TBool on both sides, got " ++ renderType other ++ " and " ++ renderType t)
 
 -- | 要求条件能算出布尔
-checkBool :: String -> [(String, Column)] -> Expr -> Either String ()
-checkBool place env e = do
+checkBool :: Database -> String -> Scope -> Expr -> Either String ()
+checkBool db 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)
+    t <- inferExpr db place env e
+    case t of
+        InferNull -> Right ()
+        InferType CBool -> Right ()
+        InferType x -> Left (place ++ ": condition must be a boolean, got " ++ typeLabel x)
 
 -- | 检查赋值列和类型
-checkTyped :: String -> [(String, Column)] -> Table -> (String, Expr) -> Either String ()
-checkTyped place env t (c, e) = do
+checkTyped :: Database -> String -> Scope -> Table -> (String, Expr) -> Either String ()
+checkTyped db 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)
+    got <- inferExpr db place env e
+    case got of
+        InferNull -> Right ()
+        InferType x
+            | assignable (columnType want) x -> Right ()
+            | otherwise -> Left (place ++ ": column " ++ c ++ " needs " ++ show want ++ ", got " ++ typeLabel x)
 
 -- | 检查插入值的类型
-checkValue :: Table -> (String, Expr) -> Either String ()
-checkValue = checkTyped "INSERT" []
+checkValue :: Database -> Table -> (String, Expr) -> Either String ()
+checkValue db = checkTyped db "INSERT" (Scope [] [])
 
 -- | 检查 UPDATE 的赋值
-checkAssign :: Table -> (String, Expr) -> Either String ()
-checkAssign t = checkTyped "UPDATE" (tableCols t) t
+checkAssign :: Database -> Table -> (String, Expr) -> Either String ()
+checkAssign db t = checkTyped db "UPDATE" (Scope (tableCols t) []) t
 
 -- | 按语句类型分派检查
 check :: Database -> Statement -> Either String ()
-check db q = case q of
+check db q = () <$ prepare db q
+
+-- | 执行前解析列名并检查类型
+prepare :: Database -> Statement -> Either String Statement
+prepare db q = do
+    resolved <- resolveStatement db q
+    checkResolved db resolved
+    pure resolved
+
+-- | 检查已解析的语句
+checkResolved :: Database -> Statement -> Either String ()
+checkResolved db = checkResolvedWith db []
+
+-- | 检查已解析的语句；outer 是相关子查询能看见的外层列
+checkResolvedWith :: Database -> [(String, Column)] -> Statement -> Either String ()
+checkResolvedWith db outer q = case q of
     Select
         { selectCols = cols
         , selectFrom = fromC
         , selectWhere = mWhere
+        , selectGroupBy = groupBy
         , selectOrderBy = orderBy
         } -> do
-            env <- checkFrom db fromC
-            checkColumns "SELECT" env cols
-            checkColumns "ORDER BY" env (map fst orderBy)
-            mapM_ (checkBool "WHERE" env) mWhere
+            env <- checkFrom db outer fromC
+            let full = Scope env outer
+            checkColumns "SELECT" full cols
+            checkGrouping full groupBy (map (\c -> (c, Col c)) cols)
+            checkColumns "ORDER BY" full (map fst orderBy)
+            mapM_ (checkNoAggregate "WHERE") mWhere
+            mapM_ (checkBool db "WHERE" full) mWhere
+    SelectExpr items fromC mWhere groupBy orderBy _ -> do
+        env <- checkFrom db outer fromC
+        let full = Scope env outer
+        mapM_ (\item -> () <$ inferExpr db "SELECT" full (snd item)) items
+        checkGrouping full groupBy items
+        checkColumns "ORDER BY" full (map fst orderBy)
+        mapM_ (checkNoAggregate "WHERE") mWhere
+        mapM_ (checkBool db "WHERE" full) mWhere
     Insert tbl cols rows -> do
         t <- lookupTable db tbl
-        checkColumns "INSERT" (tableCols t) cols
+        checkColumns "INSERT" (Scope (tableCols t) []) cols
         if null rows
             then Left "INSERT: no values"
-            else mapM_ (mapM_ (checkValue t) . zip cols) rows
+            else mapM_ (mapM_ (checkValue db t) . zip cols) rows
+        checkInsertTargets t cols
     Delete tbl mWhere -> do
         t <- lookupTable db tbl
-        mapM_ (checkBool "WHERE" (tableCols t)) mWhere
+        mapM_ (checkBool db "WHERE" (Scope (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
+        checkColumns "UPDATE" (Scope (tableCols t) []) (map fst assigns)
+        mapM_ (checkAssign db t) assigns
+        mapM_ (checkBool db "WHERE" (Scope (tableCols t) [])) mWhere
     CreateTable name cols -> do
         if null name
             then Left "CREATE TABLE: empty table name"
@@ -128,6 +356,7 @@ check db q = case q of
                 if length names /= length (nub names)
                     then Left ("CREATE TABLE: duplicate column names in " ++ name)
                     else Right ()
+                checkColumnDefs (map fst cols) cols
     DropTable name ->
         if null name
             then Left "DROP TABLE: empty table name"
@@ -150,9 +379,334 @@ check db q = case q of
                 if col == idColumn
                     then Left "DROP COLUMN: the built-in id column cannot be dropped"
                     else Right ()
+    AddColumn tbl def -> do
+        t <- lookupTable db tbl
+        if fst def `elem` tableCols' t
+            then Left ("ADD COLUMN: column already exists: " ++ fst def)
+            else Right ()
+        checkColumnDefs (tableCols' t ++ [fst def]) [def]
+    RenameColumn tbl old new -> do
+        t <- lookupTable db tbl
+        if old `notElem` tableCols' t
+            then Left ("RENAME COLUMN: unknown column: " ++ old)
+            else Right ()
+        if old == idColumn
+            then Left "RENAME COLUMN: the built-in id column cannot be renamed"
+            else
+                if new `elem` tableCols' t
+                    then Left ("RENAME COLUMN: column already exists: " ++ new)
+                    else Right ()
+    AlterColumnType tbl col ty -> do
+        t <- lookupTable db tbl
+        c <- requireColumn "ALTER COLUMN" t col
+        if columnAutoIncrement c && not (integerType ty)
+            then Left "ALTER COLUMN: AUTO_INCREMENT column must stay an integer type"
+            else Right ()
+    AlterColumnDefault tbl col def -> do
+        t <- lookupTable db tbl
+        c <- requireColumn "ALTER COLUMN" t col
+        mapM_ (\v -> checkDefault c v) def
+    AlterColumnNull tbl col nullable -> do
+        t <- lookupTable db tbl
+        c <- requireColumn "ALTER COLUMN" t col
+        if not nullable && columnAutoIncrement c
+            then Left "ALTER COLUMN: AUTO_INCREMENT column cannot be nullable"
+            else Right ()
+    CreateUser name password -> checkAccount name password
+    AlterUser name password -> checkAccount name password
+    DropUser name -> checkUserName name
+    CreateRole name -> checkRoleName name
+    DropRole name -> checkRoleName name
+    GrantPrivileges privs obj role -> do
+        mapM_ checkPrivilege privs
+        checkGrantObject obj
+        checkRoleName role
+    RevokePrivileges privs obj role -> do
+        mapM_ checkPrivilege privs
+        checkGrantObject obj
+        checkRoleName role
+    GrantRole role members -> do
+        checkRoleName role
+        mapM_ checkUserName members
+    RevokeRole role members -> do
+        checkRoleName role
+        mapM_ checkUserName members
+    CreateDatabase name -> checkDatabaseName name
+    DropDatabase name -> checkDatabaseName name
+    UseDatabase name -> checkDatabaseName name
+    ShowDatabases -> Right ()
   where
-    -- \| 表的列名清单
     tableCols' = map fst . tableCols
 
+-- | 查一列，没有就报错
+requireColumn :: String -> Table -> String -> Either String Column
+requireColumn place t c = maybe (Left (place ++ ": unknown column: " ++ c)) Right (colType t c)
+
+-- | 插入时没提到的列能不能自己补上
+checkInsertTargets :: Table -> [String] -> Either String ()
+checkInsertTargets t cols = mapM_ checkTarget (tableCols t)
+  where
+    checkTarget (name, c)
+        | name `elem` cols = Right ()
+        | columnAutoIncrement c = Right ()
+        | columnNullable c = Right ()
+        | Just _ <- columnDefault c = Right ()
+        | otherwise = Left ("INSERT: column " ++ name ++ " is NOT NULL and has no default")
+
+-- | 一列定义是否合法；names 是校验 CHECK 列引用时可用的全部列名
+checkColumnDefs :: [String] -> [(String, Column)] -> Either String ()
+checkColumnDefs names cols = do
+    mapM_ (\(_, c) -> mapM_ (checkDefault c) (columnDefault c)) cols
+    mapM_ (\(_, c) -> checkAutoIncrement c) cols
+    if length [() | (_, c) <- cols, columnAutoIncrement c] > 1
+        then Left "CREATE TABLE: at most one AUTO_INCREMENT column is allowed"
+        else Right ()
+    checkChecks names cols
+
+-- | 自增列必须是整数列
+checkAutoIncrement :: Column -> Either String ()
+checkAutoIncrement c
+    | columnAutoIncrement c && not (integerType (columnType c)) = Left "AUTO_INCREMENT: column must be an integer type"
+    | otherwise = Right ()
+
+-- | 默认值必须能放进这一列
+checkDefault :: Column -> Value -> Either String ()
+checkDefault c v
+    | VNull <- v = Right ()
+    | valueFits (columnType c) v = Right ()
+    | otherwise = Left ("DEFAULT: value does not fit column type " ++ show c)
+
+-- | CHECK 里的列必须存在
+checkChecks :: [String] -> [(String, Column)] -> Either String ()
+checkChecks names = mapM_ checkOne
+  where
+    checkOne (_, c) = case columnCheck c of
+        Nothing -> Right ()
+        Just text -> case parseExpression text of
+            Left err -> Left ("CHECK: " ++ firstLine err)
+            Right e -> mapM_ (known e) (colsInExpr e)
+    known _ col
+        | col `elem` names = Right ()
+        | otherwise = Left ("CHECK: unknown column: " ++ col)
+    firstLine = takeWhile (/= '\n')
+
+-- | 账号名上限
+accountNameLimit :: Int
+accountNameLimit = 64
+
+checkDatabaseName :: String -> Either String ()
+checkDatabaseName name
+    | null name || length name > 64 || not (all (\c -> isAscii c && (isAlphaNum c || c == '_')) name) = Left "invalid database name"
+    | otherwise = Right ()
+
+-- | 口令上限
+passwordLimit :: Int
+passwordLimit = 256
+
+-- | 账号名：ASCII 字母数字加点、短横线、下划线
+checkUserName :: String -> Either String ()
+checkUserName name
+    | null name = Left "USER: empty account name"
+    | length name > accountNameLimit = Left "USER: account name is too long"
+    | not (all allowed name) = Left "USER: account name may only contain ASCII letters, digits, dot, dash or underscore"
+    | otherwise = Right ()
+  where
+    allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
+
+-- | 建号 / 改口令：名字合法且口令不空
+checkAccount :: String -> String -> Either String ()
+checkAccount name password = do
+    checkUserName name
+    if null password
+        then Left "USER: password must not be empty"
+        else
+            if length password > passwordLimit
+                then Left "USER: password is too long"
+                else Right ()
+
+-- | 角色名：字符规则同账号名，另外不许拿权限关键字当名字（否则 GRANT 读不出来）
+checkRoleName :: String -> Either String ()
+checkRoleName name
+    | null name = Left "ROLE: empty role name"
+    | length name > accountNameLimit = Left "ROLE: role name is too long"
+    | not (all allowed name) = Left "ROLE: role name may only contain ASCII letters, digits, dot, dash or underscore"
+    | map toLower name `elem` privilegeNames = Left "ROLE: role name must not be a privilege keyword"
+    | otherwise = Right ()
+  where
+    allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
+
+-- | 权限关键字（小写，只用于比较）
+privilegeNames :: [String]
+privilegeNames = ["select", "insert", "update", "delete", "all"]
+
+-- | 权限名只能是这几个
+checkPrivilege :: String -> Either String ()
+checkPrivilege name
+    | map toLower name `elem` privilegeNames = Right ()
+    | otherwise = Left ("GRANT: unknown privilege: " ++ name)
+
+-- | 授权对象：* 表示全部表，否则是一张表（可带一个库前缀）
+checkGrantObject :: String -> Either String ()
+checkGrantObject "*" = Right ()
+checkGrantObject obj
+    | null obj = Left "GRANT: object name must not be empty"
+    | length obj > 128 = Left "GRANT: object name is too long"
+    | not (all allowed obj) = Left "GRANT: object name may only contain ASCII letters, digits, dot, dash or underscore"
+    | otherwise = Right ()
+  where
+    allowed c = isAscii c && (isAlphaNum c || c `elem` ("_.-" :: String))
+
 idColumn :: String
 idColumn = "id"
+-- | 把列引用统一为执行期名字（子查询一起解析）
+resolveExpr ::
+    Database ->
+    [(String, Column)] ->
+    [(String, Column)] ->
+    (String -> Either String String) ->
+    Expr ->
+    Either String Expr
+resolveExpr db env outer f e = case e of
+    Col c -> Col <$> f c
+    Add a b -> binary Add a b
+    Sub a b -> binary Sub a b
+    Mul a b -> binary Mul a b
+    Div a b -> binary Div a b
+    Neg a -> Neg <$> resolveExpr db env outer f a
+    Gt a b -> binary Gt a b
+    Lt a b -> binary Lt a b
+    Eq a b -> binary Eq a b
+    And a b -> binary And a b
+    Or a b -> binary Or a b
+    IsNull a -> IsNull <$> resolveExpr db env outer f a
+    IsNotNull a -> IsNotNull <$> resolveExpr db env outer f a
+    CountAll -> Right CountAll
+    CountOf a -> CountOf <$> resolveExpr db env outer f a
+    SumOf a -> SumOf <$> resolveExpr db env outer f a
+    AvgOf a -> AvgOf <$> resolveExpr db env outer f a
+    MinOf a -> MinOf <$> resolveExpr db env outer f a
+    MaxOf a -> MaxOf <$> resolveExpr db env outer f a
+    ScalarSub sq -> ScalarSub <$> resolveSubquery db (env ++ outer) sq
+    InSub a sq negated -> InSub <$> resolveExpr db env outer f a <*> resolveSubquery db (env ++ outer) sq <*> pure negated
+    InList a es negated -> InList <$> resolveExpr db env outer f a <*> mapM (resolveExpr db env outer f) es <*> pure negated
+    ExistsSub sq negated -> ExistsSub <$> resolveSubquery db (env ++ outer) sq <*> pure negated
+    _ -> Right e
+  where
+    binary ctor a b = ctor <$> resolveExpr db env outer f a <*> resolveExpr db env outer f b
+
+-- | 子查询：内层整条解析一遍，外层列参与解析（相关引用）
+-- 解析完把“引用了哪些外层列”记进 subqueryRefs：投影下推要靠它保住这些列
+resolveSubquery :: Database -> [(String, Column)] -> Subquery -> Either String Subquery
+resolveSubquery db outer sq = do
+    stmt <- resolveSubqueryStatement db outer (subqueryStatement sq)
+    pure (Subquery stmt (outerRefsOf db stmt))
+
+-- | 子查询里指向外层作用域的列（内层查不到的列就是外层引用）
+outerRefsOf :: Database -> Statement -> [String]
+outerRefsOf db stmt = nub [c | c <- statementColumns stmt, not (inInner c)]
+  where
+    inner = case checkFrom db [] (statementFrom stmt) of
+        Right env -> env
+        Left _ -> []
+    inInner c = case resolveColumn c inner of
+        Right _ -> True
+        Left _ -> False
+
+-- | 一条语句里出现的所有列引用（含 JOIN 的 ON 和嵌套子查询的外层引用）
+statementColumns :: Statement -> [String]
+statementColumns stmt = case stmt of
+    Select cols fromC mWhere groupBy orderBy _ ->
+        cols ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
+    SelectExpr items fromC mWhere groupBy orderBy _ ->
+        concatMap (colsInExpr . snd) items ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
+    _ -> []
+  where
+    fromColumns FromUnit = []
+    fromColumns (FromTable _ _) = []
+    fromColumns (FromJoin _ l _ _ c) = fromColumns l ++ colsInExpr c
+
+statementFrom :: Statement -> FromClause
+statementFrom Select { selectFrom = fromC } = fromC
+statementFrom SelectExpr { selectFrom = fromC } = fromC
+statementFrom _ = FromUnit
+
+resolveSubqueryStatement :: Database -> [(String, Column)] -> Statement -> Either String Statement
+resolveSubqueryStatement db outer q@Select{} = resolveQuery db outer q (map (\c -> (c, Col c)) (selectCols q))
+resolveSubqueryStatement db outer q@SelectExpr{} = resolveQuery db outer q (selectItems q)
+resolveSubqueryStatement _ _ _ = Left "subquery must be a SELECT"
+
+-- | 列名解析入口：查询走连接解析，改数据的语句按本表列解析
+resolveStatement :: Database -> Statement -> Either String Statement
+resolveStatement db q = case q of
+    Select{} -> resolveSelect db q
+    SelectExpr{} -> resolveSelect db q
+    Update tbl assigns mWhere -> do
+        t <- lookupTable db tbl
+        let env = tableCols t
+            name = nameIn env "UPDATE"
+        assigns' <- mapM (\(c, e) -> (\e' -> (c, e')) <$> resolveExpr db env [] name e) assigns
+        w <- mapM (resolveExpr db env [] (nameIn env "WHERE")) mWhere
+        pure (Update tbl assigns' w)
+    Delete tbl mWhere -> do
+        t <- lookupTable db tbl
+        w <- mapM (resolveExpr db (tableCols t) [] (nameIn (tableCols t) "WHERE")) mWhere
+        pure (Delete tbl w)
+    Insert tbl cols rows -> do
+        t <- lookupTable db tbl
+        let env = tableCols t
+        rows' <- mapM (mapM (resolveExpr db env [] (nameIn env "INSERT"))) rows
+        pure (Insert tbl cols rows')
+    other -> Right other
+
+-- | 查一列的物理名
+nameIn :: [(String, Column)] -> String -> String -> Either String String
+nameIn env place c = fst <$> columnAt place env c
+
+-- | 内层先查，查不到再落到外层；内层同名引起的歧义不往外层让
+scopedColumnAt :: String -> [(String, Column)] -> [(String, Column)] -> String -> Either String (String, Column)
+scopedColumnAt place inner outer c = scopeAt place (Scope inner outer) c
+
+-- | 单表保留原表头，连接使用唯一前缀
+resolveSelect :: Database -> Statement -> Either String Statement
+resolveSelect db q@Select{} = resolveQuery db [] q (map (\c -> (c, Col c)) (selectCols q))
+resolveSelect db q@SelectExpr{} = resolveQuery db [] q (selectItems q)
+resolveSelect _ q = Right q
+
+-- | 解析投影、条件、排序与连接引用；outer 是相关子查询能看见的外层列
+resolveQuery :: Database -> [(String, Column)] -> Statement -> [(String, Expr)] -> Either String Statement
+resolveQuery db outer q items = do
+    env <- checkFrom db outer (selectFrom q)
+    let physical c = case selectFrom q of
+            FromTable Nothing tbl -> unqualify (Just tbl) c
+            _ -> c
+        name place c = physical . fst <$> scopedColumnAt place env outer c
+        output (_, Col c) = do
+            k <- name "SELECT" c
+            pure (k, Col k)
+        output (label, e) = do
+            e' <- resolveExpr db env outer (name "SELECT") e
+            pure (label, e')
+    projected <- if items == [("*", Col "*")]
+        then if null env && selectFrom q == FromUnit
+            then Left "SELECT: * requires FROM"
+            else Right [(physical c, Col (physical c)) | (c, _) <- env]
+        else mapM output items
+    condition <- mapM (resolveExpr db env outer (name "WHERE")) (selectWhere q)
+    grouping <- mapM (name "GROUP BY") (selectGroupBy q)
+    ordering <- mapM (\(c, d) -> (\k -> (k, d)) <$> name "ORDER BY" c) (selectOrderBy q)
+    source <- case selectFrom q of
+        single@FromTable{} -> Right single
+        other -> resolveFrom db outer other
+    pure $ case q of
+        Select{} -> Select (map fst projected) source condition grouping ordering (selectLimit q)
+        _ -> SelectExpr projected source condition grouping ordering (selectLimit q)
+
+-- | 连接两侧默认取表名作别名；ON 里的子查询也能引用外层列
+resolveFrom :: Database -> [(String, Column)] -> FromClause -> Either String FromClause
+resolveFrom _ _ FromUnit = Right FromUnit
+resolveFrom _ _ (FromTable alias tbl) = Right (FromTable (Just (fromMaybe tbl alias)) tbl)
+resolveFrom db outer fromC@(FromJoin kind left alias tbl cond) = do
+    env <- checkFrom db outer fromC
+    l <- resolveFrom db outer left
+    c <- resolveExpr db env outer (fmap fst . columnAt "ON" env) cond
+    pure (FromJoin kind l (Just (fromMaybe tbl alias)) tbl c)

chusql-engine/src/ChuSQL/Storage.hs

@@ -8,14 +8,29 @@ import ChuSQL.Model (Column, Database, Row, Table (..), Value (..))
 -- 存储层抽象：上层只认 domain 类型，不关心底层实现。
 
 data IndexResult
-    = IndexRow (Maybe Row)
+    = IndexRows [Row]
     | NoIndex
     deriving (Show, Eq)
 
 class (Monad m) => MonadStorage m where
+    createDatabase :: String -> m (Either String ())
+    createDatabase _ = pure (Left "database management is unavailable in this storage")
+    dropDatabase :: String -> m (Either String ())
+    dropDatabase _ = pure (Left "database management is unavailable in this storage")
+    useDatabase :: String -> m (Either String ())
+    useDatabase _ = pure (Left "database selection is unavailable in this storage")
+    listDatabases :: m (Either String [String])
+    listDatabases = pure (Right [])
+
     -- \| 全表扫描
     scan :: String -> m (Either String [Row])
 
+    -- \| 只返回指定列；空清单保留每行的存在性。
+    scanColumns :: String -> [String] -> m (Either String [Row])
+    scanColumns t cols = do
+        result <- scan t
+        pure (fmap (map (\row -> [(c, v) | c <- cols, Just v <- [lookup c row]])) result)
+
     -- \| 追加一行
     insert :: String -> Row -> m (Either String ())
 
@@ -23,7 +38,6 @@ class (Monad m) => MonadStorage m where
     insertMany :: String -> [Row] -> m (Either String ())
     insertMany t = go
       where
-        -- \| 一行一行来，遇到错就停
         go [] = pure (Right ())
         go (r : rs) = do
             x <- insert t r
@@ -39,7 +53,6 @@ class (Monad m) => MonadStorage m where
             Left e -> pure (Left e)
             Right rs -> replaceAll t [r | r <- rs, not (doomed r)]
       where
-        -- \| 这一行的 id 在待删清单里吗
         doomed r = case lookup "id" r of
             Just (VInt k) -> k `elem` ks
             _ -> False
@@ -47,10 +60,19 @@ class (Monad m) => MonadStorage m where
     -- \| 整表替换
     replaceAll :: String -> [Row] -> m (Either String ())
 
-    -- \| 按某一列的索引取一行
-    lookupByColumn :: String -> String -> Int -> m (Either String IndexResult)
+    -- \| 按某一列的索引取一行（键可以是整数或字符串）
+    lookupByColumn :: String -> String -> Value -> m (Either String IndexResult)
     lookupByColumn _ _ _ = pure (Right NoIndex)
 
+    -- \| 按某一列的索引做范围扫描；没有可用索引就回 Nothing
+    scanRange ::
+        String ->
+        String ->
+        Maybe (Value, Bool) ->
+        Maybe (Value, Bool) ->
+        m (Either String (Maybe [Row]))
+    scanRange _ _ _ _ = pure (Right Nothing)
+
     -- \| 建一张空表
     createTable :: String -> [(String, Column)] -> m (Either String ())
 
@@ -68,6 +90,9 @@ class (Monad m) => MonadStorage m where
     -- \| 删一列，连它的索引与数据一起去掉
     dropColumn :: String -> String -> m (Either String ())
 
+    -- \| ALTER 用：整表换列定义与全部行
+    replaceSchema :: String -> [(String, Column)] -> [Row] -> m (Either String ())
+
     -- \| 取全库快照（表名 + 列 + 全部行）
     snapshot :: m Database
 
@@ -75,5 +100,4 @@ class (Monad m) => MonadStorage m where
     schema :: m Database
     schema = fmap (map withoutRows) snapshot
       where
-        -- \| 抹掉行，只留表名与列定义
         withoutRows (name, t) = (name, t {tableRows = []})

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -5,10 +6,14 @@ module ChuSQL.Storage.IPC (
     IPCStorage (..),
     Request (..),
     Response (..),
+    Account (..),
     SchemaColumn (..),
     TableInfo (..),
     sendRequest,
     closeConnection,
+    defaultPipeName,
+    setPipeName,
+    getPipeName,
     doListTables,
     doLookupByColumn,
     doInsert,
@@ -21,8 +26,11 @@ module ChuSQL.Storage.IPC (
 
 import ChuSQL.Model
 import ChuSQL.Storage
-import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar)
+import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, readMVar)
 import Control.Exception (IOException, try)
+#if !defined(mingw32_HOST_OS)
+import Control.Exception (onException)
+#endif
 import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict, encode, object, withObject, (.:), (.:?), (.!=), (.=))
 import Data.Aeson qualified as A
 import Data.Aeson.Key qualified as K
@@ -30,13 +38,24 @@ 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.Scientific (floatingOrInteger)
+import Data.Maybe (fromMaybe)
+import Data.Scientific (floatingOrInteger, fromFloatDigits)
 import Data.Text qualified as T
-import System.Environment (lookupEnv)
 import System.IO
 import System.IO.Unsafe (unsafePerformIO)
+#if !defined(mingw32_HOST_OS)
+import Network.Socket (Family (AF_UNIX), SockAddr (SockAddrUnix), SocketType (Stream), close, connect, defaultProtocol, socket, socketToHandle)
+import System.Environment (lookupEnv)
+#endif
 
 -- IPC 存储实现：每个存储方法翻成管道上的一条 JSON 请求。
+-- 端点：Windows 是具名管道 \\.\pipe\<name>，Unix 是文件系统套接字 <dir>/<name>.sock。
+
+#if !defined(mingw32_HOST_OS)
+-- | Unix 套接字路径的最大长度（Linux 108 含结尾 NUL，BSD 104，这里留余量）
+maxSocketPathLength :: Int
+maxSocketPathLength = 100
+#endif
 
 newtype IPCStorage a = IPCStorage
     { runIPCStorage :: IO a
@@ -58,13 +77,37 @@ instance Monad IPCStorage where
 connectionRef :: MVar (Maybe (FilePath, Handle))
 connectionRef = unsafePerformIO (newMVar Nothing)
 
--- | 打开管道
+-- | 打开端点连接：Windows 把管道当文件打开，Unix 连一个 AF_UNIX 套接字
 openPipe :: FilePath -> IO Handle
+#if defined(mingw32_HOST_OS)
 openPipe path = do
     h <- openFile path ReadWriteMode
     hSetBuffering h LineBuffering
     hSetNewlineMode h noNewlineTranslation
     pure h
+#else
+openPipe path = do
+    if length path > maxSocketPathLength
+        then ioError (userError ("socket path too long (" ++ show (length path) ++ " bytes): " ++ path))
+        else pure ()
+    sock <- socket AF_UNIX Stream defaultProtocol
+    connect sock (SockAddrUnix path) `onException` close sock
+    h <- socketToHandle sock ReadWriteMode
+    hSetBuffering h LineBuffering
+    hSetNewlineMode h noNewlineTranslation
+    pure h
+
+-- | Unix 套接字目录：$XDG_RUNTIME_DIR → $TMPDIR → /tmp（与 Rust 侧同一规则）
+socketDir :: IO String
+socketDir = do
+    runtime <- fmap nonEmpty (lookupEnv "XDG_RUNTIME_DIR")
+    tmp <- fmap nonEmpty (lookupEnv "TMPDIR")
+    pure (fromMaybe "/tmp" (runtime <> tmp))
+  where
+    nonEmpty v = case v of
+        Just s | not (null s) -> Just s
+        _ -> Nothing
+#endif
 
 -- | 关掉缓存里的句柄（没有就什么都不做）
 closeCached :: Maybe (FilePath, Handle) -> IO ()
@@ -91,11 +134,34 @@ dropConnection = modifyMVar_ connectionRef $ \cached -> do
 closeConnection :: IO ()
 closeConnection = dropConnection
 
--- | 管道路径
+-- | 没配置管名时用的端点，与 chusql.toml 的 [server] pipe_name 默认值一致
+defaultPipeName :: String
+defaultPipeName = "chusql-joint"
+
+{-# NOINLINE pipeNameRef #-}
+pipeNameRef :: MVar String
+pipeNameRef = unsafePerformIO (newMVar defaultPipeName)
+
+-- | 设定本进程要连的端点；配置从哪来由调用方决定（本层不读环境变量）
+setPipeName :: String -> IO ()
+setPipeName name = modifyMVar_ pipeNameRef (\_ -> pure name)
+
+-- | 当前端点
+getPipeName :: IO String
+getPipeName = readMVar pipeNameRef
+
+-- | 端点的完整路径
 pipePath :: IO String
+#if defined(mingw32_HOST_OS)
 pipePath = do
-    name <- maybe "chusql-storage" id <$> lookupEnv "CHUSQL_PIPE"
+    name <- getPipeName
     pure ("\\\\.\\pipe\\" ++ name)
+#else
+pipePath = do
+    name <- getPipeName
+    dir <- socketDir
+    pure (dir ++ "/" ++ name ++ ".sock")
+#endif
 
 -- | 发一条请求，管道不通就重连
 sendRequest :: Request -> IO Response
@@ -124,38 +190,83 @@ roundTrip req path = do
 data SchemaColumn = SchemaColumn
     { scName :: String
     , scType :: String
+    , scNullable :: Bool
+    , scDefault :: Maybe Value
+    , scAutoIncrement :: Bool
+    , scPrimaryKey :: Bool
+    , scUnique :: Bool
+    , scCheck :: Maybe String
     }
     deriving (Show, Eq)
 
 instance ToJSON SchemaColumn where
-    toJSON (SchemaColumn n t) = object ["name" .= n, "ty" .= t]
+    toJSON sc =
+        object
+            [ "name" .= scName sc
+            , "ty" .= scType sc
+            , "nullable" .= scNullable sc
+            , "default" .= fmap valueToJSON (scDefault sc)
+            , "auto_increment" .= scAutoIncrement sc
+            , "primary_key" .= scPrimaryKey sc
+            , "unique" .= scUnique sc
+            , "check" .= scCheck sc
+            ]
 
 instance FromJSON SchemaColumn where
     parseJSON = withObject "SchemaColumn" $ \o -> do
         n <- o .: "name"
         t <- o .: "ty"
-        pure (SchemaColumn n t)
+        nullable <- o .:? "nullable" .!= True
+        defJson <- o .:? "default"
+        def <- mapM valueFromJSON defJson
+        auto <- o .:? "auto_increment" .!= False
+        pk <- o .:? "primary_key" .!= False
+        uniq <- o .:? "unique" .!= False
+        chk <- o .:? "check"
+        pure (SchemaColumn n t nullable def auto pk uniq chk)
 
 data Request
     = ReqPing
+    | ReqDatabase String String
+    | ReqAllCatalog
+    | ReqInDatabase String Request
+    | ReqAccountsList
+    | ReqAccountCreate T.Text T.Text
+    | ReqAccountReset T.Text T.Text
+    | ReqAccountLogin T.Text (Maybe T.Text)
+    | ReqAccountDrop T.Text
     | ReqScan String
+    | ReqScanColumns String [String]
     | ReqInsert String Row
     | ReqInsertBatch String [Row]
     | ReqDeleteKeys String [Int]
     | ReqReplaceAll String [Row]
     | ReqListTables
-    | ReqLookupByColumn String String Int
+    | ReqLookupByColumn String String Value
+    | ReqRangeByIndex String String (Maybe (Value, Bool)) (Maybe (Value, Bool))
     | ReqDescribeTable String
     | ReqCreateTable String [SchemaColumn]
     | ReqDropTable String
     | ReqCreateIndex String String
     | ReqDropIndex String String
     | ReqDropColumn String String
+    | ReqReplaceSchema String [SchemaColumn] [Row]
     | ReqListCatalog
 
 instance ToJSON Request where
+    toJSON (ReqDatabase method name) = object ["method" .= method, "database" .= name]
+    toJSON ReqAllCatalog = object ["method" .= ("all_catalogs" :: T.Text)]
+    toJSON (ReqInDatabase name req) = case toJSON req of
+        A.Object fields -> A.Object (KM.insert "database" (A.String (T.pack name)) fields)
+        other -> other
+    toJSON ReqAccountsList = object ["method" .= ("accounts_list" :: T.Text)]
+    toJSON (ReqAccountCreate u h) = object ["method" .= ("account_create" :: T.Text), "user" .= u, "password_hash" .= h]
+    toJSON (ReqAccountReset u h) = object ["method" .= ("account_reset" :: T.Text), "user" .= u, "password_hash" .= h]
+    toJSON (ReqAccountLogin u at) = object ["method" .= ("account_login" :: T.Text), "user" .= u, "at" .= at]
+    toJSON (ReqAccountDrop u) = object ["method" .= ("account_drop" :: T.Text), "user" .= u]
     toJSON ReqPing = object ["method" .= ("ping" :: T.Text)]
     toJSON (ReqScan t) = object ["method" .= ("scan" :: T.Text), "table" .= t]
+    toJSON (ReqScanColumns t cols) = object ["method" .= ("scan" :: T.Text), "table" .= t, "columns" .= cols]
     toJSON (ReqInsert t r) =
         object
             [ "method" .= ("insert" :: T.Text)
@@ -186,7 +297,17 @@ instance ToJSON Request where
             [ "method" .= ("lookup_by_index" :: T.Text)
             , "table" .= t
             , "column" .= c
-            , "key" .= k
+            , "key" .= valueToJSON k
+            ]
+    toJSON (ReqRangeByIndex t c lo hi) =
+        object
+            [ "method" .= ("range_by_index" :: T.Text)
+            , "table" .= t
+            , "column" .= c
+            , "lo" .= fmap (valueToJSON . fst) lo
+            , "lo_inclusive" .= maybe True snd lo
+            , "hi" .= fmap (valueToJSON . fst) hi
+            , "hi_inclusive" .= maybe True snd hi
             ]
     toJSON (ReqDescribeTable t) =
         object
@@ -219,6 +340,13 @@ instance ToJSON Request where
             , "table" .= t
             , "column" .= c
             ]
+    toJSON (ReqReplaceSchema t cols rs) =
+        object
+            [ "method" .= ("replace_schema" :: T.Text)
+            , "table" .= t
+            , "columns" .= cols
+            , "rows" .= map rowToJSON rs
+            ]
     toJSON ReqListCatalog = object ["method" .= ("list_catalog" :: T.Text)]
 
 data TableInfo = TableInfo
@@ -230,8 +358,31 @@ data TableInfo = TableInfo
     }
     deriving (Show, Eq)
 
+data Account = Account
+    { accountId :: Integer
+    , accountUser :: T.Text
+    , accountHash :: T.Text
+    , accountRevision :: Integer
+    , accountRegisteredAt :: T.Text
+    , accountLastLoginAt :: Maybe T.Text
+    } deriving (Eq)
+
+instance Show Account where
+    show a = "Account " ++ show (accountUser a) ++ " revision=" ++ show (accountRevision a)
+
+instance FromJSON Account where
+    parseJSON = withObject "Account" $ \o -> Account <$> o .: "id" <*> o .: "user"
+        <*> o .: "password_hash" <*> o .: "revision"
+        <*> o .:? "registered_at" .!= "" <*> o .:? "last_login_at"
+
+instance ToJSON Account where
+    toJSON a = object ["id" .= accountId a, "user" .= accountUser a,
+        "password_hash" .= accountHash a, "revision" .= accountRevision a,
+        "registered_at" .= accountRegisteredAt a, "last_login_at" .= accountLastLoginAt a]
+
 data Response
     = RespPong
+    | RespAccounts [Account]
     | RespRows [Row]
     | RespTables [String]
     | RespSchema TableInfo
@@ -244,6 +395,7 @@ instance FromJSON Response where
     parseJSON = withObject "Response" $ \o -> do
         status <- o .: "status"
         case status :: T.Text of
+            "accounts" -> RespAccounts <$> o .: "accounts"
             "pong" -> pure RespPong
             "ok" -> pure RespOk
             "no_index" -> pure RespNoIndex
@@ -256,7 +408,6 @@ instance FromJSON Response where
                 RespCatalog <$> mapM parseTable xs
             other -> fail ("unknown status: " ++ T.unpack other)
       where
-        -- \| 解一张表的 schema
         parseTable :: A.Value -> Parser TableInfo
         parseTable = withObject "TableInfo" $ \o -> do
             t <- o .: "table"
@@ -268,7 +419,6 @@ instance FromJSON Response where
             stats <- mapM parseStat (sts :: [A.Value])
             pure (TableInfo t cols cnt idxCols stats)
 
-        -- \| 解一条列统计
         parseStat :: A.Value -> Parser (String, Int, Bool)
         parseStat = withObject "ColumnStat" $ \o -> do
             name <- o .: "name"
@@ -278,16 +428,19 @@ instance FromJSON Response where
 
 -- | 值编码成 JSON
 valueToJSON :: Value -> A.Value
+valueToJSON VNull = A.Null
 valueToJSON (VInt n) = A.Number (fromIntegral n)
+valueToJSON (VFloat d) = A.Number (fromFloatDigits d)
 valueToJSON (VStr s) = A.String (T.pack s)
 valueToJSON (VBool b) = A.Bool b
 
 -- | JSON 解回值
 valueFromJSON :: A.Value -> Parser Value
+valueFromJSON A.Null = pure VNull
 valueFromJSON (A.Number n) =
     case floatingOrInteger n :: Either Double Integer of
         Right i -> pure (VInt (fromIntegral i))
-        Left _ -> fail "non-integer number"
+        Left d -> pure (VFloat d)
 valueFromJSON (A.String s) = pure (VStr (T.unpack s))
 valueFromJSON (A.Bool b) = pure (VBool b)
 valueFromJSON _ = fail "unsupported value type"
@@ -301,7 +454,6 @@ rowToJSON r =
 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)
@@ -356,14 +508,25 @@ doListCatalog = ask "list_catalog" ReqListCatalog $ \resp -> case resp of
     RespCatalog xs -> Just xs
     _ -> Nothing
 
--- | 按某一列的索引取一行
-doLookupByColumn :: String -> String -> Int -> IO (Either String IndexResult)
+-- | 按某一列的索引取一行（键可以是整数或字符串）
+doLookupByColumn :: String -> String -> Value -> IO (Either String IndexResult)
 doLookupByColumn t c k = ask "lookup_by_index" (ReqLookupByColumn t c k) $ \resp -> case resp of
-    RespRows [] -> Just (IndexRow Nothing)
-    RespRows (r : _) -> Just (IndexRow (Just r))
+    RespRows rows -> Just (IndexRows rows)
     RespNoIndex -> Just NoIndex
     _ -> Nothing
 
+-- | 范围扫描：没有可用索引就回 Nothing，让上层退回扫描
+doScanRange ::
+    String ->
+    String ->
+    Maybe (Value, Bool) ->
+    Maybe (Value, Bool) ->
+    IO (Either String (Maybe [Row]))
+doScanRange t c lo hi = ask "range_by_index" (ReqRangeByIndex t c lo hi) $ \resp -> case resp of
+    RespRows rows -> Just (Just rows)
+    RespNoIndex -> Just Nothing
+    _ -> Nothing
+
 -- | 发 DescribeTable
 doDescribeTable :: String -> IO (Either String TableInfo)
 doDescribeTable t = ask "describe_table" (ReqDescribeTable t) $ \resp -> case resp of
@@ -382,6 +545,10 @@ doDropIndex t c = ask "drop_index" (ReqDropIndex t c) okOnly
 doDropColumn :: String -> String -> IO (Either String ())
 doDropColumn t c = ask "drop_column" (ReqDropColumn t c) okOnly
 
+-- | 发 ReplaceSchema（ALTER 用）
+doReplaceSchema :: String -> [SchemaColumn] -> [Row] -> IO (Either String ())
+doReplaceSchema t cols rs = ask "replace_schema" (ReqReplaceSchema t cols rs) okOnly
+
 -- | 发 CreateTable
 doCreateTable :: String -> [SchemaColumn] -> IO (Either String ())
 doCreateTable t cols = ask "create_table" (ReqCreateTable t cols) okOnly
@@ -392,16 +559,48 @@ doDropTable t = ask "drop_table" (ReqDropTable t) okOnly
 
 -- | 线上 schema 转本地列
 schemaToColumns :: [SchemaColumn] -> [(String, Column)]
-schemaToColumns = map go
-  where
-    go (SchemaColumn n "int") = (n, TInt)
-    go (SchemaColumn n "str") = (n, TStr)
-    go (SchemaColumn n "bool") = (n, TBool)
-    go (SchemaColumn n _) = (n, TStr)
+schemaToColumns = map toColumn
+
+toColumn :: SchemaColumn -> (String, Column)
+toColumn sc =
+    ( scName sc
+    , Column
+        { columnType = fromMaybe CStr (parseColumnType (scType sc))
+        , columnNullable = scNullable sc
+        , columnDefault = scDefault sc
+        , columnAutoIncrement = scAutoIncrement sc
+        , columnUnique = scUnique sc
+        , columnPrimaryKey = scPrimaryKey sc
+        , columnCheck = scCheck sc
+        }
+    )
+
+-- | 本地列转线上 schema
+toWire :: (String, Column) -> SchemaColumn
+toWire (n, c) =
+    SchemaColumn
+        { scName = n
+        , scType = typeName (columnType c)
+        , scNullable = columnNullable c
+        , scDefault = columnDefault c
+        , scAutoIncrement = columnAutoIncrement c
+        , scPrimaryKey = columnPrimaryKey c
+        , scUnique = columnUnique c
+        , scCheck = columnCheck c
+        }
 
 instance MonadStorage IPCStorage where
+    createDatabase name = IPCStorage (ask "create_database" (ReqDatabase "create_database" name) okOnly)
+    dropDatabase name = IPCStorage (ask "drop_database" (ReqDatabase "drop_database" name) okOnly)
+    useDatabase name = IPCStorage (ask "use_database" (ReqDatabase "use_database" name) okOnly)
+    listDatabases = IPCStorage $ ask "list_databases" (ReqDatabase "list_databases" "") $ \resp -> case resp of
+        RespTables names -> Just names
+        _ -> Nothing
     -- \| 发 Scan
     scan t = IPCStorage (doScan t)
+    scanColumns t cols = IPCStorage $ ask "scan" (ReqScanColumns t cols) $ \resp -> case resp of
+        RespRows rows -> Just [[(c, v) | c <- cols, Just v <- [lookup c row]] | row <- rows]
+        _ -> Nothing
 
     -- \| 发 Insert（索引由存储层自己维护）
     insert t r = IPCStorage (doInsert t r)
@@ -418,13 +617,14 @@ instance MonadStorage IPCStorage where
     -- \| 按某一列的索引取一行（没有索引就回 NoIndex）
     lookupByColumn t c k = IPCStorage (doLookupByColumn t c k)
 
+    -- \| 范围扫描（没有索引就回 Nothing）
+    scanRange t c lo hi = IPCStorage (doScanRange t c lo hi)
+
     -- \| 发 CreateTable
     createTable name cols = IPCStorage (doCreateTable name (map toWire cols))
-      where
-        -- \| 本地列类型转线上字符串
-        toWire (n, TInt) = SchemaColumn n "int"
-        toWire (n, TStr) = SchemaColumn n "str"
-        toWire (n, TBool) = SchemaColumn n "bool"
+
+    -- \| ALTER：整表换列定义与全部行
+    replaceSchema name cols rows = IPCStorage (doReplaceSchema name (map toWire cols) rows)
 
     -- \| 发 DropTable
     dropTable name = IPCStorage (doDropTable name)
@@ -445,7 +645,6 @@ instance MonadStorage IPCStorage where
             Left _ -> pure []
             Right xs -> mapM loadEntry xs
       where
-        -- \| 加载一张表，行来自 scan
         loadEntry info = do
             rows <- doScan (tiTable info)
             pure
@@ -455,7 +654,9 @@ instance MonadStorage IPCStorage where
 
     -- \| 只问数据字典要结构，一行数据都不拉过来
     schema = IPCStorage $ do
-        result <- doListCatalog
+        result <- ask "all_catalogs" ReqAllCatalog $ \resp -> case resp of
+            RespCatalog infos -> Just infos
+            _ -> Nothing
         pure $ case result of
             Left _ -> []
             Right xs ->

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

@@ -74,6 +74,11 @@ instance MonadStorage MemoryStorage where
     -- \| 原样返回当前库
     snapshot = MemoryStorage $ \db -> Right (db, db)
 
+    -- \| 改表结构：列定义与行一起换
+    replaceSchema name cols rows = MemoryStorage $ \db -> case lookup name db of
+        Nothing -> Right (Left ("unknown table: " ++ name), db)
+        Just tbl -> Right (Right (), replaceTable name tbl{tableCols = cols, tableRows = rows} db)
+
 -- | 用给定表替换同名表
 replaceTable :: String -> Table -> Database -> Database
 replaceTable name table =

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

@@ -1,6 +1,6 @@
-module ChuSQL.Syntax.AST (Statement (..), FromClause (..), Expr (..), SortDir (..), makeSelect) where
+module ChuSQL.Syntax.AST (Statement (..), FromClause (..), JoinKind (..), Expr (..), Subquery (..), SortDir (..), makeSelect) where
 
-import ChuSQL.Model (Column (..))
+import ChuSQL.Model (Column (..), ColumnType, Value (..))
 
 -- 语法树：语句、数据来源、条件表达式、排序方向。
 
@@ -9,6 +9,15 @@ data Statement
         { selectCols :: [String]
         , selectFrom :: FromClause
         , selectWhere :: Maybe Expr
+        , selectGroupBy :: [String]
+        , selectOrderBy :: [(String, SortDir)]
+        , selectLimit :: Maybe Int
+        }
+    | SelectExpr
+        { selectItems :: [(String, Expr)]
+        , selectFrom :: FromClause
+        , selectWhere :: Maybe Expr
+        , selectGroupBy :: [String]
         , selectOrderBy :: [(String, SortDir)]
         , selectLimit :: Maybe Int
         }
@@ -20,23 +29,83 @@ data Statement
     | CreateIndex String String
     | DropIndex String String
     | DropColumn String String
+    | AddColumn String (String, Column)
+    | RenameColumn String String String
+    | AlterColumnType String String ColumnType
+    | AlterColumnDefault String String (Maybe Value)
+    | AlterColumnNull String String Bool
+    | CreateUser String String
+    | AlterUser String String
+    | DropUser String
+    -- | 新角色：权限的载体，用户靠成员资格继承它的权限
+    | CreateRole String
+    -- | 删角色：连同它的授权与成员一起删
+    | DropRole String
+    -- | GRANT <权限>[, ...] ON <表|*> TO <角色>
+    | GrantPrivileges [String] String String
+    -- | REVOKE <权限>[, ...] ON <表|*> FROM <角色>
+    | RevokePrivileges [String] String String
+    -- | GRANT <角色> TO <用户>[, ...]：给用户加角色
+    | GrantRole String [String]
+    -- | REVOKE <角色> FROM <用户>[, ...]
+    | RevokeRole String [String]
+    | CreateDatabase String
+    | DropDatabase String
+    | UseDatabase String
+    | ShowDatabases
+    deriving (Show, Eq)
+
+-- | 连接类型：内连接与左外连接
+data JoinKind
+    = InnerJoin
+    | LeftJoin
     deriving (Show, Eq)
 
 data FromClause
     = FromTable (Maybe String) String
-    | FromJoin FromClause (Maybe String) String Expr
+    | FromJoin JoinKind FromClause (Maybe String) String Expr
+    | FromUnit
+    deriving (Show, Eq)
+
+-- | 子查询：语句，加上它对外层列的引用（自由变量，语义检查时填）
+data Subquery = Subquery
+    { subqueryStatement :: Statement
+    , subqueryRefs :: [String]
+    }
     deriving (Show, Eq)
 
 data Expr
     = Col String
+    | LitNull
     | LitInt Int
+    | LitFloat Double
     | LitStr String
     | LitBool Bool
+    | LitDate String
+    | LitTimestamp String
+    | LitBlob String
+    | Add Expr Expr
+    | Sub Expr Expr
+    | Mul Expr Expr
+    | Div Expr Expr
+    | Neg Expr
     | Gt Expr Expr
     | Lt Expr Expr
     | Eq Expr Expr
     | And Expr Expr
     | Or Expr Expr
+    | IsNull Expr
+    | IsNotNull Expr
+    | CountAll
+    | CountOf Expr
+    | SumOf Expr
+    | AvgOf Expr
+    | MinOf Expr
+    | MaxOf Expr
+    | ScalarSub Subquery
+    | InSub Expr Subquery Bool
+    | InList Expr [Expr] Bool
+    | ExistsSub Subquery Bool
     deriving (Show, Eq)
 
 data SortDir
@@ -51,6 +120,7 @@ makeSelect cols tbl w =
         { selectCols = cols
         , selectFrom = FromTable Nothing tbl
         , selectWhere = w
+        , selectGroupBy = []
         , selectOrderBy = []
         , selectLimit = Nothing
         }

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

@@ -1,11 +1,12 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
-module ChuSQL.Syntax.Parser (parseStatement) where
+module ChuSQL.Syntax.Parser (parseStatement, parseExpression) where
 
-import ChuSQL.Model (Column (..))
+import ChuSQL.Model (Column (..), ColumnType (..), Value (..), plainColumn)
 import ChuSQL.Syntax.AST
+import Control.Monad (void)
 import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
-import Data.Char (isAlpha, isAlphaNum, toLower)
+import Data.Char (isAlpha, isAlphaNum, isHexDigit, isSpace, toLower, toUpper)
 import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
 import Data.Void (Void)
@@ -19,7 +20,7 @@ type Parser = Parsec Void String
 
 -- | 跳过空白
 sc :: Parser ()
-sc = Lxr.space space1 empty empty
+sc = Lxr.space space1 (Lxr.skipLineComment "--") (Lxr.skipBlockComment "/*" "*/")
 
 -- | 词后面吃掉空白
 lexeme :: Parser a -> Parser a
@@ -42,6 +43,10 @@ identifier = lexeme $ do
     rest <- many (satisfy isIdentChar)
     return (first : rest)
 
+-- | 账号名：裸名字或单引号字符串（账号名允许点与短横线，字符串形式才写得出来）
+userName :: Parser String
+userName = identifier <|> stringLit
+
 -- | 名字里允许的字符
 isIdentChar :: Char -> Bool
 isIdentChar ch = isAlphaNum ch || ch == '_'
@@ -50,6 +55,10 @@ isIdentChar ch = isAlphaNum ch || ch == '_'
 integer :: Parser Int
 integer = lexeme Lxr.decimal
 
+-- | 读一个浮点数（必须有小数点或指数）
+floatLit :: Parser Double
+floatLit = lexeme Lxr.float
+
 -- | 读一个字符串字面量
 stringLit :: Parser String
 stringLit = lexeme $ do
@@ -66,6 +75,15 @@ stringChar =
         , satisfy (/= '\'')
         ]
 
+-- | X'ABCD' 形式的二进制字面量，统一存成大写十六进制文本
+blobLit :: Parser String
+blobLit = lexeme $ do
+    _ <- char 'x' <|> char 'X'
+    _ <- char '\''
+    s <- many (satisfy isHexDigit)
+    _ <- char '\''
+    return (map toUpper s)
+
 -- | 升序或降序
 sortDir :: Parser SortDir
 sortDir = (Desc <$ keyword "desc") <|> (Asc <$ keyword "asc") <|> pure Asc
@@ -83,7 +101,6 @@ qualifiedName = do
     rest <- many (symbol "." *> identifier)
     return (intercalate "." (first : rest))
 
-
 -- | 读一个表达式
 expr :: Parser Expr
 expr = makeExprParser atom operatorTable
@@ -91,11 +108,17 @@ expr = makeExprParser atom operatorTable
 -- | 运算符优先级（从紧到松）
 operatorTable :: [[Operator Parser Expr]]
 operatorTable =
-    [
-        [ InfixN (Gt <$ symbol ">")
+    [ [Prefix (Neg <$ symbol "-")]
+    , [InfixL (Mul <$ symbol "*"), InfixL (Div <$ symbol "/")]
+    , [InfixL (Add <$ symbol "+"), InfixL (Sub <$ symbol "-")]
+    , [ InfixN (Gt <$ symbol ">")
         , InfixN (Lt <$ symbol "<")
         , InfixN (Eq <$ symbol "=")
         ]
+    , [ Postfix inPredicate
+        , Postfix (IsNotNull <$ try (keyword "is" *> keyword "not" *> keyword "null"))
+        , Postfix (IsNull <$ (keyword "is" *> keyword "null"))
+        ]
     , [InfixL (And <$ keyword "AND")]
     , [InfixL (Or <$ keyword "OR")]
     ]
@@ -104,14 +127,79 @@ operatorTable =
 atom :: Parser Expr
 atom =
     choice
-        [ LitBool True <$ keyword "TRUE"
+        [ LitNull <$ keyword "null"
+        , LitBool True <$ keyword "TRUE"
         , LitBool False <$ keyword "FALSE"
+        , try (LitDate <$> (keyword "date" *> stringLit))
+        , try (LitTimestamp <$> (keyword "timestamp" *> stringLit))
+        , try (LitBlob <$> blobLit)
+        , LitFloat <$> try floatLit
         , LitInt <$> integer
         , LitStr <$> stringLit
+        , try aggregateCall
+        , try existsPredicate
         , Col <$> qualifiedName
+        , try scalarSubquery
         , between (symbol "(") (symbol ")") expr
         ]
 
+-- | [NOT] EXISTS (SELECT ...)
+existsPredicate :: Parser Expr
+existsPredicate = do
+    negated <- (True <$ try (keyword "not" *> keyword "exists")) <|> (False <$ keyword "exists")
+    sq <- between (symbol "(") (symbol ")") subquerySelect
+    return (ExistsSub sq negated)
+
+-- | 标量子查询：(SELECT ...)
+scalarSubquery :: Parser Expr
+scalarSubquery = ScalarSub <$> between (symbol "(") (symbol ")") subquerySelect
+
+-- | [NOT] IN (SELECT ...) 或 [NOT] IN (值清单)
+inPredicate :: Parser (Expr -> Expr)
+inPredicate = do
+    negated <- (True <$ try (keyword "not" *> keyword "in")) <|> (False <$ keyword "in")
+    body <-
+        between (symbol "(") (symbol ")") $
+            choice
+                [ Left <$> try subquerySelect
+                , Right <$> sepBy1 expr (symbol ",")
+                ]
+    return $ \e -> case body of
+        Left sq -> InSub e sq negated
+        Right es -> InList e es negated
+
+-- | 括号里的子查询；对外层列的引用留给语义检查填
+subquerySelect :: Parser Subquery
+subquerySelect = Subquery <$> selectStatement <*> pure []
+
+-- | 聚合调用：COUNT(*) / COUNT(x) / SUM(x) / AVG(x) / MIN(x) / MAX(x)
+aggregateCall :: Parser Expr
+aggregateCall =
+    choice
+        [ CountAll <$ try (keyword "count" *> between (symbol "(") (symbol ")") (symbol "*"))
+        , CountOf <$> aggArg "count"
+        , SumOf <$> aggArg "sum"
+        , AvgOf <$> aggArg "avg"
+        , MinOf <$> aggArg "min"
+        , MaxOf <$> aggArg "max"
+        ]
+  where
+    aggArg name = try (keyword name *> between (symbol "(") (symbol ")") expr)
+
+-- | 只认字面量，给 DEFAULT 用
+literalValue :: Parser Value
+literalValue =
+    choice
+        [ VNull <$ keyword "null"
+        , VBool True <$ keyword "TRUE"
+        , VBool False <$ keyword "FALSE"
+        , try (negateLit <$> floatLit)
+        , VInt <$> integer
+        , VFloat <$> try floatLit
+        , VStr <$> stringLit
+        ]
+  where
+    negateLit d = VFloat (negate d)
 
 -- | 一个排序列
 orderItem :: Parser (String, SortDir)
@@ -127,6 +215,13 @@ orderByClause = do
     keyword "by"
     sepBy1 orderItem (symbol ",")
 
+-- | GROUP BY 的列表
+groupByClause :: Parser [String]
+groupByClause = do
+    keyword "group"
+    keyword "by"
+    sepBy1 qualifiedName (symbol ",")
+
 -- | SET 里的一条赋值
 assignment :: Parser (String, Expr)
 assignment = do
@@ -135,16 +230,21 @@ assignment = do
     e <- expr
     return (col, e)
 
-
 reservedWords :: [String]
 reservedWords =
     [ "select"
+    , "as"
     , "from"
     , "where"
     , "order"
     , "by"
     , "limit"
     , "join"
+    , "left"
+    , "outer"
+    , "inner"
+    , "exists"
+    , "in"
     , "on"
     , "and"
     , "or"
@@ -161,7 +261,23 @@ reservedWords =
     , "index"
     , "drop"
     , "alter"
+    , "add"
+    , "rename"
+    , "to"
     , "column"
+    , "user"
+    , "identified"
+    , "null"
+    , "is"
+    , "not"
+    , "default"
+    , "check"
+    , "unique"
+    , "primary"
+    , "key"
+    , "auto_increment"
+    , "type"
+    , "group"
     ]
 
 -- | 别名（不许用保留字）
@@ -173,41 +289,53 @@ aliasName = try $ do
 -- | 表名 + 可选别名
 tableRef :: Parser (Maybe String, String)
 tableRef = do
-    tbl <- identifier
-    mAlias <- optional aliasName
+    tbl <- tableName
+    mAlias <- optional ((keyword "as" *> aliasName) <|> aliasName)
     return (mAlias, tbl)
 
+-- | 连接类型：内连接 / 左外连接
+joinKind :: Parser JoinKind
+joinKind =
+    try (keyword "left" *> optional (keyword "outer") *> keyword "join" *> return LeftJoin)
+        <|> try (keyword "inner" *> keyword "join" *> return InnerJoin)
+        <|> (keyword "join" *> return InnerJoin)
+
 -- | 一个 JOIN ... ON
-joinClause :: Parser (Maybe String, String, Expr)
+joinClause :: Parser (JoinKind, Maybe String, String, Expr)
 joinClause = do
-    keyword "join"
+    kind <- joinKind
     (mAlias, tbl) <- tableRef
     keyword "on"
     cond <- expr
-    return (mAlias, tbl, cond)
+    return (kind, mAlias, tbl, cond)
 
 -- | FROM 子句（可含多个 JOIN）
 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)
+    return (foldl (\acc (k, a, t, c) -> FromJoin k acc a t c) (FromTable mAlias tbl) joins)
 
 -- | SELECT 的列清单
-selectList :: Parser [String]
+selectList :: Parser [(String, Expr)]
 selectList =
     choice
-        [ ["*"] <$ symbol "*"
-        , (:) <$> qualifiedName <*> many (symbol "," *> qualifiedName)
+        [ [("*", Col "*")] <$ symbol "*"
+        , sepBy1 selectItem (symbol ",")
         ]
 
+-- | 投影标签保留表达式原文
+selectItem :: Parser (String, Expr)
+selectItem = do
+    (source, e) <- match expr
+    pure (case e of Col c -> (c, e); _ -> (reverse (dropWhile isSpace (reverse source)), e))
 
 -- | 读 CREATE TABLE
 createTableStatement :: Parser Statement
 createTableStatement = do
     keyword "create"
     keyword "table"
-    name <- identifier
+    name <- tableName
     cols <- between (symbol "(") (symbol ")") (sepBy1 columnDef (symbol ","))
     return (CreateTable name cols)
 
@@ -216,7 +344,7 @@ dropTableStatement :: Parser Statement
 dropTableStatement = do
     keyword "drop"
     keyword "table"
-    name <- identifier
+    name <- tableName
     return (DropTable name)
 
 -- | 读 CREATE INDEX（列名即索引名）
@@ -225,7 +353,7 @@ createIndexStatement = do
     keyword "create"
     keyword "index"
     keyword "on"
-    tbl <- identifier
+    tbl <- tableName
     col <- between (symbol "(") (symbol ")") identifier
     return (CreateIndex tbl col)
 
@@ -235,64 +363,223 @@ dropIndexStatement = do
     keyword "drop"
     keyword "index"
     keyword "on"
-    tbl <- identifier
+    tbl <- tableName
     col <- between (symbol "(") (symbol ")") identifier
     return (DropIndex tbl col)
 
--- | 读 ALTER TABLE ... DROP COLUMN
-alterDropColumnStatement :: Parser Statement
-alterDropColumnStatement = do
+-- | 读 ALTER TABLE：加列、删列、改名、改类型、改默认值、改可空
+alterTableStatement :: Parser Statement
+alterTableStatement = do
     keyword "alter"
     keyword "table"
-    tbl <- identifier
-    keyword "drop"
-    keyword "column"
-    col <- identifier
-    return (DropColumn tbl col)
+    tbl <- tableName
+    choice
+        [ do
+            keyword "add"
+            void (optional (keyword "column"))
+            (name, col) <- columnDef
+            pure (AddColumn tbl (name, col))
+        , do
+            keyword "drop"
+            void (optional (keyword "column"))
+            DropColumn tbl <$> identifier
+        , do
+            keyword "rename"
+            void (optional (keyword "column"))
+            old <- identifier
+            keyword "to"
+            RenameColumn tbl old <$> identifier
+        , do
+            keyword "alter"
+            void (optional (keyword "column"))
+            col <- identifier
+            choice
+                [ AlterColumnType tbl col <$> (keyword "type" *> columnTypeP)
+                , try (AlterColumnNull tbl col False <$ (keyword "set" *> keyword "not" *> keyword "null"))
+                , try (AlterColumnNull tbl col True <$ (keyword "drop" *> keyword "not" *> keyword "null"))
+                , try (AlterColumnDefault tbl col . Just <$> (keyword "set" *> keyword "default" *> literalValue))
+                , AlterColumnDefault tbl col Nothing <$ (keyword "drop" *> keyword "default")
+                ]
+        ]
 
--- | 建表时的一列
+-- | 读 CREATE USER（口令是明文，交给账号服务加盐派生）
+createUserStatement :: Parser Statement
+createUserStatement = do
+    keyword "create"
+    keyword "user"
+    name <- userName
+    pw <- identifiedBy
+    return (CreateUser name pw)
+
+-- | 读 IDENTIFIED BY '口令'
+identifiedBy :: Parser String
+identifiedBy = do
+    keyword "identified"
+    keyword "by"
+    stringLit
+
+-- | 读 ALTER USER ... IDENTIFIED BY（改一个普通账号的口令）
+alterUserStatement :: Parser Statement
+alterUserStatement = do
+    keyword "alter"
+    keyword "user"
+    name <- userName
+    pw <- identifiedBy
+    return (AlterUser name pw)
+
+-- | 读 DROP USER
+dropUserStatement :: Parser Statement
+dropUserStatement = do
+    keyword "drop"
+    keyword "user"
+    name <- userName
+    return (DropUser name)
+
+-- | 读 CREATE ROLE
+createRoleStatement :: Parser Statement
+createRoleStatement = do
+    keyword "create"
+    keyword "role"
+    CreateRole <$> userName
+
+-- | 读 DROP ROLE
+dropRoleStatement :: Parser Statement
+dropRoleStatement = do
+    keyword "drop"
+    keyword "role"
+    DropRole <$> userName
+
+-- | 权限名，统一收成大写
+privilegeName :: Parser String
+privilegeName =
+    choice
+        [ "SELECT" <$ keyword "select"
+        , "INSERT" <$ keyword "insert"
+        , "UPDATE" <$ keyword "update"
+        , "DELETE" <$ keyword "delete"
+        , "ALL" <$ keyword "all"
+        ]
+
+-- | ON 后面的授权对象：* 表示全部表，否则是一张表（可带库前缀）
+grantObject :: Parser String
+grantObject = ("*" <$ symbol "*") <|> tableName
+
+-- | 读 GRANT：带 ON 的是给角色授权限，不带的是给用户加角色
+grantStatement :: Parser Statement
+grantStatement = do
+    keyword "grant"
+    choice
+        [ try $ do
+            privs <- sepBy1 privilegeName (symbol ",")
+            keyword "on"
+            obj <- grantObject
+            keyword "to"
+            GrantPrivileges privs obj <$> userName
+        , GrantRole <$> userName <*> (keyword "to" *> sepBy1 userName (symbol ","))
+        ]
+
+-- | 读 REVOKE：与 GRANT 对称
+revokeStatement :: Parser Statement
+revokeStatement = do
+    keyword "revoke"
+    choice
+        [ try $ do
+            privs <- sepBy1 privilegeName (symbol ",")
+            keyword "on"
+            obj <- grantObject
+            keyword "from"
+            RevokePrivileges privs obj <$> userName
+        , RevokeRole <$> userName <*> (keyword "from" *> sepBy1 userName (symbol ","))
+        ]
+
+-- | 建表时的一列：类型后面跟若干约束
 columnDef :: Parser (String, Column)
 columnDef = do
     name <- identifier
-    ty <- columnType
-    return (name, ty)
+    ty <- columnTypeP
+    mods <- many columnConstraint
+    return (name, foldl (\c f -> f c) (plainColumn ty) mods)
+
+-- | 一条列约束
+columnConstraint :: Parser (Column -> Column)
+columnConstraint =
+    choice
+        [ try (keyword "not" *> keyword "null" *> pure (\c -> c{columnNullable = False}))
+        , keyword "null" *> pure (\c -> c{columnNullable = True})
+        , keyword "auto_increment" *> pure (\c -> c{columnAutoIncrement = True, columnNullable = False})
+        , try (keyword "primary" *> keyword "key" *> pure (\c -> c{columnPrimaryKey = True, columnUnique = True, columnNullable = False}))
+        , keyword "unique" *> pure (\c -> c{columnUnique = True})
+        , keyword "default" *> ((\v c -> c{columnDefault = Just v}) <$> literalValue)
+        , keyword "check" *> ((\s c -> c{columnCheck = Just s}) <$> checkText)
+        ]
+
+-- | CHECK 后面括号里的表达式原文，交给执行期再解析
+checkText :: Parser String
+checkText = between (symbol "(") (symbol ")") (match expr) >>= \(source, _) -> pure source
+
+-- | 括号里的长度参数
+sizeParen :: Parser Int
+sizeParen = try (between (symbol "(") (symbol ")") integer)
 
 -- | 列类型关键字
-columnType :: Parser Column
-columnType =
-    (keyword "integer" >> pure TInt)
-        <|> (keyword "int" >> pure TInt)
-        <|> (keyword "varchar" >> pure TStr)
-        <|> (keyword "text" >> pure TStr)
-        <|> (keyword "str" >> pure TStr)
-        <|> (keyword "boolean" >> pure TBool)
-        <|> (keyword "bool" >> pure TBool)
+columnTypeP :: Parser ColumnType
+columnTypeP =
+    choice
+        [ keyword "integer" >> pure CInt
+        , keyword "int" >> pure CInt
+        , keyword "bigint" >> pure CBigInt
+        , keyword "smallint" >> pure CSmallInt
+        , (keyword "varchar" >>) (maybe CStr CVarchar <$> optional sizeParen)
+        , (keyword "char" >>) (maybe (CChar 1) CChar <$> optional sizeParen)
+        , keyword "text" >> pure CStr
+        , keyword "str" >> pure CStr
+        , keyword "boolean" >> pure CBool
+        , keyword "bool" >> pure CBool
+        , keyword "float" >> pure CFloat
+        , keyword "real" >> pure CFloat
+        , try (keyword "double" *> keyword "precision" *> pure CDouble)
+        , keyword "double" >> pure CDouble
+        , (keyword "decimal" >>) decimalType
+        , (keyword "numeric" >>) decimalType
+        , keyword "date" >> pure CDate
+        , keyword "timestamp" >> pure CTimestamp
+        , keyword "blob" >> pure CBlob
+        ]
+
+-- | DECIMAL 的精度与小数位
+decimalType :: Parser ColumnType
+decimalType = do
+    args <- optional (try (between (symbol "(") (symbol ")") decimalArgs))
+    pure $ case args of
+        Nothing -> CDecimal 10 0
+        Just (p, s) -> CDecimal p s
+
+decimalArgs :: Parser (Int, Int)
+decimalArgs = do
+    p <- integer
+    s <- fromMaybe 0 <$> optional (symbol "," *> integer)
+    pure (p, s)
 
 -- | 读 SELECT
 selectStatement :: Parser Statement
 selectStatement = do
     keyword "select"
     cols <- selectList
-    keyword "from"
-    fromC <- fromClause
+    fromC <- fromMaybe FromUnit <$> optional (keyword "from" *> fromClause)
     mWhere <- optional (keyword "where" *> expr)
+    groupBy <- fromMaybe [] <$> optional groupByClause
     orderBy <- fromMaybe [] <$> optional orderByClause
     mLimit <- optional limitClause
-    return
-        Select
-            { selectCols = cols
-            , selectFrom = fromC
-            , selectWhere = mWhere
-            , selectOrderBy = orderBy
-            , selectLimit = mLimit
-            }
+    pure $ if all (\(name, e) -> e == Col name) cols
+        then Select (map fst cols) fromC mWhere groupBy orderBy mLimit
+        else SelectExpr cols fromC mWhere groupBy orderBy mLimit
 
 -- | 读 INSERT，可一次插多行
 insertStatement :: Parser Statement
 insertStatement = do
     keyword "INSERT"
     keyword "INTO"
-    tbl <- identifier
+    tbl <- tableName
     cols <-
         between
             (symbol "(")
@@ -304,14 +591,14 @@ insertStatement = do
 
 -- | 一行值：一对括号里的若干字面量
 valueRow :: Parser [Expr]
-valueRow = between (symbol "(") (symbol ")") (sepBy1 atom (symbol ","))
+valueRow = between (symbol "(") (symbol ")") (sepBy1 expr (symbol ","))
 
 -- | 读 DELETE
 deleteStatement :: Parser Statement
 deleteStatement = do
     keyword "DELETE"
     keyword "FROM"
-    tbl <- identifier
+    tbl <- tableName
     mWhere <- optional (keyword "WHERE" *> expr)
     return (Delete tbl mWhere)
 
@@ -319,7 +606,7 @@ deleteStatement = do
 updateStatement :: Parser Statement
 updateStatement = do
     keyword "update"
-    tbl <- identifier
+    tbl <- tableName
     keyword "set"
     assigns <- sepBy1 assignment (symbol ",")
     mWhere <- optional (keyword "where" *> expr)
@@ -332,14 +619,38 @@ parseStatement input =
         Left err -> Left (errorBundlePretty err)
         Right q -> Right q
   where
-    -- \| 依次尝试各种语句
     statementP =
         selectStatement
+            <|> try (CreateDatabase <$> (keyword "create" *> keyword "database" *> identifier))
+            <|> try (DropDatabase <$> (keyword "drop" *> keyword "database" *> identifier))
+            <|> (UseDatabase <$> (keyword "use" *> identifier))
+            <|> (ShowDatabases <$ (keyword "show" *> keyword "databases"))
             <|> insertStatement
             <|> deleteStatement
             <|> updateStatement
+            <|> try createUserStatement
+            <|> try alterUserStatement
+            <|> try dropUserStatement
+            <|> try createRoleStatement
+            <|> try dropRoleStatement
+            <|> try grantStatement
+            <|> try revokeStatement
             <|> try createIndexStatement
             <|> try createTableStatement
             <|> try dropIndexStatement
-            <|> try alterDropColumnStatement
+            <|> try alterTableStatement
             <|> dropTableStatement
+
+-- | 解析一个裸表达式（CHECK 约束原文用）
+parseExpression :: String -> Either String Expr
+parseExpression input =
+    case runParser (sc *> expr <* sc <* eof) "<expr>" input of
+        Left err -> Left (errorBundlePretty err)
+        Right e -> Right e
+
+-- | 表名至多有一个库前缀。
+tableName :: Parser String
+tableName = do
+    first <- identifier
+    databaseTable <- optional (symbol "." *> identifier)
+    pure (maybe first (\t -> map toLower first ++ "." ++ t) databaseTable)