修bug，完善功能

chusql-cli/app/Main.hs

@@ -2,10 +2,12 @@
 
 module Main (main) where
 
-import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Password (readPasswordInput)
 import ChuSQL.CLI.Script (stripTerminator)
+import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
+import ChuSQL.Interface.Link (Client, closeClient, connectClient)
 import ChuSQL.Interface.Session (
     Session,
     authenticateSession,
@@ -14,8 +16,6 @@ import ChuSQL.Interface.Session (
     newSession,
     switchDatabase,
  )
-import ChuSQL.Interface.Config (ServerConfig (..), loadServerConfigAt, loadWebConfigAt, rootUserName)
-import ChuSQL.Interface.Link (Client, closeClient, connectClient)
 import ChuSQL.Interface.Sudo (SudoCredential, readSudoCredential)
 import ChuSQL.Interface.TOML (resolveConfigPath)
 import Control.Exception (finally)
@@ -106,14 +106,16 @@ main = do
     config <- loadServerConfigAt configPath
     let rootName = rootUserName base
         userName = fromMaybe (if optSudo options then scSudoUser config else rootName) (optUser options)
-    credential <- if optSudo options then do
-        when (T.null userName)
-          $ reportError "sudo_auth_user is not configured" >> exitFailure
-        local <- readSudoCredential (scPort config)
-        case local of
-            Left message -> reportError message >> exitFailure
-            Right proof -> pure (Just proof)
-        else pure Nothing
+    credential <-
+        if optSudo options
+            then do
+                when (T.null userName) $
+                    reportError "sudo_auth_user is not configured" >> exitFailure
+                local <- readSudoCredential (scPort config)
+                case local of
+                    Left message -> reportError message >> exitFailure
+                    Right proof -> pure (Just proof)
+            else pure Nothing
     password <- if optSudo options then pure "" else promptPassword userName
     connected <- connectClient (T.pack (scHost config)) (scPort config)
     case connected of

chusql-cli/app/Repl.hs

@@ -1,19 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Repl
-    ( runRepl
-    , runStatementOnce
-    , reportError
-    ) where
+module Repl (
+    runRepl,
+    runStatementOnce,
+    reportError,
+) where
 
-import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
+import ChuSQL.CLI.Normalization (runNormalizationOnce)
 import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement)
-import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
 import ChuSQL.Core.Protocol (SchemaColumn (..), TableInfo (..))
 import ChuSQL.Interface.Protocol (Grant (..), RoleView (..))
-import Control.Monad (forM_, when, unless)
+import ChuSQL.Interface.Session (Session, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase)
+import Control.Monad (forM_, unless, when)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef, writeIORef)
 import Data.Text (Text)
@@ -138,7 +138,7 @@ listTables session = do
         Right tables -> outputStrLn (T.unpack (renderRows headers (map tableRow tables)))
   where
     headers = ["table", "columns", "rows", "indexes"]
