mirror of
http://101.35.51.105:3000/congyu/Hakysidian.git
synced 2026-04-28 05:50:49 +08:00
Split TUI from default watch mode
This commit is contained in:
Codex
@@ -54,7 +54,7 @@ cabal install exe:hakysidian
|
||||
|
||||
## Commands
|
||||
|
||||
The CLI mirrors the common Hakyll workflow:
|
||||
The default CLI mirrors the common Hakyll workflow:
|
||||
|
||||
```bash
|
||||
hakysidian build
|
||||
@@ -70,28 +70,41 @@ hakysidian watch --host 127.0.0.1 --port 8000
|
||||
hakysidian watch --no-server
|
||||
```
|
||||
|
||||
The dashboard is now an explicit TUI mode:
|
||||
|
||||
```bash
|
||||
hakysidian -tui
|
||||
hakysidian -tui --host 127.0.0.1 --port 8000
|
||||
hakysidian -tui --no-server
|
||||
```
|
||||
|
||||
What each command does:
|
||||
|
||||
- `build`: incremental site build.
|
||||
- `clean`: removes generated output and cache.
|
||||
- `rebuild`: clears output/cache and builds from scratch.
|
||||
- `watch`: shows an in-place terminal dashboard, watches project inputs, and rebuilds automatically on change.
|
||||
- `watch`: runs Hakyll's normal watch workflow, prints build logs directly to the terminal, and rebuilds automatically on change.
|
||||
- `-tui`: starts the interactive dashboard with explicit controls for watching and cleaning.
|
||||
|
||||
## Watch Mode
|
||||
## Watch And TUI
|
||||
|
||||
`watch` tracks:
|
||||
Both `watch` and `-tui` work against the same project inputs:
|
||||
|
||||
- `notes/**`
|
||||
- `reference.bib`
|
||||
- `math-macros.md`
|
||||
- `images/**`
|
||||
|
||||
The watch UI:
|
||||
Normal `watch` behaves like a standard Hakyll watch command: it stays in the terminal, rebuilds when inputs change, and can start a preview server unless `--no-server` is passed.
|
||||
|
||||
`-tui` uses an alternate-screen dashboard that:
|
||||
|
||||
- uses the terminal’s current size to keep the dashboard within the visible screen,
|
||||
- keeps recent build output in a bounded activity pane,
|
||||
- avoids scrolling raw Hakyll logs through the terminal,
|
||||
- can start a local preview server unless `--no-server` is passed.
|
||||
- can start a local preview server unless `--no-server` is passed,
|
||||
- supports `w` to start watching, `s` to stop watching, `c` to clean, and `q` to quit.
|
||||
|
||||
The TUI requires an interactive terminal.
|
||||
|
||||
## Notes Format
|
||||
|
||||
|
||||
+159
-69
@@ -9,7 +9,7 @@ import ChaoDoc
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (SomeException, bracket_, try)
|
||||
import Control.Monad (filterM, unless, void, when)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Char (isSpace, toLower)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Kind (Type)
|
||||
import Data.List (intercalate, isPrefixOf, sort, sortOn)
|
||||
@@ -112,11 +112,24 @@ data CliCommand
|
||||
| CleanCommand
|
||||
| HelpCommand
|
||||
| RebuildCommand
|
||||
| TuiCommand WatchSettings
|
||||
| WatchCommand WatchSettings
|
||||
|
||||
type TuiAction :: Type
|
||||
data TuiAction
|
||||
= TuiClean
|
||||
| TuiQuit
|
||||
| TuiStartWatching
|
||||
| TuiStopWatching
|
||||
|
||||
type FileSnapshot :: Type
|
||||
type FileSnapshot = M.Map FilePath UTCTime
|
||||
|
||||
type TuiWatchState :: Type
|
||||
data TuiWatchState
|
||||
= TuiWatchStopped
|
||||
| TuiWatching FileSnapshot
|
||||
|
||||
type ServerStatus :: Type
|
||||
data ServerStatus
|
||||
= ServerDisabled
|
||||
@@ -203,14 +216,17 @@ main = do
|
||||
Right RebuildCommand -> do
|
||||
validateProject projectRoot
|
||||
exitWith =<< runSiteCommand config rebuildOptions cslPath
|
||||
Right (TuiCommand watchSettings) -> do
|
||||
validateProject projectRoot
|
||||
exitWith =<< runTui projectRoot config cslPath watchSettings
|
||||
Right (WatchCommand watchSettings) -> do
|
||||
validateProject projectRoot
|
||||
exitWith =<< runWatch projectRoot config cslPath watchSettings
|
||||
exitWith =<< runSiteCommand config (watchOptions watchSettings) cslPath
|
||||
|
||||
usageText :: String
|
||||
usageText =
|
||||
unlines
|
||||
[ "usage: hakysidian [build|clean|rebuild|watch [--host HOST] [--port PORT] [--no-server]]",
|
||||
[ "usage: hakysidian [build|clean|rebuild|watch [--host HOST] [--port PORT] [--no-server]|-tui [--host HOST] [--port PORT] [--no-server]]",
|
||||
"",
|
||||
"Run inside a project directory containing notes/, reference.bib, math-macros.md, and optional images/."
|
||||
]
|
||||
@@ -223,6 +239,8 @@ parseCliCommand config args
|
||||
["build"] -> Right BuildCommand
|
||||
["clean"] -> Right CleanCommand
|
||||
["rebuild"] -> Right RebuildCommand
|
||||
"-tui" : rest -> Right (TuiCommand (parseWatchSettings config rest))
|
||||
"--tui" : rest -> Right (TuiCommand (parseWatchSettings config rest))
|
||||
"watch" : rest -> Right (WatchCommand (parseWatchSettings config rest))
|
||||
command : _ -> Left ("Unknown command: " <> command)
|
||||
|
||||
@@ -251,12 +269,12 @@ validateProject projectRoot = do
|
||||
initialDashboardState :: DashboardState
|
||||
initialDashboardState =
|
||||
DashboardState
|
||||
{ dashboardStatus = "starting",
|
||||
dashboardLastChange = "waiting for first build",
|
||||
dashboardLastBuild = "pending",
|
||||
{ dashboardStatus = "idle",
|
||||
dashboardLastChange = "press w to start watching",
|
||||
dashboardLastBuild = "no command run yet",
|
||||
dashboardLogLines =
|
||||
[ "watcher ready",
|
||||
"watching notes/, reference.bib, math-macros.md, images/ (optional)"
|
||||
[ "tui ready",
|
||||
"controls: w watch, s stop, c clean, q quit"
|
||||
]
|
||||
}
|
||||
|
||||
@@ -353,12 +371,11 @@ watchInputMode inputMode =
|
||||
renderWatchDashboard ::
|
||||
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
|
||||
FilePath ->
|
||||
Configuration ->
|
||||
WatchSettings ->
|
||||
IORef ServerStatus ->
|
||||
DashboardState ->
|
||||
IO ()
|
||||
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef dashboard = do
|
||||
renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef dashboard = do
|
||||
terminalSize <- getTerminalSize
|
||||
serverStatus <- readIORef serverStatusRef
|
||||
previousRenderState <- readIORef renderStateRef
|
||||
@@ -369,22 +386,20 @@ renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatu
|
||||
border = "+" ++ replicate (cols - 2) '-' ++ "+"
|
||||
infoRows =
|
||||
[ dashboardRow cols ("Project : " ++ projectRoot),
|
||||
-- dashboardRow cols ("Output : " ++ destinationDirectory config),
|
||||
dashboardRow cols ("Preview : " ++ renderServerStatus watchSettings serverStatus),
|
||||
-- dashboardRow cols "Watch : notes/, reference.bib, math-macros.md, images/ (optional)",
|
||||
-- dashboardRow cols ("Change : " ++ dashboardLastChange dashboard),
|
||||
dashboardRow cols ("Build : " ++ dashboardLastBuild dashboard)
|
||||
dashboardRow cols ("Change : " ++ dashboardLastChange dashboard),
|
||||
dashboardRow cols ("Last op : " ++ dashboardLastBuild dashboard)
|
||||
]
|
||||
headerRows =
|
||||
[ border,
|
||||
dashboardTitleRow cols "hakysidian watch" (dashboardStatus dashboard),
|
||||
dashboardTitleRow cols "hakysidian tui" (dashboardStatus dashboard),
|
||||
border
|
||||
]
|
||||
++ infoRows
|
||||
++ [border, dashboardRow cols "Recent activity", border]
|
||||
footerRows =
|
||||
[ border,
|
||||
dashboardRow cols "Controls: q quit, Ctrl-C interrupt",
|
||||
dashboardRow cols "Controls: w watch, s stop, c clean, q quit, Ctrl-C interrupt",
|
||||
border
|
||||
]
|
||||
availableLogRows = max 1 (rows - length headerRows - length footerRows)
|
||||
@@ -483,20 +498,20 @@ watchLoopDelayMicros = 1000000
|
||||
watchInputPollMicros :: Int
|
||||
watchInputPollMicros = 100000
|
||||
|
||||
waitForWatchQuit :: Bool -> Int -> IO Bool
|
||||
waitForWatchQuit watchInputEnabled remainingMicros
|
||||
| remainingMicros <= 0 = pure False
|
||||
waitForTuiAction :: Bool -> Int -> IO (Maybe TuiAction)
|
||||
waitForTuiAction watchInputEnabled remainingMicros
|
||||
| remainingMicros <= 0 = pure Nothing
|
||||
| otherwise = do
|
||||
shouldQuit <- pollWatchQuit watchInputEnabled
|
||||
if shouldQuit
|
||||
then pure True
|
||||
else do
|
||||
nextAction <- pollTuiAction watchInputEnabled
|
||||
case nextAction of
|
||||
Just action -> pure (Just action)
|
||||
Nothing -> do
|
||||
threadDelay (min watchInputPollMicros remainingMicros)
|
||||
waitForWatchQuit watchInputEnabled (remainingMicros - watchInputPollMicros)
|
||||
waitForTuiAction watchInputEnabled (remainingMicros - watchInputPollMicros)
|
||||
|
||||
pollWatchQuit :: Bool -> IO Bool
|
||||
pollWatchQuit watchInputEnabled
|
||||
| not watchInputEnabled = pure False
|
||||
pollTuiAction :: Bool -> IO (Maybe TuiAction)
|
||||
pollTuiAction watchInputEnabled
|
||||
| not watchInputEnabled = pure Nothing
|
||||
| otherwise = drainInput
|
||||
where
|
||||
drainInput = do
|
||||
@@ -504,10 +519,18 @@ pollWatchQuit watchInputEnabled
|
||||
if hasInput
|
||||
then do
|
||||
inputChar <- hGetChar stdin
|
||||
if inputChar == 'q'
|
||||
then pure True
|
||||
else drainInput
|
||||
else pure False
|
||||
case parseTuiAction inputChar of
|
||||
Just action -> pure (Just action)
|
||||
Nothing -> drainInput
|
||||
else pure Nothing
|
||||
|
||||
parseTuiAction :: Char -> Maybe TuiAction
|
||||
parseTuiAction inputChar = case toLower inputChar of
|
||||
'c' -> Just TuiClean
|
||||
'q' -> Just TuiQuit
|
||||
's' -> Just TuiStopWatching
|
||||
'w' -> Just TuiStartWatching
|
||||
_ -> Nothing
|
||||
|
||||
trimTrailingSpace :: String -> String
|
||||
trimTrailingSpace = reverse . dropWhile isSpace . reverse
|
||||
@@ -546,54 +569,107 @@ cleanOptions = Options {verbosity = False, optCommand = Clean}
|
||||
rebuildOptions :: Options
|
||||
rebuildOptions = Options {verbosity = False, optCommand = Rebuild}
|
||||
|
||||
watchOptions :: WatchSettings -> Options
|
||||
watchOptions watchSettings =
|
||||
Options
|
||||
{ verbosity = False,
|
||||
optCommand =
|
||||
Watch
|
||||
{ host = watchHost watchSettings,
|
||||
port = watchPort watchSettings,
|
||||
no_server = not (watchServerEnabled watchSettings)
|
||||
}
|
||||
}
|
||||
|
||||
runSiteCommand :: Configuration -> Options -> FilePath -> IO ExitCode
|
||||
runSiteCommand config options cslPath =
|
||||
hakyllWithExitCodeAndArgs config options (siteRules cslPath)
|
||||
|
||||
runWatch :: FilePath -> Configuration -> FilePath -> WatchSettings -> IO ExitCode
|
||||
runWatch projectRoot config _cslPath watchSettings = do
|
||||
runTui :: FilePath -> Configuration -> FilePath -> WatchSettings -> IO ExitCode
|
||||
runTui projectRoot config _cslPath watchSettings = do
|
||||
stdoutInteractive <- hIsTerminalDevice stdout
|
||||
stdinInteractive <- hIsTerminalDevice stdin
|
||||
let watchInputEnabled = stdoutInteractive && stdinInteractive
|
||||
if watchInputEnabled
|
||||
then
|
||||
withWatchTui do
|
||||
serverStatusRef <- newIORef initialServerStatus
|
||||
renderStateRef <- newIORef Nothing
|
||||
startPreviewServer config watchSettings serverStatusRef
|
||||
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef initialDashboardState
|
||||
(_, initialDashboard) <-
|
||||
runWatchBuild
|
||||
"build"
|
||||
"initial build"
|
||||
"initial build"
|
||||
projectRoot
|
||||
config
|
||||
watchSettings
|
||||
renderStateRef
|
||||
serverStatusRef
|
||||
initialDashboardState
|
||||
initialSnapshot <- snapshotInputs projectRoot
|
||||
watchLoop watchInputEnabled renderStateRef serverStatusRef initialSnapshot initialDashboard
|
||||
renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef initialDashboardState
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef TuiWatchStopped initialDashboardState
|
||||
else do
|
||||
putStrLn "hakysidian -tui requires an interactive terminal."
|
||||
pure (ExitFailure 1)
|
||||
where
|
||||
initialServerStatus
|
||||
| watchServerEnabled watchSettings = ServerStarting
|
||||
| otherwise = ServerDisabled
|
||||
|
||||
watchLoop ::
|
||||
tuiLoop ::
|
||||
Bool ->
|
||||
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
|
||||
IORef ServerStatus ->
|
||||
FileSnapshot ->
|
||||
TuiWatchState ->
|
||||
DashboardState ->
|
||||
IO ExitCode
|
||||
watchLoop watchInputEnabled renderStateRef serverStatusRef previousSnapshot dashboard = do
|
||||
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef dashboard
|
||||
shouldQuit <- waitForWatchQuit watchInputEnabled watchLoopDelayMicros
|
||||
if shouldQuit
|
||||
then pure ExitSuccess
|
||||
else do
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard = do
|
||||
renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef dashboard
|
||||
nextAction <- waitForTuiAction watchInputEnabled watchLoopDelayMicros
|
||||
case nextAction of
|
||||
Just TuiQuit -> pure ExitSuccess
|
||||
Just TuiStartWatching -> case watchState of
|
||||
TuiWatching _ ->
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard
|
||||
TuiWatchStopped -> do
|
||||
(_, nextDashboard) <-
|
||||
runDashboardCommand
|
||||
"rebuild"
|
||||
"watch start"
|
||||
"manual start"
|
||||
"building (watch start)"
|
||||
(watchCommandStatus "watch start")
|
||||
projectRoot
|
||||
watchSettings
|
||||
renderStateRef
|
||||
serverStatusRef
|
||||
dashboard
|
||||
nextSnapshot <- snapshotInputs projectRoot
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef (TuiWatching nextSnapshot) nextDashboard
|
||||
Just TuiStopWatching -> case watchState of
|
||||
TuiWatchStopped ->
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard
|
||||
TuiWatching _ -> do
|
||||
nextDashboard <-
|
||||
appendDashboardMessage
|
||||
( dashboard
|
||||
{ dashboardStatus = "idle",
|
||||
dashboardLastChange = "watch stopped"
|
||||
}
|
||||
)
|
||||
"watch stopped"
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef TuiWatchStopped nextDashboard
|
||||
Just TuiClean -> do
|
||||
(_, nextDashboard) <-
|
||||
runDashboardCommand
|
||||
"clean"
|
||||
"clean"
|
||||
"manual clean"
|
||||
"cleaning"
|
||||
cleanCommandStatus
|
||||
projectRoot
|
||||
watchSettings
|
||||
renderStateRef
|
||||
serverStatusRef
|
||||
dashboard
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef TuiWatchStopped nextDashboard
|
||||
Nothing -> case watchState of
|
||||
TuiWatchStopped ->
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard
|
||||
TuiWatching previousSnapshot -> do
|
||||
nextSnapshot <- snapshotInputs projectRoot
|
||||
if nextSnapshot == previousSnapshot
|
||||
then watchLoop watchInputEnabled renderStateRef serverStatusRef previousSnapshot dashboard
|
||||
then tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard
|
||||
else do
|
||||
let changedFiles = diffSnapshots previousSnapshot nextSnapshot
|
||||
command :: String
|
||||
@@ -603,52 +679,66 @@ runWatch projectRoot config _cslPath watchSettings = do
|
||||
else "build"
|
||||
changeSummary = intercalate ", " changedFiles
|
||||
(_, nextDashboard) <-
|
||||
runWatchBuild
|
||||
runDashboardCommand
|
||||
command
|
||||
command
|
||||
changeSummary
|
||||
("building (" ++ command ++ ")")
|
||||
(watchCommandStatus command)
|
||||
projectRoot
|
||||
config
|
||||
watchSettings
|
||||
renderStateRef
|
||||
serverStatusRef
|
||||
dashboard
|
||||
watchLoop watchInputEnabled renderStateRef serverStatusRef nextSnapshot nextDashboard
|
||||
tuiLoop watchInputEnabled renderStateRef serverStatusRef (TuiWatching nextSnapshot) nextDashboard
|
||||
|
||||
watchCommandStatus :: String -> ExitCode -> String
|
||||
watchCommandStatus label exitCode
|
||||
| exitCode == ExitSuccess = "watching"
|
||||
| otherwise = "watching after failed " ++ label
|
||||
|
||||
cleanCommandStatus :: ExitCode -> String
|
||||
cleanCommandStatus exitCode
|
||||
| exitCode == ExitSuccess = "idle"
|
||||
| otherwise = "idle after failed clean"
|
||||
|
||||
renderBuildResult :: ExitCode -> String
|
||||
renderBuildResult ExitSuccess = "success"
|
||||
renderBuildResult (ExitFailure code) = "failed (" ++ show code ++ ")"
|
||||
|
||||
runWatchBuild ::
|
||||
appendDashboardMessage :: DashboardState -> String -> IO DashboardState
|
||||
appendDashboardMessage dashboard message = do
|
||||
timestamp <- watchTimestamp
|
||||
pure (appendLogBatch dashboard message timestamp [])
|
||||
|
||||
runDashboardCommand ::
|
||||
String ->
|
||||
String ->
|
||||
String ->
|
||||
String ->
|
||||
(ExitCode -> String) ->
|
||||
FilePath ->
|
||||
Configuration ->
|
||||
WatchSettings ->
|
||||
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
|
||||
IORef ServerStatus ->
|
||||
DashboardState ->
|
||||
IO (ExitCode, DashboardState)
|
||||
runWatchBuild command label changeSummary projectRoot config watchSettings renderStateRef serverStatusRef dashboard = do
|
||||
runDashboardCommand command label changeSummary runningStatus completedStatus projectRoot watchSettings renderStateRef serverStatusRef dashboard = do
|
||||
startedAt <- watchTimestamp
|
||||
let runningDashboard =
|
||||
dashboard
|
||||
{ dashboardStatus = "building (" ++ label ++ ")",
|
||||
{ dashboardStatus = runningStatus,
|
||||
dashboardLastChange = changeSummary,
|
||||
dashboardLastBuild = "running since " ++ startedAt
|
||||
}
|
||||
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef runningDashboard
|
||||
renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef runningDashboard
|
||||
(exitCode, buildLines) <- runCapturedSiteCommand projectRoot command
|
||||
finishedAt <- watchTimestamp
|
||||
let loggedDashboard =
|
||||
appendLogBatch runningDashboard (label ++ ": " ++ changeSummary) finishedAt buildLines
|
||||
completedDashboard =
|
||||
loggedDashboard
|
||||
{ dashboardStatus =
|
||||
if exitCode == ExitSuccess
|
||||
then "watching"
|
||||
else "watching after failed " ++ label,
|
||||
{ dashboardStatus = completedStatus exitCode,
|
||||
dashboardLastBuild =
|
||||
renderBuildResult exitCode
|
||||
++ " at "
|
||||
@@ -656,7 +746,7 @@ runWatchBuild command label changeSummary projectRoot config watchSettings rende
|
||||
++ " via "
|
||||
++ label
|
||||
}
|
||||
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef completedDashboard
|
||||
renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef completedDashboard
|
||||
pure (exitCode, completedDashboard)
|
||||
|
||||
startPreviewServer :: Configuration -> WatchSettings -> IORef ServerStatus -> IO ()
|
||||
|
||||
Reference in New Issue
Block a user