2026-09-24 15:37:55 +08:00
|
|
|
module ChuSQL.Storage.Memory (MemoryStorage (runMemoryStorage)) where
|
|
|
|
|
|
|
|
|
|
import ChuSQL.Model
|
|
|
|
|
import ChuSQL.Storage
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- 内存实现:状态是 Database,错误通道是 Either String。
|
2026-09-25 14:21:55 +08:00
|
|
|
--
|
|
|
|
|
-- 它只实现"必须有"的那几个:批量插入、行级删除、索引、统计全走类的默认实现
|
|
|
|
|
-- (内存里数据本来就在手上,扫一遍就是最快的做法)。
|
2026-09-24 21:28:49 +08:00
|
|
|
|
|
|
|
|
-- * 实例
|
2026-09-24 23:56:07 +08:00
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | 内存存储:Database 上的状态
|
2026-09-24 15:37:55 +08:00
|
|
|
newtype MemoryStorage a = MemoryStorage {runMemoryStorage :: Database -> Either String (a, Database)}
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | Functor:转发给底层状态
|
2026-09-24 15:37:55 +08:00
|
|
|
instance Functor MemoryStorage where
|
|
|
|
|
fmap f (MemoryStorage m) = MemoryStorage $ \db -> do
|
|
|
|
|
(a, db') <- m db
|
|
|
|
|
Right (f a, db')
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | Applicative:转发 pure 和 <*>
|
2026-09-24 15:37:55 +08:00
|
|
|
instance Applicative MemoryStorage where
|
|
|
|
|
pure x = MemoryStorage $ \db -> Right (x, db)
|
|
|
|
|
MemoryStorage mf <*> MemoryStorage ma = MemoryStorage $ \db -> do
|
|
|
|
|
(f, db1) <- mf db
|
|
|
|
|
(a, db2) <- ma db1
|
|
|
|
|
Right (f a, db2)
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | Monad:顺序执行
|
2026-09-24 15:37:55 +08:00
|
|
|
instance Monad MemoryStorage where
|
|
|
|
|
MemoryStorage m >>= k = MemoryStorage $ \db -> do
|
|
|
|
|
(a, db') <- m db
|
|
|
|
|
runMemoryStorage (k a) db'
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | MonadStorage:直接改内存库
|
2026-09-24 15:37:55 +08:00
|
|
|
instance MonadStorage MemoryStorage where
|
2026-09-24 21:28:49 +08:00
|
|
|
-- \| 全表扫描
|
2026-09-24 15:37:55 +08:00
|
|
|
scan t = MemoryStorage $ \db -> do
|
|
|
|
|
tbl <- lookupTable db t
|
|
|
|
|
Right (Right (tableRows tbl), db)
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- \| 追加一行
|
2026-09-25 14:21:55 +08:00
|
|
|
insert t r = MemoryStorage $ \db -> do
|
2026-09-24 15:37:55 +08:00
|
|
|
tbl <- lookupTable db t
|
|
|
|
|
Right (Right (), replaceTable t tbl{tableRows = tableRows tbl ++ [r]} db)
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- \| 整表替换
|
2026-09-24 15:37:55 +08:00
|
|
|
replaceAll t rows = MemoryStorage $ \db -> do
|
|
|
|
|
tbl <- lookupTable db t
|
|
|
|
|
Right (Right (), replaceTable t tbl{tableRows = rows} db)
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- \| 建空表;已存在报错
|
|
|
|
|
createTable name cols = MemoryStorage $ \db ->
|
|
|
|
|
if any ((== name) . fst) db
|
|
|
|
|
then Right (Left ("table already exists: " ++ name), db)
|
|
|
|
|
else Right (Right (), db ++ [(name, Table name cols [])])
|
|
|
|
|
|
|
|
|
|
-- \| 删表;不存在报错
|
|
|
|
|
dropTable name = MemoryStorage $ \db ->
|
|
|
|
|
if any ((== name) . fst) db
|
|
|
|
|
then Right (Right (), filter ((/= name) . fst) db)
|
|
|
|
|
else Right (Left ("unknown table: " ++ name), db)
|
|
|
|
|
|
|
|
|
|
-- \| 原样返回当前库
|
2026-09-24 15:37:55 +08:00
|
|
|
snapshot = MemoryStorage $ \db -> Right (db, db)
|
|
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- * 工具
|
2026-09-24 23:56:07 +08:00
|
|
|
|
2026-09-24 21:28:49 +08:00
|
|
|
-- | 用给定表替换同名表
|
2026-09-24 15:37:55 +08:00
|
|
|
replaceTable :: String -> Table -> Database -> Database
|
|
|
|
|
replaceTable name table =
|
|
|
|
|
map (\(n, t) -> if n == name then (n, table) else (n, t))
|
2026-09-25 14:21:55 +08:00
|
|
|
|