-    -- | 把表信息排成一行
+    -- \| 把表信息排成一行
     tableRow info =
         [ T.pack (tiTable info)
         , tshow (length (tiColumns info))
@@ -158,9 +158,9 @@ describeTable session name = do
                 (info : _) -> outputStrLn (T.unpack (renderRows headers (map columnRow (tiColumns info))))
   where
     headers = ["column", "type", "primary", "unique", "nullable", "auto"]
-    -- | 表名忽略大小写比较
+    -- \| 表名忽略大小写比较
     matches wanted info = T.toLower (T.pack (tiTable info)) == T.toLower wanted
-    -- | 把列信息排成一行
+    -- \| 把列信息排成一行
     columnRow column =
         [ T.pack (scName column)
         , T.pack (scType column)
@@ -169,7 +169,7 @@ describeTable session name = do
         , yesNo (scNullable column)
         , yesNo (scAutoIncrement column)
         ]
-    -- | 布尔值转成 yes/no
+    -- \| 布尔值转成 yes/no
     yesNo True = "yes"
     yesNo False = "no"
 
@@ -181,17 +181,17 @@ listRoles session = do
         Left message -> liftIO (reportError message)
         Right roles -> outputStrLn (T.unpack (renderRows ["role", "grants", "members"] (map roleRow roles)))
   where
-    -- | 把角色信息排成一行
+    -- \| 把角色信息排成一行
     roleRow view =
         [ roleName view
         , if null (roleGrants view) then "-" else T.intercalate ", " (map grantText (roleGrants view))
         , if null (roleMembers view) then "-" else T.intercalate ", " (roleMembers view)
         ]
-    -- | 拼一条授权说明
+    -- \| 拼一条授权说明
     grantText grant = grantPrivilege grant <> " on " <> grantObject grant <> optionText grant
-    -- | 带转授权时补一段说明
+    -- \| 带转授权时补一段说明
     optionText grant = if grantable grant then " with grant option" else ""
 
 -- | 用 show 转成 Text
-tshow :: Show a => a -> Text
+tshow :: (Show a) => a -> Text
 tshow = T.pack . show

chusql-cli/src/ChuSQL/CLI/Format.hs

@@ -1,16 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.CLI.Format
-    ( OutputFormat (..)
-    , parseFormat
-    , formatName
-    , renderResult
-    , renderTable
-    , renderRows
-    , renderCsv
-    , renderJson
-    , displayValue
-    ) where
+module ChuSQL.CLI.Format (
+    OutputFormat (..),
+    parseFormat,
+    formatName,
+    renderResult,
+    renderTable,
+    renderRows,
+    renderCsv,
+    renderJson,
+    displayValue,
+) where
 
 import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
@@ -55,7 +55,7 @@ renderCsv :: QueryResult -> Text
 renderCsv result = T.unlines (header : map rowLine (qrRows result))
   where
     header = T.intercalate "," (map csvField (qrColumns result))
-    -- | 拼一行 CSV
+    -- \| 拼一行 CSV
     rowLine row = T.intercalate "," (map (csvField . csvCell) row)
 
 -- | CSV 里的空值就是空字段
@@ -80,13 +80,13 @@ renderRows :: [Text] -> [[Text]] -> Text
 renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
   where
     widths = [columnWidth index | index <- [0 .. length columns - 1]]
-    -- | 一列的显示宽度，有上限
+    -- \| 一列的显示宽度，有上限
     columnWidth index =
         min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
     maxColumnWidth = 64
-    -- | 取某行某列，缺的当空
+    -- \| 取某行某列，缺的当空
     cellAt row index = if index < length row then row !! index else ""
-    -- | 拼一行带竖线的表行
+    -- \| 拼一行带竖线的表行
     cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
     headerLine = cellLine columns
     body = map cellLine rawRows

chusql-cli/src/ChuSQL/CLI/History.hs

@@ -11,11 +11,12 @@ import System.Console.Haskeline.History (addHistory)
 -- 关闭逐行历史，筛选完整语句后记录安全输入。
 
 -- | 配置仅手动追加的输入历史
-historySettings :: MonadIO m => Maybe FilePath -> Settings m
-historySettings path = defaultSettings {historyFile = path, autoAddHistory = False}
+historySettings :: (MonadIO m) => Maybe FilePath -> Settings m
+historySettings path = defaultSettings{historyFile = path, autoAddHistory = False}
 
 -- | 排除含口令标记的完整语句
-rememberStatement :: MonadIO m => T.Text -> InputT m ()
+rememberStatement :: (MonadIO m) => T.Text -> InputT m ()
 rememberStatement statement =
-    unless (T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
+    unless
+        (T.null (T.strip statement) || any (`T.isInfixOf` T.toCaseFold statement) ["password", "identified"])
         (modifyHistory (addHistory (T.unpack statement)))

chusql-cli/src/ChuSQL/CLI/Normalization.hs

@@ -3,7 +3,7 @@
 module ChuSQL.CLI.Normalization (normalizationArguments, loadNormalizationDeclaration, renderNormalization, runNormalizationOnce) where
 
 import ChuSQL.Interface.Normalization
-import ChuSQL.Interface.Session (Session, sessionDatabase, analyzeNormalization)
+import ChuSQL.Interface.Session (Session, analyzeNormalization, sessionDatabase)
 import Control.Exception (IOException, try)
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Key as K
@@ -59,7 +59,8 @@ jsonText = TE.decodeUtf8 . BL.toStrict . A.encode
 -- 缩进展示完整报告且保留所有证据。
 pretty :: Int -> A.Value -> Text
 pretty depth (A.Object fields) = T.intercalate "\n" [indent <> K.toText key <> ":\n" <> pretty (depth + 1) value | (key, value) <- KM.toList fields]
-  where indent = T.replicate depth "  "
+  where
+    indent = T.replicate depth "  "
 pretty depth value = T.replicate depth "  " <> jsonText value
 
 -- 发送声明并让失败决定 CLI 退出码。

chusql-cli/src/ChuSQL/CLI/Script.hs

@@ -1,19 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module ChuSQL.CLI.Script
-    ( Meta (..)
-    , parseMeta
-    , takeStatement
-    , statementComplete
-    , stripTerminator
-    , errorHint
-    , metaHelp
-    ) where
+module ChuSQL.CLI.Script (
+    Meta (..),
+    parseMeta,
+    takeStatement,
+    statementComplete,
+    stripTerminator,
+    errorHint,
+    metaHelp,
+) where
 
-import Data.Maybe (isJust)
-import ChuSQL.CLI.Normalization (normalizationArguments)
 import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
+import ChuSQL.CLI.Normalization (normalizationArguments)
 import Data.Char (isSpace)
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -49,7 +49,8 @@ parseMeta raw = do
         "list" -> MetaDatabases
         "dt" -> MetaTables
         "tables" -> MetaTables
-        "d" | T.null argument -> MetaTables
+        "d"
+            | T.null argument -> MetaTables
             | otherwise -> MetaDescribe argument
         "dr" -> MetaRoles
         "roles" -> MetaRoles
@@ -61,18 +62,18 @@ parseMeta raw = do
         "format" -> selectFormat argument
         other -> MetaUnknown other
   where
-    -- | 拼出切库命令
+    -- \| 拼出切库命令
     connectTo argument
         | T.null argument = MetaUnknown "c"
         | otherwise = MetaConnect argument
-    -- | 解析格式参数
+    -- \| 解析格式参数
     selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
 
 -- | 取出第一条语句，忽略引号与注释里的分号
 takeStatement :: Text -> Maybe (Text, Text)
 takeStatement = go ScanNormal [] . T.unpack
   where
-    -- | 逐字符扫描语句边界
+    -- \| 逐字符扫描语句边界
     go _ _ [] = Nothing
     go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
     go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest

chusql-cli/test/Spec.hs

@@ -2,27 +2,27 @@
 
 module Main (main) where
 
-import ChuSQL.CLI.Normalization
-import ChuSQL.Interface.Normalization
-import ChuSQL.CLI.Format (OutputFormat (..), parseFormat, renderCsv, renderJson, renderTable, displayValue)
+import ChuSQL.CLI.Format (OutputFormat (..), displayValue, parseFormat, renderCsv, renderJson, renderTable)
 import ChuSQL.CLI.History (historySettings, rememberStatement)
+import ChuSQL.CLI.Normalization
 import ChuSQL.CLI.Password (readPasswordInput)
 import ChuSQL.CLI.Script (Meta (..), errorHint, parseMeta, statementComplete, stripTerminator, takeStatement)
 import ChuSQL.Core.Model (Value (..))
 import ChuSQL.Core.Protocol (QueryResult (..), queryResultJson)
 import ChuSQL.Core.Runtime
+import ChuSQL.Interface.Normalization
+import Control.Exception (bracket, finally)
+import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (decode)
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Control.Exception (bracket, finally)
-import Control.Monad.IO.Class (liftIO)
+import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
+import System.Console.Haskeline.History (historyLines)
 import System.Directory (getTemporaryDirectory, removeFile)
 import System.IO (Handle, SeekMode (AbsoluteSeek), hClose, hPutStr, hSeek, hSetNewlineMode, noNewlineTranslation, openTempFile)
 import Test.Hspec
-import System.Console.Haskeline (getHistory, getInputLine, runInputT, runInputTBehavior, useFileHandle)
-import System.Console.Haskeline.History (historyLines)
 
 -- chusql-cli 测试：输出格式、语句缓冲、元命令与口令输入。
 
@@ -47,12 +47,15 @@ spec = do
 historySpec :: Spec
 historySpec = describe "CLI: SQL history" $ do
     it "does not automatically record unfinished input lines" $
-        withPasswordInput "CREATE USER alice IDENTIFIED BY\n'secret'\n" (\handle -> do
-            entries <- runInputTBehavior (useFileHandle handle) (historySettings Nothing) $ do
-                getInputLine "" >>= liftExpectation "CREATE USER alice IDENTIFIED BY"
-                getInputLine "" >>= liftExpectation "'secret'"
-                historyLines <$> getHistory
-            entries `shouldBe` [])
+        withPasswordInput
+            "CREATE USER alice IDENTIFIED BY\n'secret'\n"
+            ( \handle -> do
+                entries <- runInputTBehavior (useFileHandle handle) (historySettings Nothing) $ do
+                    getInputLine "" >>= liftExpectation "CREATE USER alice IDENTIFIED BY"
+                    getInputLine "" >>= liftExpectation "'secret'"
+                    historyLines <$> getHistory
+                entries `shouldBe` []
+            )
     it "keeps ordinary statements and excludes multiline or mixed-case passwords" $ do
         entries <- runInputT (historySettings Nothing) $ do
             rememberStatement "SELECT 1;"
@@ -66,18 +69,20 @@ historySpec = describe "CLI: SQL history" $ do
         entries `shouldBe` ["SELECT 1;"]
     it "persists only safe statements from a batch" $ do
         directory <- getTemporaryDirectory
-        bracket (openTempFile directory "csql-history-test")
+        bracket
+            (openTempFile directory "csql-history-test")
             (\(path, _) -> removeFile path)
-            (\(path, handle) -> do
+            ( \(path, handle) -> do
                 hClose handle
                 runInputT (historySettings (Just path)) $
                     rememberBatch "SELECT 1; CREATE USER alice IDENTIFIED BY 'secret'; SELECT 2;"
                 entries <- runInputT (historySettings (Just path)) (historyLines <$> getHistory)
-                entries `shouldBe` ["SELECT 2;", "SELECT 1;"])
+                entries `shouldBe` ["SELECT 2;", "SELECT 1;"]
+            )
   where
-    -- | 核对实际读取的输入行
+    -- \| 核对实际读取的输入行
     liftExpectation expected actual = liftIO (actual `shouldBe` Just expected)
-    -- | 按完整语句筛选批量输入
+    -- \| 按完整语句筛选批量输入
     rememberBatch input = case takeStatement input of
         Nothing -> pure ()
         Just (statement, rest) -> do
@@ -88,27 +93,33 @@ historySpec = describe "CLI: SQL history" $ do
 withPasswordInput :: String -> (Handle -> IO a) -> IO a
 withPasswordInput input action = do
     directory <- getTemporaryDirectory
-    bracket (openTempFile directory "csql-password-test")
+    bracket
+        (openTempFile directory "csql-password-test")
         (\(path, handle) -> hClose handle `finally` removeFile path)
-        (\(_, handle) -> do
+        ( \(_, handle) -> do
             hSetNewlineMode handle noNewlineTranslation
             hPutStr handle input
             hSeek handle AbsoluteSeek 0
-            action handle)
+            action handle
+        )
 
 -- | 管道口令的行尾与内容用例
 passwordSpec :: Spec
 passwordSpec = describe "CLI: password input" $ do
     it "reads LF, CRLF and unterminated passwords identically" $ do
-        mapM_ (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
+        mapM_
+            (\input -> withPasswordInput input (\handle -> readPasswordInput handle `shouldReturn` "secret"))
             ["secret\n", "secret\r\n", "secret"]
     it "preserves password spaces and internal carriage returns" $
         withPasswordInput " a\rb \r\n" (\handle -> readPasswordInput handle `shouldReturn` " a\rb ")
     it "accepts an empty password and consumes only one line" $
-        withPasswordInput "\r\nsecond\n" (\handle -> do
-            readPasswordInput handle `shouldReturn` ""
-            readPasswordInput handle `shouldReturn` "second"
-            readPasswordInput handle `shouldReturn` "")
+        withPasswordInput
+            "\r\nsecond\n"
+            ( \handle -> do
+                readPasswordInput handle `shouldReturn` ""
+                readPasswordInput handle `shouldReturn` "second"
+                readPasswordInput handle `shouldReturn` ""
+            )
 
 -- | 输出格式的用例
 formatSpec :: Spec
@@ -192,7 +203,6 @@ sampleResult =
         , qrDatabase = Nothing
         }
 
-
 -- 范式元命令、严格文件与显示格式回归。
 normalizationSpec :: Spec
 normalizationSpec = describe "CLI: normalization" $ do