整理代码

This commit is contained in:
LIm1tZz7 committed 2026-10-13 14:09:36 +08:00
1 parent e87c4ee6a8
commit a45e33f94b
39 files changed
+264 -917

No files matched your search

@@ -47,10 +47,6 @@ runStatementUncheckedM db q@Select{} =
case bindQuery db q of
Left e -> pure (Left e)
Right bound -> executeQueryM bound
runStatementUncheckedM db q@SelectExpr{} =
case bindQuery db q of
Left e -> pure (Left e)
Right bound -> executeQueryM bound
runStatementUncheckedM db (Insert tbl cols rows) =
case lookupTable db tbl of
Left e -> pure (Left e)
@@ -86,26 +86,16 @@ translate q = case q of
ordering <- distinctOrdering inner
plan <- case inner of
s@Select{} -> translate s { selectOrderBy = [], selectLimit = Nothing }
s@SelectExpr{} -> translate s { selectOrderBy = [], selectLimit = Nothing }
_ -> Left "DISTINCT requires SELECT"
Right (limited ordering (selectLimit inner) (Distinct plan))
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectGroupBy = groupBy
, selectOrderBy = orderBy
, selectLimit = mLimit
} -> do
plan0 <- source fromC mWhere
let (plan, _) = grouped groupBy [] plan0
Right (Project cols (limited orderBy mLimit plan))
SelectExpr items fromC mWhere groupBy orderBy mLimit -> do
Select items fromC mWhere groupBy orderBy mLimit -> do
plan0 <- source fromC mWhere
let (plan, items') = grouped groupBy items plan0
Right $ if any (\(c, _) -> c `elem` map fst items') orderBy
then orderedProjection items' orderBy mLimit plan
else Compute items' (limited orderBy mLimit plan)
Right $ if all (\(label, expression) -> expression == Col label) items'
then Project (map fst items') (limited orderBy mLimit plan)
else if any (\(c, _) -> c `elem` map fst items') orderBy
then orderedProjection items' orderBy mLimit plan
else Compute items' (limited orderBy mLimit plan)
_ -> Left "only SELECT is supported by translate"
-- | 在排序前计算别名并保留输出顺序
@@ -10,8 +10,7 @@ import Data.List (nub)
queryTables :: Statement -> [String]
queryTables statement = nub (case statement of
SelectDistinct child -> queryTables child
Select _ source condition _ _ _ -> sourceTables source ++ concatMap expressionTables condition
SelectExpr items source condition _ _ _ -> sourceTables source
Select items source condition _ _ _ -> sourceTables source
++ concatMap (expressionTables . snd) items ++ concatMap expressionTables condition
_ -> [])
@@ -238,21 +238,13 @@ inferSubqueryOutput db outerScope sq = case subqueryStatement sq of
mapM_ (requireOrdering "DISTINCT" . snd) columns
_ <- distinctOrdering q
Right columns
q@Select{selectCols = cols} -> do
env <- checkFrom db enclosing (selectFrom q)
checkResolvedWith db enclosing q
mapM (columnTypeOf env) cols
q@SelectExpr{selectItems = items} -> do
q@Select{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, inferredColumnType (columnType col))
-- | 聚合的参数:列要在,且不能嵌套聚合
aggregateArg :: Database -> String -> Scope -> Expr -> Either String InferredType
@@ -450,27 +442,13 @@ checkResolved db = checkResolvedWith db []
checkResolvedWith :: Database -> [(String, Column)] -> Statement -> Either String ()
checkResolvedWith db outer q = case q of
SelectDistinct inner -> () <$ inferSubqueryOutput db (Scope [] outer) (Subquery (SelectDistinct inner) [])
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectGroupBy = groupBy
, selectOrderBy = orderBy
} -> do
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_ (checkRuntimeColumn "ORDER BY" full . fst) orderBy
mapM_ (checkNoAggregate "WHERE") mWhere
mapM_ (checkBool db "WHERE" full) mWhere
SelectExpr items fromC mWhere groupBy orderBy _ -> do
Select items fromC mWhere groupBy orderBy _ -> do
env <- checkFrom db outer fromC
let full = Scope env outer
direct = all (\(label, expression) -> expression == Col label) items
mapM_ (\item -> () <$ inferExpr db "SELECT" full (snd item)) items
checkGrouping full groupBy (items ++ [(c, Col c) | (c, _) <- orderBy, c `notElem` map fst items])
mapM_ (checkOrder db full items . fst) orderBy
checkGrouping full groupBy (items ++ [(c, Col c) | (c, _) <- orderBy, not direct, c `notElem` map fst items])
mapM_ ((if direct then checkRuntimeColumn "ORDER BY" full else checkOrder db full items) . fst) orderBy
mapM_ (checkNoAggregate "WHERE") mWhere
mapM_ (checkBool db "WHERE" full) mWhere
Insert tbl cols rows -> do
@@ -850,9 +828,7 @@ outerRefsOf db stmt = nub [c | c <- statementColumns stmt, not (inInner c)]
statementColumns :: Statement -> [String]
statementColumns stmt = case stmt of
SelectDistinct q -> statementColumns q
Select cols fromC mWhere groupBy orderBy _ ->
cols ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
SelectExpr items fromC mWhere groupBy orderBy _ ->
Select items fromC mWhere groupBy orderBy _ ->
concatMap (colsInExpr . snd) items ++ fromColumns fromC ++ concatMap colsInExpr mWhere ++ groupBy ++ map fst orderBy
_ -> []
where
@@ -866,14 +842,12 @@ statementColumns stmt = case stmt of
statementFrom :: Statement -> FromClause
statementFrom (SelectDistinct q) = statementFrom q
statementFrom Select{selectFrom = fromC} = fromC
statementFrom SelectExpr{selectFrom = fromC} = fromC
statementFrom _ = FromUnit
-- | 解析子查询里的 SELECT
resolveSubqueryStatement :: Database -> [(String, Column)] -> Statement -> Either String Statement
resolveSubqueryStatement db outer (SelectDistinct q) = SelectDistinct <$> resolveSubqueryStatement db outer q
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 db outer q@Select{} = resolveQuery db outer q (selectItems q)
resolveSubqueryStatement _ _ _ = Left "subquery must be a SELECT"
-- | 列名解析入口:查询走连接解析,改数据的语句按本表列解析
@@ -881,7 +855,6 @@ resolveStatement :: Database -> Statement -> Either String Statement
resolveStatement db q = case q of
SelectDistinct inner -> SelectDistinct <$> resolveStatement db inner
Select{} -> resolveSelect db q
SelectExpr{} -> resolveSelect db q
Update tbl assigns mWhere -> do
(key, t) <- resolveTable db tbl
let env = tableCols t
@@ -910,8 +883,7 @@ 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 db q@Select{} = resolveQuery db [] q (selectItems q)
resolveSelect _ q = Right q
-- | 检查排序输出别名或来源列
@@ -978,11 +950,9 @@ resolveQuery db outer q items = do
[] -> name "ORDER BY" c
[label] -> Right label
_ -> Left ("ORDER BY: ambiguous projection alias: " ++ c)
qIsExpression = case q of SelectExpr{} -> True; _ -> False
qIsExpression = any (\(label, expression) -> expression /= Col label) items
ordering <- mapM (\(c, d) -> (\k -> (k, d)) <$> orderName c) (selectOrderBy q)
pure $ case q of
Select{} -> Select (map fst projected) source condition grouping ordering (selectLimit q)
_ -> SelectExpr projected source condition grouping ordering (selectLimit q)
pure (Select projected source condition grouping ordering (selectLimit q))
-- | 收集没有别名遮蔽的来源表名
sourceTableNames :: FromClause -> [String]
@@ -1028,19 +998,7 @@ resolveFrom db outer (FromJoin kind left right cond) = do
-- | 派生表的输出列名:列取裸名,表达式保留原标签
nameDerivedColumns :: Statement -> Either String Statement
nameDerivedColumns (SelectDistinct q) = SelectDistinct <$> nameDerivedColumns q
nameDerivedColumns q@Select{selectCols = cols, selectFrom = fromC} = do
let names = map lastTablePart cols
checkDerivedNames names
Right
( SelectExpr
[(n, Col c) | (n, c) <- zip names cols]
fromC
(selectWhere q)
(selectGroupBy q)
(selectOrderBy q)
(selectLimit q)
)
nameDerivedColumns q@SelectExpr{selectItems = items} = do
nameDerivedColumns q@Select{selectItems = items} = do
let names = map derivedItemName items
checkDerivedNames names
Right q{selectItems = zip names (map snd items)}
@@ -8,14 +8,7 @@ import ChuSQL.Core.Engine.Runtime.Functions (FunctionId)
data Statement
= Select
{ selectCols :: [String]
, selectFrom :: FromClause
, selectWhere :: Maybe Expr
, selectGroupBy :: [String]
, selectOrderBy :: [(String, SortDir)]
, selectLimit :: Maybe Int
}
| SelectExpr
-- | 输出名称与投影表达式,普通列用 Col
{ selectItems :: [(String, Expr)]
, selectFrom :: FromClause
, selectWhere :: Maybe Expr
@@ -170,7 +163,7 @@ data SortDir
makeSelect :: [String] -> String -> Maybe Expr -> Statement
makeSelect cols tbl w =
Select
{ selectCols = cols
{ selectItems = [(c, Col c) | c <- cols]
, selectFrom = FromTable Nothing tbl
, selectWhere = w
, selectGroupBy = []
@@ -181,7 +174,6 @@ makeSelect cols tbl w =
-- | 将去重排序映射到输出列
distinctOrdering :: Statement -> Either String [(String, SortDir)]
distinctOrdering q@Select{} = resolveDistinctOrdering q
distinctOrdering q@SelectExpr{} = resolveDistinctOrdering q
distinctOrdering _ = Left "DISTINCT requires SELECT"
-- | 解析去重输出的排序列
@@ -189,8 +181,7 @@ resolveDistinctOrdering :: Statement -> Either String [(String, SortDir)]
resolveDistinctOrdering q = mapM resolve (selectOrderBy q)
where
items = case q of
Select { selectCols = cols } -> [(c, Col c) | c <- cols]
SelectExpr { selectItems = projected } -> projected
Select { selectItems = projected } -> projected
_ -> []
-- | 排序键必须出现在去重结果中
resolve (column, direction) = case [label | (label, e) <- items, label == column || e == Col column] of
@@ -697,9 +697,7 @@ selectStatement = do
groupBy <- fromMaybe [] <$> optional groupByClause
orderBy <- fromMaybe [] <$> optional orderByClause
mLimit <- optional limitClause
pure $ (if distinct then SelectDistinct else id) $ 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
pure $ (if distinct then SelectDistinct else id) (Select cols fromC mWhere groupBy orderBy mLimit)
-- | 读 WITH:展开每个 CTE 再读主查询
withStatement :: Parser Statement
@@ -741,20 +739,11 @@ cteKey = map toLower
renameColumns :: String -> [String] -> Statement -> Either String Statement
renameColumns _ [] q = Right q
renameColumns name cols (SelectDistinct q) = SelectDistinct <$> renameColumns name cols q
renameColumns name cols q@Select { selectCols = names } = do
checkCteArity name cols names
Right
( SelectExpr
[(c, Col n) | (c, n) <- zip cols names]
(selectFrom q)
(selectWhere q)
(selectGroupBy q)
(selectOrderBy q)
(selectLimit q)
)
renameColumns name cols q@SelectExpr { selectItems = items } = do
renameColumns name cols q@Select { selectItems = items } = do
checkCteArity name cols (map snd items)
ordering <- mapM renameOrder (selectOrderBy q)
ordering <- if all (\(label, expression) -> expression == Col label) items
then Right (selectOrderBy q)
else mapM renameOrder (selectOrderBy q)
Right q { selectItems = zip cols (map snd items), selectOrderBy = ordering }
where
-- | 列清单同步改写内层排序输出别名
@@ -774,11 +763,7 @@ checkCteArity name cols out
expandStatement :: [(String, Statement)] -> Statement -> Either String Statement
expandStatement env stmt = case stmt of
SelectDistinct q -> SelectDistinct <$> expandStatement env q
q@Select { selectFrom = fromC, selectWhere = mWhere } -> do
fromC' <- expandClause env fromC
w <- traverse (expandExpr env) mWhere
Right q { selectFrom = fromC', selectWhere = w }
q@SelectExpr { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
q@Select { selectFrom = fromC, selectItems = items, selectWhere = mWhere } -> do
fromC' <- expandClause env fromC
items' <- traverse (\(name, e) -> fmap ((,) name) (expandExpr env e)) items
w <- traverse (expandExpr env) mWhere
+1 -1
View File
@@ -420,7 +420,7 @@ spec = do
it "binds calls before execution" $ do
let bound = parseStatement "SELECT length('abc')" >>= prepare []
case bound of
Right SelectExpr {selectItems = [(_, BoundFunction (FunctionId 1) _ [_])]} -> pure ()
Right Select {selectItems = [(_, BoundFunction (FunctionId 1) _ [_])]} -> pure ()
_ -> expectationFailure (show bound)
it "rejects unknown SQL functions before scanning" $
sql "SELECT missing('abc')" `shouldSatisfy` isFailure
+29 -21
View File
@@ -564,7 +564,7 @@ main = hspec $ do
parseStatement "SELECT name FROM users JOIN orders ON id = user_id"
`shouldBe` Right
( Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom =
FromJoin
InnerJoin
@@ -582,7 +582,7 @@ main = hspec $ do
parseStatement "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id"
`shouldBe` Right
( Select
{ selectCols = ["u.name"]
{ selectItems = [("u.name", Col "u.name")]
, selectFrom =
FromJoin
InnerJoin
@@ -600,7 +600,7 @@ main = hspec $ do
parseStatement "SELECT u.name FROM users u LEFT JOIN orders o ON u.id = o.user_id"
`shouldBe` Right
( Select
{ selectCols = ["u.name"]
{ selectItems = [("u.name", Col "u.name")]
, selectFrom =
FromJoin
LeftJoin
@@ -633,11 +633,11 @@ main = hspec $ do
parseStatement "SELECT d.name FROM (SELECT name FROM users) d"
`shouldBe` Right
( Select
{ selectCols = ["d.name"]
{ selectItems = [("d.name", Col "d.name")]
, selectFrom =
FromSubquery
(Just "d")
(Select ["name"] (FromTable Nothing "users") Nothing [] [] Nothing)
(Select [("name", Col "name")] (FromTable Nothing "users") Nothing [] [] Nothing)
, selectWhere = Nothing
, selectGroupBy = []
, selectOrderBy = []
@@ -654,14 +654,14 @@ main = hspec $ do
( FromJoin
InnerJoin
(FromTable (Just "u") "users")
(FromSubquery (Just "d") (Select ["name"] (FromTable Nothing "users") Nothing [] [] Nothing))
(FromSubquery (Just "d") (Select [("name", Col "name")] (FromTable Nothing "users") Nothing [] [] Nothing))
(Eq (Col "u.name") (Col "d.name"))
)
it "parses a projection alias" $ do
parseStatement "SELECT count(*) AS total FROM orders"
`shouldBe` Right
( SelectExpr
( Select
[("total", CountAll)]
(FromTable Nothing "orders")
Nothing
@@ -713,11 +713,11 @@ main = hspec $ do
parseStatement "WITH t AS (SELECT name FROM users) SELECT t.name FROM t"
`shouldBe` Right
( Select
{ selectCols = ["t.name"]
{ selectItems = [("t.name", Col "t.name")]
, selectFrom =
FromSubquery
(Just "t")
(Select ["name"] (FromTable Nothing "users") Nothing [] [] Nothing)
(Select [("name", Col "name")] (FromTable Nothing "users") Nothing [] [] Nothing)
, selectWhere = Nothing
, selectGroupBy = []
, selectOrderBy = []
@@ -737,6 +737,14 @@ main = hspec $ do
values "WITH t(who) AS (SELECT name FROM users) SELECT t.who FROM t ORDER BY t.who"
`shouldBe` Right [[VStr "Alice"], [VStr "Bob"], [VStr "Carol"]]
it "keeps source ordering when renaming repeated CTE columns" $ do
values "WITH t(first, second) AS (SELECT name, name FROM users ORDER BY name DESC LIMIT 1) SELECT first, second FROM t"
`shouldBe` Right [[VStr "Carol", VStr "Carol"]]
it "renames expression ordering aliases with CTE columns" $ do
values "WITH t(next_age) AS (SELECT age + 1 AS years FROM users ORDER BY years DESC LIMIT 1) SELECT next_age FROM t"
`shouldBe` Right [[VInt 31]]
it "takes a bare column from a CTE" $ do
values "WITH t(who) AS (SELECT name FROM users) SELECT who FROM t ORDER BY who"
`shouldBe` Right [[VStr "Alice"], [VStr "Bob"], [VStr "Carol"]]
@@ -771,11 +779,11 @@ main = hspec $ do
it "parses >= into GtE" $ do
parseStatement "SELECT name FROM users WHERE age >= 18"
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (GtE (Col "age") (LitInt 18))) [] [] Nothing)
`shouldBe` Right (Select [("name", Col "name")] (FromTable Nothing "users") (Just (GtE (Col "age") (LitInt 18))) [] [] Nothing)
it "parses <= into LtE" $ do
parseStatement "SELECT name FROM users WHERE age <= 30"
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (LtE (Col "age") (LitInt 30))) [] [] Nothing)
`shouldBe` Right (Select [("name", Col "name")] (FromTable Nothing "users") (Just (LtE (Col "age") (LitInt 30))) [] [] Nothing)
it "parses <> and != into the same node" $ do
sql "SELECT name FROM users WHERE age <> 17"
@@ -855,11 +863,11 @@ main = hspec $ do
it "parses > ANY into a quantified comparison" $ do
parseStatement "SELECT name FROM users WHERE age > ANY (SELECT age FROM orders)"
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (QuantCmp CmpGt (Col "age") (Subquery (Select ["age"] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AnyQ)) [] [] Nothing)
`shouldBe` Right (Select [("name", Col "name")] (FromTable Nothing "users") (Just (QuantCmp CmpGt (Col "age") (Subquery (Select [("age", Col "age")] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AnyQ)) [] [] Nothing)
it "parses <> ALL into a quantified comparison" $ do
parseStatement "SELECT name FROM users WHERE age <> ALL (SELECT age FROM orders)"
`shouldBe` Right (Select ["name"] (FromTable Nothing "users") (Just (QuantCmp CmpNe (Col "age") (Subquery (Select ["age"] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AllQ)) [] [] Nothing)
`shouldBe` Right (Select [("name", Col "name")] (FromTable Nothing "users") (Just (QuantCmp CmpNe (Col "age") (Subquery (Select [("age", Col "age")] (FromTable Nothing "orders") Nothing [] [] Nothing) []) AllQ)) [] [] Nothing)
it "still reads plain comparisons" $ do
values "SELECT name FROM users WHERE age > 20 ORDER BY name"
@@ -1269,7 +1277,7 @@ main = hspec $ do
it "user is reserved as an alias but still usable inside a longer name" $ do
parseStatement "SELECT * FROM users user" `shouldSatisfy` isLeft
parseStatement "SELECT user1 FROM users" `shouldBe` Right (Select ["user1"] (FromTable Nothing "users") Nothing [] [] Nothing)
parseStatement "SELECT user1 FROM users" `shouldBe` Right (Select [("user1", Col "user1")] (FromTable Nothing "users") Nothing [] [] Nothing)
describe "ChuSQL.Core.Engine (DELETE)" $ do
it "parses DELETE with WHERE" $ do
@@ -1407,7 +1415,7 @@ main = hspec $ do
it "executes ORDER BY age ASC" $ do
let q =
Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectGroupBy = []
@@ -1424,7 +1432,7 @@ main = hspec $ do
it "executes ORDER BY age DESC" $ do
let q =
Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectGroupBy = []
@@ -1454,7 +1462,7 @@ main = hspec $ do
it "executes LIMIT without ORDER BY" $ do
let q =
Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectGroupBy = []
@@ -1470,7 +1478,7 @@ main = hspec $ do
it "executes LIMIT with ORDER BY" $ do
let q =
Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectGroupBy = []
@@ -1486,7 +1494,7 @@ main = hspec $ do
it "executes LIMIT 0" $ do
let q =
Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectGroupBy = []
@@ -1535,7 +1543,7 @@ main = hspec $ do
runStatement
testDB
( Select
{ selectCols = ["u.name"]
{ selectItems = [("u.name", Col "u.name")]
, selectFrom =
FromJoin
InnerJoin
@@ -2512,7 +2520,7 @@ main = hspec $ do
runIPCStorage
( runStatementM
( Select
{ selectCols = ["name"]
{ selectItems = [("name", Col "name")]
, selectFrom = FromTable Nothing "ipc_idx"
, selectWhere = Just (Eq (Col "id") (LitInt 42))
, selectGroupBy = []