{-# LANGUAGE OverloadedStrings #-} module Repl ( runRepl , runStatementOnce , reportError ) where import ChuSQL.CLI.Format (OutputFormat, formatName, renderResult, renderRows) import ChuSQL.CLI.Script (Meta (..), errorHint, metaHelp, parseMeta, takeStatement) import ChuSQL.CLI.Session (Session, accountTable, catalog, databases, roleViews, runStatement, sessionDatabase, switchDatabase) import ChuSQL.Storage.IPC (SchemaColumn (..), TableInfo (..)) import ChuSQL.Web.Privileges (Grant (..), RoleView (..)) import Control.Monad (forM_, when) import Control.Monad.IO.Class (liftIO) import Data.IORef (IORef, readIORef, writeIORef) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO import System.Console.Haskeline import System.IO (hIsTerminalDevice, stderr, stdin) -- 交互层:提示符、多行输入、历史、元命令与错误提示。 -- | 交互循环;historyPath 为 Nothing 就不落盘历史 runRepl :: Session -> IORef OutputFormat -> Maybe FilePath -> IO () runRepl session formatRef historyPath = runInputT (defaultSettings{historyFile = historyPath}) (loop session formatRef T.empty) -- | 入口处直接报错(-e 与启动阶段用) reportError :: Text -> IO () reportError message = do TIO.hPutStrLn stderr ("chusql: error: " <> message) forM_ (errorHint message) (\hint -> TIO.hPutStrLn stderr ("hint: " <> hint)) -- | 跑一条语句并按格式打印;成功与否当退出码 runStatementOnce :: Session -> OutputFormat -> Text -> IO Bool runStatementOnce session format sql = do result <- runStatement session sql case result of Left message -> reportError message >> pure False Right answer -> TIO.putStrLn (renderResult format answer) >> pure True loop :: Session -> IORef OutputFormat -> Text -> InputT IO () loop session formatRef buffer = do prompt <- liftIO (promptFor session buffer) entered <- getInputLine (T.unpack prompt) case entered of Nothing -> do interactive <- liftIO (hIsTerminalDevice stdin) when interactive (outputStrLn "") Just raw -> do let line = T.strip (T.pack raw) if T.null line then loop session formatRef buffer else case (T.null buffer, parseMeta line) of (True, Just meta) -> do again <- runMeta session formatRef meta when again (loop session formatRef T.empty) _ -> do let extended = if T.null buffer then line else buffer <> "\n" <> line remaining <- drain session formatRef extended loop session formatRef remaining -- | 提示符带上当前库;续行换个样子,方便看出语句还没写完;管道输入时不出提示符 promptFor :: Session -> Text -> IO Text promptFor session buffer = do interactive <- hIsTerminalDevice stdin if not interactive then pure "" else if not (T.null (T.strip buffer)) then pure " -> " else do current <- sessionDatabase session pure (if T.null current then "chusql> " else "chusql [" <> current <> "]> ") -- | 把攒下来的内容里所有完整语句依次执行,返回没写完的残余 drain :: Session -> IORef OutputFormat -> Text -> InputT IO Text drain session formatRef buffer = case takeStatement buffer of Nothing -> pure (T.strip buffer) Just (statement, rest) -> do when (not (T.null statement)) (runOne session formatRef statement) drain session formatRef rest runOne :: Session -> IORef OutputFormat -> Text -> InputT IO () runOne session formatRef statement = do result <- liftIO (runStatement session statement) case result of Left message -> liftIO (reportError message) Right answer -> do format <- liftIO (readIORef formatRef) outputStrLn (T.unpack (renderResult format answer)) runMeta :: Session -> IORef OutputFormat -> Meta -> InputT IO Bool runMeta session formatRef meta = case meta of MetaQuit -> pure False MetaHelp -> outputStrLn (T.unpack metaHelp) >> pure True MetaDatabases -> listDatabases session >> pure True MetaTables -> listTables session >> pure True MetaDescribe name -> describeTable session name >> pure True MetaRoles -> listRoles session >> pure True MetaConnect name -> do switched <- liftIO (switchDatabase session name) case switched of Left message -> liftIO (reportError message) Right () -> outputStrLn ("database is now " <> T.unpack name) pure True MetaSetFormat format -> do liftIO (writeIORef formatRef format) outputStrLn ("output format is now " <> T.unpack (formatName format)) pure True MetaUnknown name -> outputStrLn ("unknown command: \\" <> T.unpack name <> " (try \\?)") >> pure True -- | \l:库清单 listDatabases :: Session -> InputT IO () listDatabases session = do answer <- liftIO (databases session) case answer of Left message -> liftIO (reportError message) Right names -> outputStrLn (T.unpack (renderRows ["database"] (map (: []) names))) -- | \dt:表清单(base 里补上账号表) listTables :: Session -> InputT IO () listTables session = do answer <- liftIO (catalog session) case answer of Left message -> liftIO (reportError message) Right tables -> do allTables <- liftIO (withAccountTable session tables) outputStrLn (T.unpack (renderRows headers (map tableRow allTables))) where headers = ["table", "columns", "rows", "indexes"] tableRow info = [ T.pack (tiTable info) , tshow (length (tiColumns info)) , tshow (tiRows info) , if null (tiIndexes info) then "-" else T.intercalate ", " (map T.pack (tiIndexes info)) ] -- | \d