ChuBlog/chusql-web/src/ChuSQL/Web/Demo.hs

{-# LANGUAGE OverloadedStrings #-}

module ChuSQL.Web.Demo (
    SeedReport (..),
    demoTableSpecs,
    demoRows,
    demoIndexes,
    demoNames,
    demoPlan,
    seedDemo,
) where

import ChuSQL.Core.Model (Value (..))
import ChuSQL.Core.Protocol (TableInfo (..))
import ChuSQL.Interface.Actions (
    ColumnSpec (..),
    CreateTableSpec (..),
    createIndexSql,
    createTableSql,
    insertRowsSql,
 )
import ChuSQL.Interface.Session (Session, catalog, runStatement)
import Data.Text (Text)
import qualified Data.Text as T

-- 演示数据：三张表加一个二级索引，语句与界面走同一套拼 SQL 的代码。

-- | 演示表（建表顺序即依赖顺序；没有外键约束，纯展示）
demoTableSpecs :: [CreateTableSpec]
demoTableSpecs =
    [ CreateTableSpec "users" [ColumnSpec "id" "int", ColumnSpec "name" "str", ColumnSpec "age" "int"]
    , CreateTableSpec "orders" [ColumnSpec "id" "int", ColumnSpec "user_id" "int", ColumnSpec "product" "str", ColumnSpec "amount" "int"]
    , CreateTableSpec "products" [ColumnSpec "id" "int", ColumnSpec "name" "str", ColumnSpec "sku" "int", ColumnSpec "price" "int"]
    ]

-- | 每张表的演示行
demoRows :: [(T.Text, [[(String, Value)]])]
demoRows =
    [ ( "users"
      , [ [("id", VInt i), ("name", VStr name), ("age", VInt age)]
        | (i, (name, age)) <- zip [1 :: Int ..] userRecords
        ]
      )
    , ( "orders"
      , [ [("id", VInt i), ("user_id", VInt uid), ("product", VStr p), ("amount", VInt a)]
        | (i, (uid, p, a)) <- zip [1 :: Int ..] orderRecords
        ]
      )
    , ( "products"
      , [ [("id", VInt i), ("name", VStr n), ("sku", VInt sku), ("price", VInt price)]
        | (i, (n, sku, price)) <- zip [1 :: Int ..] productRecords
        ]
      )
    ]

-- | 演示索引：products.sku 取值唯一
demoIndexes :: [(T.Text, T.Text)]
demoIndexes = [("products", "sku")]

-- | 演示数据涉及的表名
demoNames :: [T.Text]
demoNames = map ctsTable demoTableSpecs

-- | 完整的一套语句（建表 + 插行 + 建索引），按顺序执行
demoPlan :: Either String [String]
demoPlan = do
    creates <- mapM createTableSql demoTableSpecs
    inserts <- mapM (uncurry insertRowsSql) demoRows
    indexes <- mapM (uncurry createIndexSql) demoIndexes
    pure (creates ++ inserts ++ indexes)

data SeedReport = SeedReport
    { srCreated :: [String]
    , srSkipped :: [String]
    , srIndexes :: [String]
    }
    deriving (Show, Eq)

-- | 按需灌演示数据：缺表补表、缺索引补索引
seedDemo :: Session -> IO (Either Text SeedReport)
seedDemo session = do
    catalogResult <- catalog session
    case catalogResult of
        Left message -> pure (Left message)
        Right infos -> do
            let existingTables = map tiTable infos
                missing = [spec | spec <- demoTableSpecs, T.unpack (ctsTable spec) `notElem` existingTables]
                skipped = [T.unpack (ctsTable spec) | spec <- demoTableSpecs, T.unpack (ctsTable spec) `elem` existingTables]
                missingNames = map ctsTable missing
                wantedIndexes =
                    [ (t, c)
                    | (t, c) <- demoIndexes
                    , t `elem` missingNames || indexMissing infos t c
                    ]
            created <- runAll (map createTableSql missing)
            case created of
                Left message -> pure (Left message)
                Right () -> do
                    rowsDone <- runAll [insertRowsSql t rs | (t, rs) <- demoRows, t `elem` missingNames]
                    case rowsDone of
                        Left message -> pure (Left message)
                        Right () -> do
                            indexes <- runAll [createIndexSql t c | (t, c) <- wantedIndexes]
                            pure $ fmap (const (SeedReport (map T.unpack missingNames) skipped (map (T.unpack . snd) wantedIndexes))) indexes
  where
    -- | 顺序跑完一串语句，首错即停
    runAll :: [Either String String] -> IO (Either Text ())
    runAll [] = pure (Right ())
    runAll (sql : rest) = case sql of
        Left e -> pure (Left (T.pack e))
        Right statement -> do
            result <- runStatement session (T.pack statement)
            case result of
                Left message -> pure (Left message)
                Right _ -> runAll rest

    -- | 目录里这张表缺不缺这个索引
    indexMissing :: [TableInfo] -> Text -> Text -> Bool
    indexMissing infos t c = case lookup (T.unpack t) [(tiTable i, tiIndexes i) | i <- infos] of
        Nothing -> True
        Just cols -> T.unpack c `notElem` cols

-- | 演示用户数据
userRecords :: [(String, Int)]
userRecords =
    [ ("Alice", 24)
    , ("Bob", 31)
    , ("Carol", 45)
    , ("Dave", 19)
    , ("Erin", 38)
    , ("Frank", 52)
    , ("Grace", 27)
    , ("Heidi", 33)
    , ("Ivan", 41)
    , ("Judy", 29)
    ]

-- | 演示订单数据
orderRecords :: [(Int, String, Int)]
orderRecords =
    [ (1, "Laptop", 1299)
    , (1, "Mouse", 25)
    , (2, "Keyboard", 79)
    , (3, "Monitor", 349)
    , (3, "Webcam", 89)
    , (4, "Headset", 119)
    , (5, "SSD", 139)
    , (5, "RAM", 99)
    , (6, "Dock", 199)
    , (7, "Cable", 12)
    , (8, "Stand", 45)
    , (9, "Lamp", 39)
    ]

-- | 演示产品数据
productRecords :: [(String, Int, Int)]
productRecords =
    [ ("Laptop", 1001, 1299)
    , ("Mouse", 1002, 25)
    , ("Keyboard", 1003, 79)
    , ("Monitor", 1004, 349)
    , ("Webcam", 1005, 89)
    , ("Headset", 1006, 119)
    , ("SSD", 1007, 139)
    , ("RAM", 1008, 99)
    ]