ChuNa7a/ChuSQL
1
0 Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
LIm1tZz7 committed 2026-09-19 22:42:22 +08:00
1 parent a9ef1ef3e2
commit cae66f0731
15 files changed
+411 -124
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

chusql-engine/app/Main.hs
+3 -3
View File
@@ -1,9 +1,9 @@
module Main where
import ChuSQL.Eval.Executor
import ChuSQL.SQLSyntax.Executor
import ChuSQL.Model
import ChuSQL.Syntax.Ast
import ChuSQL.Syntax.Parser
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Parser
users :: Table
users =
chusql-engine/chusql-engine.cabal
+8 -5
View File
@@ -9,12 +9,15 @@ build-type: Simple
library
hs-source-dirs: src
exposed-modules: ChuSQL.Syntax.Ast
ChuSQL.Syntax.Parser
exposed-modules: ChuSQL.Algebra.Eval
ChuSQL.Algebra.Op
ChuSQL.Algebra.Planner
ChuSQL.Model
ChuSQL.Eval.Expr
ChuSQL.Eval.Sort
ChuSQL.Eval.Executor
ChuSQL.SQLSyntax.AST
ChuSQL.SQLSyntax.Executor
ChuSQL.SQLSyntax.Expr
ChuSQL.SQLSyntax.Parser
ChuSQL.SQLSyntax.Sort
build-depends: base >= 4.14 && < 5
, megaparsec
, parser-combinators
chusql-engine/src/ChuSQL/Algebra/.gitkeep
View File
Whitespace-only changes.
chusql-engine/src/ChuSQL/Algebra/Eval.hs
+39
View File
@@ -0,0 +1,39 @@
module ChuSQL.Algebra.Eval where
import ChuSQL.Algebra.Op
import ChuSQL.Model
import ChuSQL.SQLSyntax.Expr (evalCondForRow)
import ChuSQL.SQLSyntax.Sort (sortRows)
import Control.Monad (filterM)
-- 投影
project :: [String] -> Row -> Row
project ["*"] row = row
project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
-- 执行关系代数运算
addPrefix :: String -> Row -> Row
addPrefix prefix = map (\(k, v) -> (prefix ++ k, v))
evalRelOp :: Database -> RelOp -> Either String [Row]
evalRelOp db (Scan mAlias tbl) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
let prefix = maybe "" (++ ".") mAlias
Right (map (addPrefix prefix) (tableRows table))
evalRelOp db (Filter e op) = do
rows <- evalRelOp db op
filterM (evalCondForRow e) rows
evalRelOp db (Project cols op) = do
rows <- evalRelOp db op
Right (map (project cols) rows)
evalRelOp db (Sort spec op) = do
rows <- evalRelOp db op
Right (sortRows spec rows)
evalRelOp db (Limit n op) = do
rows <- evalRelOp db op
Right (take n rows)
evalRelOp db (Join left right cond) = do
lrows <- evalRelOp db left
rrows <- evalRelOp db right
let cross = [l ++ r | l <- lrows, r <- rrows] -- 笛卡尔积
filterM (evalCondForRow cond) cross
chusql-engine/src/ChuSQL/Algebra/Op.hs
+13
View File
@@ -0,0 +1,13 @@
module ChuSQL.Algebra.Op where
import ChuSQL.SQLSyntax.AST (Expr, SortDir)
-- 关系代数算子
data RelOp
= Scan (Maybe String) String
| Filter Expr RelOp
| Project [String] RelOp
| Sort [(String, SortDir)] RelOp
| Limit Int RelOp
| Join RelOp RelOp Expr
deriving (Show, Eq)
chusql-engine/src/ChuSQL/Algebra/Planner.hs
+73
View File
@@ -0,0 +1,73 @@
module ChuSQL.Algebra.Planner where
import ChuSQL.Algebra.Op
import ChuSQL.Model
import ChuSQL.SQLSyntax.AST
-- * 存在性检查
checkColumns :: [String] -> [String] -> Either String ()
checkColumns available requested =
case [c | c <- requested, c /= "*", c `notElem` available] of
[] -> Right ()
(c : _) -> Left ("unknown column: " ++ c)
checkFrom :: Database -> FromClause -> Either String ()
checkFrom db (FromTable _ tbl) =
case lookup tbl db of
Just _ -> Right ()
Nothing -> Left ("unknown table: " ++ tbl)
checkFrom db (FromJoin left _ tbl _) = do
_ <- checkFrom db left
case lookup tbl db of
Just _ -> Right ()
Nothing -> Left ("unknown table: " ++ tbl)
-- | 收集 FromClause 里所有可用的列名
availableColumns :: Database -> FromClause -> Either String [String]
availableColumns db (FromTable mAlias tbl) = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
let prefix = maybe "" (++ ".") mAlias
Right (map (prefix ++) (tableCols table))
availableColumns db (FromJoin left mAlias tbl _) = do
lcols <- availableColumns db left
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
let prefix = maybe "" (++ ".") mAlias
Right (lcols ++ map (prefix ++) (tableCols table))
-- | 检查数据库列明
checkColumnsFrom :: Database -> FromClause -> [String] -> Either String ()
checkColumnsFrom db fromC requested = do
available <- availableColumns db fromC
checkColumns available requested
-- 内部查询语句转执行计划
fromToRelOp :: FromClause -> RelOp
fromToRelOp (FromTable mAlias tbl) = Scan mAlias tbl
fromToRelOp (FromJoin left mAlias tbl cond) =
Join (fromToRelOp left) (Scan mAlias tbl) cond
translate :: Database -> Query -> Either String RelOp
translate db q = case q of
Select
{ selectCols = cols
, selectFrom = fromC
, selectWhere = mWhere
, selectOrderBy = orderBy
, selectLimit = mLimit
} -> do
-- 检查所有表和列
_ <- checkFrom db fromC
_ <- checkColumnsFrom db fromC cols
_ <- checkColumnsFrom db fromC (map fst orderBy)
let base = fromToRelOp fromC
filtered = case mWhere of
Nothing -> base
Just w -> Filter w base
sorted = case orderBy of
[] -> filtered
spec -> Sort spec filtered
limited = case mLimit of
Nothing -> sorted
Just n -> Limit n sorted
Right (Project cols limited)
_ -> Left "only SELECT is supported by translate"
chusql-engine/src/ChuSQL/Syntax/Ast.hs → chusql-engine/src/ChuSQL/SQLSyntax/AST.hs
+9 -3
View File
@@ -1,10 +1,10 @@
module ChuSQL.Syntax.Ast where
module ChuSQL.SQLSyntax.AST where
-- 查询语句
data Query
= Select
{ selectCols :: [String]
, selectTable :: String
, selectFrom :: FromClause
, selectWhere :: Maybe Expr
, selectOrderBy :: [(String, SortDir)]
, selectLimit :: Maybe Int
@@ -14,6 +14,12 @@ data Query
| Update String [(String, Expr)] (Maybe Expr)
deriving (Show, Eq)
-- 从句
data FromClause
= FromTable (Maybe String) String
| FromJoin FromClause (Maybe String) String Expr
deriving (Show, Eq)
-- 条件表达式
data Expr
= Col String
@@ -35,7 +41,7 @@ makeSelect :: [String] -> String -> Maybe Expr -> Query
makeSelect cols tbl w =
Select
{ selectCols = cols
, selectTable = tbl
, selectFrom = FromTable Nothing tbl
, selectWhere = w
, selectOrderBy = []
, selectLimit = Nothing
chusql-engine/src/ChuSQL/Eval/Executor.hs → chusql-engine/src/ChuSQL/SQLSyntax/Executor.hs
+9 -38
View File
@@ -1,16 +1,12 @@
module ChuSQL.Eval.Executor where
module ChuSQL.SQLSyntax.Executor where
import ChuSQL.Eval.Expr
import ChuSQL.Eval.Sort
import ChuSQL.Algebra.Eval (evalRelOp)
import ChuSQL.Algebra.Planner (translate)
import ChuSQL.Model
import ChuSQL.Syntax.Ast
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Expr (evalCondForRow, evalExpr)
import Control.Monad (filterM)
-- | 带限制的排序
applyLimit :: Maybe Int -> [Row] -> [Row]
applyLimit Nothing rows = rows
applyLimit (Just n) rows = take n rows
-- 表里加新行
updateTable :: String -> (Table -> Table) -> Database -> Either String Database
updateTable name f db = do
@@ -30,28 +26,10 @@ applyUpdates ((col, e) : rest) row = do
-- 处理查询
runQuery :: Database -> Query -> Either String (Database, [Row])
runQuery
db
Select
{ selectCols = cols
, selectTable = tbl
, selectWhere = mWhere
, selectOrderBy = orderBy
, selectLimit = mLimit
} = do
table <- maybe (Left ("unknown table: " ++ tbl)) Right (lookup tbl db)
_ <- checkColumns (tableCols table) cols
_ <- checkColumns (tableCols table) (map fst orderBy)
rows <- case mWhere of
Nothing -> Right (tableRows table)
Just e -> filterM (evalCondForRow e) (tableRows table)
let sorted = sortRows orderBy rows
limited = applyLimit mLimit sorted
Right (db, map (project cols) limited)
where
project :: [String] -> Row -> Row
project ["*"] row = row
project cs row = [(c, v) | (c, v) <- row, c `elem` cs]
runQuery db q@Select{} = do
relOp <- translate db q
rows <- evalRelOp db relOp
Right (db, rows)
-- 处理插入
runQuery db (Insert tbl cols vals) = do
@@ -95,10 +73,3 @@ runQuery db (Update tbl assigns mWhere) = do
if keep
then applyUpdates asgns row
else Right row
-- 显式请求的列必须存在（@*@ 表示全部列），避免静默返回一堆空行
checkColumns :: [String] -> [String] -> Either String ()
checkColumns available requested =
case [c | c <- requested, c /= "*", c `notElem` available] of
[] -> Right ()
(c : _) -> Left ("unknown column: " ++ c)
chusql-engine/src/ChuSQL/Eval/Expr.hs → chusql-engine/src/ChuSQL/SQLSyntax/Expr.hs
+2 -2
View File
@@ -1,7 +1,7 @@
module ChuSQL.Eval.Expr where
module ChuSQL.SQLSyntax.Expr where
import ChuSQL.Model
import ChuSQL.Syntax.Ast
import ChuSQL.SQLSyntax.AST
import Control.Monad (join)
-- 表达式求值
chusql-engine/src/ChuSQL/Syntax/Parser.hs → chusql-engine/src/ChuSQL/SQLSyntax/Parser.hs
+73 -11
View File
@@ -1,11 +1,11 @@
{-# LANGUAGE ImportQualifiedPost #-}
{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.Syntax.Ast.Query'。
{- | SQL 语法分析器：把 SQL 文本解析为 'ChuSQL.SQLSyntax.AST.Query'。
词法层负责空白、关键字、标识符、字面量与符号；语法层按
优先级 比较 &gt; AND &gt; OR 自底向上组装表达式。
-}
module ChuSQL.Syntax.Parser (
module ChuSQL.SQLSyntax.Parser (
Parser,
parseQuery,
expr,
@@ -14,9 +14,10 @@ module ChuSQL.Syntax.Parser (
stringLit,
) where
import ChuSQL.Syntax.Ast
import ChuSQL.SQLSyntax.AST
import Control.Monad.Combinators.Expr (Operator (..), makeExprParser)
import Data.Char (isAlpha, isAlphaNum)
import Data.Char (isAlpha, isAlphaNum, toLower)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Void (Void)
import Text.Megaparsec
@@ -88,6 +89,13 @@ limitClause = do
keyword "limit"
integer
-- | 解析JOIN和限定列名
qualifiedName :: Parser String
qualifiedName = do
first <- identifier
rest <- many (symbol "." *> identifier)
return (intercalate "." (first : rest))
-- * 表达式层
-- | 表达式入口，最低优先级。
@@ -114,7 +122,7 @@ atom =
choice
[ LitInt <$> integer
, LitStr <$> stringLit
, Col <$> identifier
, Col <$> qualifiedName
, between (symbol "(") (symbol ")") expr
]
@@ -123,7 +131,7 @@ atom =
-- | 显式指定排序的语句
orderItem :: Parser (String, SortDir)
orderItem = do
col <- identifier
col <- qualifiedName
dir <- sortDir
return (col, dir)
@@ -140,28 +148,82 @@ assignment = do
e <- expr
return (col, e)
-- | 从句语法
-- | SQL 保留字，不能用作表别名
reservedWords :: [String]
reservedWords =
[ "select"
, "from"
, "where"
, "order"
, "by"
, "limit"
, "join"
, "on"
, "and"
, "or"
, "asc"
, "desc"
, "insert"
, "into"
, "values"
, "delete"
, "update"
, "set"
]
{- | 表别名。别名不能是保留字：否则 @FROM users WHERE age > 18@ 会把 @WHERE@
当成 @users@ 的别名吃掉，后面真正的 WHERE 子句就再也解析不到。
用 'try' 包住，一旦命中保留字就整体回溯，让 'optional' 正常返回 'Nothing'。
-}
aliasName :: Parser String
aliasName = try $ do
name <- identifier
if map toLower name `elem` reservedWords then empty else return name
tableRef :: Parser (Maybe String, String)
tableRef = do
tbl <- identifier
mAlias <- optional aliasName
return (mAlias, tbl)
joinClause :: Parser (Maybe String, String, Expr)
joinClause = do
keyword "join"
(mAlias, tbl) <- tableRef
keyword "on"
cond <- expr
return (mAlias, tbl, cond)
fromClause :: Parser FromClause
fromClause = do
(mAlias, tbl) <- tableRef
joins <- many joinClause
return (foldl (\acc (a, t, c) -> FromJoin acc a t c) (FromTable mAlias tbl) joins)
-- | 选择列表：@*@ 或逗号分隔的列名。
selectList :: Parser [String]
selectList =
choice
[ ["*"] <$ symbol "*"
, (:) <$> identifier <*> many (symbol "," *> identifier)
, (:) <$> qualifiedName <*> many (symbol "," *> qualifiedName)
]
-- | @SELECT ... FROM ... [WHERE ...]@。
selectQuery :: Parser Query
selectQuery = do
_ <- keyword "select"
keyword "select"
cols <- selectList
_ <- keyword "from"
tableName <- identifier
keyword "from"
fromC <- fromClause
mWhere <- optional (keyword "where" *> expr)
orderBy <- fromMaybe [] <$> optional orderByClause
mLimit <- optional limitClause
return
Select
{ selectCols = cols
, selectTable = tableName
, selectFrom = fromC
, selectWhere = mWhere
, selectOrderBy = orderBy
, selectLimit = mLimit
chusql-engine/src/ChuSQL/Eval/Sort.hs → chusql-engine/src/ChuSQL/SQLSyntax/Sort.hs
+2 -2
View File
@@ -1,7 +1,7 @@
module ChuSQL.Eval.Sort where
module ChuSQL.SQLSyntax.Sort where
import ChuSQL.Model
import ChuSQL.Syntax.Ast
import ChuSQL.SQLSyntax.AST
import Data.List (sortBy)
-- | 反向排序
chusql-engine/src/ChuSQL/Semantic/.gitkeep
View File
Whitespace-only changes.
chusql-engine/test/Spec.hs
+179 -57
View File
@@ -1,37 +1,50 @@
module Main where
import ChuSQL.Eval.Executor
import ChuSQL.Model
import ChuSQL.Syntax.Ast
import ChuSQL.Syntax.Parser
import ChuSQL.SQLSyntax.AST
import ChuSQL.SQLSyntax.Executor
import ChuSQL.SQLSyntax.Parser
import Test.Hspec
-- ============================================================
-- Test database
testDB :: Database
testDB = [("users", users)]
where
users =
Table
{ tableName = "users"
, tableCols = ["name", "age"]
, tableRows =
[ [("name", VStr "Alice"), ("age", VInt 25)]
, [("name", VStr "Bob"), ("age", VInt 17)]
, [("name", VStr "Carol"), ("age", VInt 30)]
]
}
-- ============================================================
users :: Table
users =
Table
{ tableName = "users"
, tableCols = ["id", "name", "age"]
, tableRows =
[ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
, [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)]
]
}
orders :: Table
orders =
Table
{ tableName = "orders"
, tableCols = ["id", "user_id", "product"]
, tableRows =
[ [("id", VInt 1), ("user_id", VInt 1), ("product", VStr "Book")]
, [("id", VInt 2), ("user_id", VInt 2), ("product", VStr "Pen")]
, [("id", VInt 3), ("user_id", VInt 1), ("product", VStr "Cup")]
]
}
testDB :: Database
testDB = [("users", users), ("orders", orders)]
-- ============================================================
-- Main
-- ============================================================
main :: IO ()
main = hspec $ do
-- ============================================================
-- AST
-- ============================================================
describe "ChuSQL.Syntax.Ast" $ do
it "shows a Select without WHERE" $ do
show (makeSelect ["name"] "users" Nothing)
`shouldBe` "Select {selectCols = [\"name\"], selectTable = \"users\", \
\selectWhere = Nothing, selectOrderBy = [], selectLimit = Nothing}"
it "equal Selects are equal" $ do
makeSelect ["name"] "users" Nothing
`shouldBe` makeSelect ["name"] "users" Nothing
@@ -177,13 +190,56 @@ main = hspec $ do
)
it "rejects trailing junk after a complete query" $ do
parseQuery "SELECT name FROM users extra"
parseQuery "SELECT name FROM users extra junk"
`shouldSatisfy` isLeft
it "returns Left on missing table name" $ do
parseQuery "SELECT name FROM"
`shouldSatisfy` isLeft
-- ============================================================
-- Parser: JOIN
-- ============================================================
describe "ChuSQL.Syntax.Parser (JOIN)" $ do
it "parses a simple JOIN without aliases" $ do
parseQuery "SELECT name FROM users JOIN orders ON id = user_id"
`shouldBe` Right
( Select
{ selectCols = ["name"]
, selectFrom =
FromJoin
(FromTable Nothing "users")
Nothing
"orders"
(Eq (Col "id") (Col "user_id"))
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Nothing
}
)
it "parses JOIN with aliases" $ do
parseQuery "SELECT u.name FROM users u JOIN orders o ON u.id = o.user_id"
`shouldBe` Right
( Select
{ selectCols = ["u.name"]
, selectFrom =
FromJoin
(FromTable (Just "u") "users")
(Just "o")
"orders"
(Eq (Col "u.id") (Col "o.user_id"))
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Nothing
}
)
it "parses qualified column names" $ do
case parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id" of
Right q -> selectCols q `shouldBe` ["u.name", "o.product"]
Left err -> expectationFailure err
-- ============================================================
-- Engine: SELECT
-- ============================================================
@@ -191,9 +247,9 @@ main = hspec $ do
it "returns all rows without WHERE" $ do
rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 25)]
, [("name", VStr "Bob"), ("age", VInt 17)]
, [("name", VStr "Carol"), ("age", VInt 30)]
[ [("id", VInt 1), ("name", VStr "Alice"), ("age", VInt 25)]
, [("id", VInt 2), ("name", VStr "Bob"), ("age", VInt 17)]
, [("id", VInt 3), ("name", VStr "Carol"), ("age", VInt 30)]
]
it "filters with WHERE" $ do
@@ -261,7 +317,7 @@ main = hspec $ do
case runQuery testDB (Insert "users" ["name", "age"] [LitStr "Dave", LitInt 22]) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name", "age"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 25)]
, [("name", VStr "Bob"), ("age", VInt 17)]
@@ -273,7 +329,7 @@ main = hspec $ do
case runQuery testDB (Insert "users" ["name", "age"] [LitStr "Dave", LitInt 22]) of
Left err -> expectationFailure err
Right (_, _) -> do
rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery testDB (makeSelect ["name"] "users" Nothing))
`shouldSatisfy` \r -> case r of
Right rows -> length rows == 3
Left _ -> False
@@ -310,24 +366,24 @@ main = hspec $ do
case runQuery testDB (Delete "users" (Just (Lt (Col "age") (LitInt 18)))) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 25)]
, [("name", VStr "Carol"), ("age", VInt 30)]
[ [("name", VStr "Alice")]
, [("name", VStr "Carol")]
]
it "executes DELETE without WHERE, removing all rows" $ do
case runQuery testDB (Delete "users" Nothing) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name"] "users" Nothing))
`shouldBe` Right []
it "does not modify the original database" $ do
case runQuery testDB (Delete "users" Nothing) of
Left err -> expectationFailure err
Right (_, _) -> do
rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery testDB (makeSelect ["name"] "users" Nothing))
`shouldSatisfy` \r -> case r of
Right rows -> length rows == 3
Left _ -> False
@@ -380,7 +436,7 @@ main = hspec $ do
case runQuery testDB (Update "users" [("age", LitInt 99)] (Just (Eq (Col "name") (LitStr "Alice")))) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name", "age"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 99)]
, [("name", VStr "Bob"), ("age", VInt 17)]
@@ -391,7 +447,7 @@ main = hspec $ do
case runQuery testDB (Update "users" [("age", LitInt 0)] Nothing) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name", "age"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 0)]
, [("name", VStr "Bob"), ("age", VInt 0)]
@@ -402,7 +458,7 @@ main = hspec $ do
case runQuery testDB (Update "users" [("age", LitInt 99), ("name", LitStr "X")] Nothing) of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (runQuery db' (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery db' (makeSelect ["name", "age"] "users" Nothing))
`shouldBe` Right
[ [("name", VStr "X"), ("age", VInt 99)]
, [("name", VStr "X"), ("age", VInt 99)]
@@ -413,7 +469,7 @@ main = hspec $ do
case runQuery testDB (Update "users" [("age", LitInt 0)] Nothing) of
Left err -> expectationFailure err
Right (_, _) -> do
rowsOf (runQuery testDB (makeSelect ["*"] "users" Nothing))
rowsOf (runQuery testDB (makeSelect ["name"] "users" Nothing))
`shouldSatisfy` \r -> case r of
Right rows -> length rows == 3
Left _ -> False
@@ -465,7 +521,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = [("age", Asc)]
, selectLimit = Nothing
@@ -481,7 +537,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = [("age", Desc)]
, selectLimit = Nothing
@@ -497,7 +553,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = [("name", Asc)]
, selectLimit = Nothing
@@ -513,7 +569,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = [("nope", Asc)]
, selectLimit = Nothing
@@ -545,7 +601,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Just 2
@@ -560,7 +616,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = [("age", Desc)]
, selectLimit = Just 2
@@ -575,7 +631,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Just 10
@@ -591,7 +647,7 @@ main = hspec $ do
let q =
Select
{ selectCols = ["name"]
, selectTable = "users"
, selectFrom = FromTable Nothing "users"
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Just 0
@@ -603,6 +659,76 @@ main = hspec $ do
parseQuery "SELECT * FROM users LIMIT -1"
`shouldSatisfy` isLeft
-- ============================================================
-- Engine: JOIN
-- ============================================================
describe "ChuSQL.Eval.Engine (JOIN)" $ do
it "executes a two-table JOIN with aliases" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id" >>= runQuery testDB)
`shouldBe` Right
[ [("u.name", VStr "Alice"), ("o.product", VStr "Book")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Cup")]
, [("u.name", VStr "Bob"), ("o.product", VStr "Pen")]
]
it "executes JOIN with WHERE" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 20" >>= runQuery testDB)
`shouldBe` Right
[ [("u.name", VStr "Alice"), ("o.product", VStr "Book")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Cup")]
]
it "executes JOIN with ORDER BY" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id ORDER BY o.product DESC" >>= runQuery testDB)
`shouldBe` Right
[ [("u.name", VStr "Bob"), ("o.product", VStr "Pen")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Cup")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Book")]
]
it "executes JOIN with LIMIT" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id LIMIT 2" >>= runQuery testDB)
`shouldBe` Right
[ [("u.name", VStr "Alice"), ("o.product", VStr "Book")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Cup")]
]
it "returns Left when JOIN table not found" $ do
runQuery
testDB
( Select
{ selectCols = ["u.name"]
, selectFrom =
FromJoin
(FromTable (Just "u") "users")
(Just "x")
"nonexistent"
(Eq (Col "u.id") (Col "x.id"))
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Nothing
}
)
`shouldSatisfy` isLeft
it "returns Left when ON references an unknown column" $ do
runQuery
testDB
( Select
{ selectCols = ["u.name"]
, selectFrom =
FromJoin
(FromTable (Just "u") "users")
(Just "o")
"orders"
(Eq (Col "u.nope") (Col "o.user_id"))
, selectWhere = Nothing
, selectOrderBy = []
, selectLimit = Nothing
}
)
`shouldSatisfy` isLeft
-- ============================================================
-- End-to-end
-- ============================================================
@@ -652,7 +778,7 @@ main = hspec $ do
case parseQuery "UPDATE users SET age = 99 WHERE name = 'Alice'" >>= runQuery testDB of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (parseQuery "SELECT * FROM users" >>= runQuery db')
rowsOf (parseQuery "SELECT name, age FROM users" >>= runQuery db')
`shouldBe` Right
[ [("name", VStr "Alice"), ("age", VInt 99)]
, [("name", VStr "Bob"), ("age", VInt 17)]
@@ -666,18 +792,6 @@ main = hspec $ do
, [("name", VStr "Alice")]
]
it "ORDER BY then INSERT then SELECT end-to-end" $ do
case parseQuery "INSERT INTO users (name, age) VALUES ('Dave', 99)" >>= runQuery testDB of
Left err -> expectationFailure err
Right (db', _) -> do
rowsOf (parseQuery "SELECT name FROM users ORDER BY age DESC" >>= runQuery db')
`shouldBe` Right
[ [("name", VStr "Dave")]
, [("name", VStr "Carol")]
, [("name", VStr "Alice")]
, [("name", VStr "Bob")]
]
it "ORDER BY with LIMIT end-to-end" $ do
rowsOf (parseQuery "SELECT name FROM users ORDER BY age DESC LIMIT 2" >>= runQuery testDB)
`shouldBe` Right
@@ -691,6 +805,14 @@ main = hspec $ do
[ [("name", VStr "Carol")]
]
it "JOIN with WHERE and ORDER BY end-to-end" $ do
rowsOf (parseQuery "SELECT u.name, o.product FROM users u JOIN orders o ON u.id = o.user_id WHERE u.age > 15 ORDER BY o.product" >>= runQuery testDB)
`shouldBe` Right
[ [("u.name", VStr "Alice"), ("o.product", VStr "Book")]
, [("u.name", VStr "Alice"), ("o.product", VStr "Cup")]
, [("u.name", VStr "Bob"), ("o.product", VStr "Pen")]
]
-- ============================================================
-- Helpers
-- ============================================================