congyu/Hakysidian
1
Fork 0
Code Issues Pull Requests Activity

Split TUI from default watch mode

Browse Source
This commit is contained in:
Codex
2026-03-30 11:05:44 +08:00
parent aa05d73c9c
commit 3a3fd97055
2 changed files with 202 additions and 99 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
readme.md
View File

@@ -54,7 +54,7 @@ cabal install exe:hakysidian
## Commands ## Commands
The CLI mirrors the common Hakyll workflow: The default CLI mirrors the common Hakyll workflow:
```bash ```bash
hakysidian build hakysidian build
@@ -70,28 +70,41 @@ hakysidian watch --host 127.0.0.1 --port 8000
hakysidian watch --no-server 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: What each command does:
- `build`: incremental site build. - `build`: incremental site build.
- `clean`: removes generated output and cache. - `clean`: removes generated output and cache.
- `rebuild`: clears output/cache and builds from scratch. - `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/**` - `notes/**`
- `reference.bib` - `reference.bib`
- `math-macros.md` - `math-macros.md`
- `images/**` - `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, - uses the terminal’s current size to keep the dashboard within the visible screen,
- keeps recent build output in a bounded activity pane, - 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 ## Notes Format

228
src/site.hs
View File

@@ -9,7 +9,7 @@ import ChaoDoc
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (SomeException, bracket_, try) import Control.Exception (SomeException, bracket_, try)
import Control.Monad (filterM, unless, void, when) 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.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Kind (Type) import Data.Kind (Type)
import Data.List (intercalate, isPrefixOf, sort, sortOn) import Data.List (intercalate, isPrefixOf, sort, sortOn)
@@ -112,11 +112,24 @@ data CliCommand
| CleanCommand | CleanCommand
| HelpCommand | HelpCommand
| RebuildCommand | RebuildCommand
| TuiCommand WatchSettings
| WatchCommand WatchSettings | WatchCommand WatchSettings
type TuiAction :: Type
data TuiAction
= TuiClean
| TuiQuit
| TuiStartWatching
| TuiStopWatching
type FileSnapshot :: Type type FileSnapshot :: Type
type FileSnapshot = M.Map FilePath UTCTime type FileSnapshot = M.Map FilePath UTCTime
type TuiWatchState :: Type
data TuiWatchState
= TuiWatchStopped
| TuiWatching FileSnapshot
type ServerStatus :: Type type ServerStatus :: Type
data ServerStatus data ServerStatus
= ServerDisabled = ServerDisabled
@@ -203,14 +216,17 @@ main = do
Right RebuildCommand -> do Right RebuildCommand -> do
validateProject projectRoot validateProject projectRoot
exitWith =<< runSiteCommand config rebuildOptions cslPath exitWith =<< runSiteCommand config rebuildOptions cslPath
Right (TuiCommand watchSettings) -> do
validateProject projectRoot
exitWith =<< runTui projectRoot config cslPath watchSettings
Right (WatchCommand watchSettings) -> do Right (WatchCommand watchSettings) -> do
validateProject projectRoot validateProject projectRoot
exitWith =<< runWatch projectRoot config cslPath watchSettings exitWith =<< runSiteCommand config (watchOptions watchSettings) cslPath
usageText :: String usageText :: String
usageText = usageText =
unlines 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/." "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 ["build"] -> Right BuildCommand
["clean"] -> Right CleanCommand ["clean"] -> Right CleanCommand
["rebuild"] -> Right RebuildCommand ["rebuild"] -> Right RebuildCommand
"-tui" : rest -> Right (TuiCommand (parseWatchSettings config rest))
"--tui" : rest -> Right (TuiCommand (parseWatchSettings config rest))
"watch" : rest -> Right (WatchCommand (parseWatchSettings config rest)) "watch" : rest -> Right (WatchCommand (parseWatchSettings config rest))
command : _ -> Left ("Unknown command: " <> command) command : _ -> Left ("Unknown command: " <> command)
@@ -251,12 +269,12 @@ validateProject projectRoot = do
initialDashboardState :: DashboardState initialDashboardState :: DashboardState
initialDashboardState = initialDashboardState =
DashboardState DashboardState
{ dashboardStatus = "starting", { dashboardStatus = "idle",
dashboardLastChange = "waiting for first build", dashboardLastChange = "press w to start watching",
dashboardLastBuild = "pending", dashboardLastBuild = "no command run yet",
dashboardLogLines = dashboardLogLines =
[ "watcher ready", [ "tui ready",
"watching notes/, reference.bib, math-macros.md, images/ (optional)" "controls: w watch, s stop, c clean, q quit"
] ]
} }
@@ -353,12 +371,11 @@ watchInputMode inputMode =
renderWatchDashboard :: renderWatchDashboard ::
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) -> IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
FilePath -> FilePath ->
Configuration ->
WatchSettings -> WatchSettings ->
IORef ServerStatus -> IORef ServerStatus ->
DashboardState -> DashboardState ->
IO () IO ()
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef dashboard = do renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef dashboard = do
terminalSize <- getTerminalSize terminalSize <- getTerminalSize
serverStatus <- readIORef serverStatusRef serverStatus <- readIORef serverStatusRef
previousRenderState <- readIORef renderStateRef previousRenderState <- readIORef renderStateRef
@@ -369,22 +386,20 @@ renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatu
border = "+" ++ replicate (cols - 2) '-' ++ "+" border = "+" ++ replicate (cols - 2) '-' ++ "+"
infoRows = infoRows =
[ dashboardRow cols ("Project : " ++ projectRoot), [ dashboardRow cols ("Project : " ++ projectRoot),
-- dashboardRow cols ("Output : " ++ destinationDirectory config),
dashboardRow cols ("Preview : " ++ renderServerStatus watchSettings serverStatus), dashboardRow cols ("Preview : " ++ renderServerStatus watchSettings serverStatus),
-- dashboardRow cols "Watch : notes/, reference.bib, math-macros.md, images/ (optional)", dashboardRow cols ("Change : " ++ dashboardLastChange dashboard),
-- dashboardRow cols ("Change : " ++ dashboardLastChange dashboard), dashboardRow cols ("Last op : " ++ dashboardLastBuild dashboard)
dashboardRow cols ("Build : " ++ dashboardLastBuild dashboard)
] ]
headerRows = headerRows =
[ border, [ border,
dashboardTitleRow cols "hakysidian watch" (dashboardStatus dashboard), dashboardTitleRow cols "hakysidian tui" (dashboardStatus dashboard),
border border
] ]
++ infoRows ++ infoRows
++ [border, dashboardRow cols "Recent activity", border] ++ [border, dashboardRow cols "Recent activity", border]
footerRows = footerRows =
[ border, [ border,
dashboardRow cols "Controls: q quit, Ctrl-C interrupt", dashboardRow cols "Controls: w watch, s stop, c clean, q quit, Ctrl-C interrupt",
border border
] ]
availableLogRows = max 1 (rows - length headerRows - length footerRows) availableLogRows = max 1 (rows - length headerRows - length footerRows)
@@ -483,20 +498,20 @@ watchLoopDelayMicros = 1000000
watchInputPollMicros :: Int watchInputPollMicros :: Int
watchInputPollMicros = 100000 watchInputPollMicros = 100000
waitForWatchQuit :: Bool -> Int -> IO Bool waitForTuiAction :: Bool -> Int -> IO (Maybe TuiAction)
waitForWatchQuit watchInputEnabled remainingMicros waitForTuiAction watchInputEnabled remainingMicros
| remainingMicros <= 0 = pure False | remainingMicros <= 0 = pure Nothing
| otherwise = do | otherwise = do
shouldQuit <- pollWatchQuit watchInputEnabled nextAction <- pollTuiAction watchInputEnabled
if shouldQuit case nextAction of
then pure True Just action -> pure (Just action)
else do Nothing -> do
threadDelay (min watchInputPollMicros remainingMicros) threadDelay (min watchInputPollMicros remainingMicros)
waitForWatchQuit watchInputEnabled (remainingMicros - watchInputPollMicros) waitForTuiAction watchInputEnabled (remainingMicros - watchInputPollMicros)
pollWatchQuit :: Bool -> IO Bool pollTuiAction :: Bool -> IO (Maybe TuiAction)
pollWatchQuit watchInputEnabled pollTuiAction watchInputEnabled
| not watchInputEnabled = pure False | not watchInputEnabled = pure Nothing
| otherwise = drainInput | otherwise = drainInput
where where
drainInput = do drainInput = do
@@ -504,10 +519,18 @@ pollWatchQuit watchInputEnabled
if hasInput if hasInput
then do then do
inputChar <- hGetChar stdin inputChar <- hGetChar stdin
if inputChar == 'q' case parseTuiAction inputChar of
then pure True Just action -> pure (Just action)
else drainInput Nothing -> drainInput
else pure False 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 :: String -> String
trimTrailingSpace = reverse . dropWhile isSpace . reverse trimTrailingSpace = reverse . dropWhile isSpace . reverse
@@ -546,54 +569,107 @@ cleanOptions = Options {verbosity = False, optCommand = Clean}
rebuildOptions :: Options rebuildOptions :: Options
rebuildOptions = Options {verbosity = False, optCommand = Rebuild} 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 :: Configuration -> Options -> FilePath -> IO ExitCode
runSiteCommand config options cslPath = runSiteCommand config options cslPath =
hakyllWithExitCodeAndArgs config options (siteRules cslPath) hakyllWithExitCodeAndArgs config options (siteRules cslPath)
runWatch :: FilePath -> Configuration -> FilePath -> WatchSettings -> IO ExitCode runTui :: FilePath -> Configuration -> FilePath -> WatchSettings -> IO ExitCode
runWatch projectRoot config _cslPath watchSettings = do runTui projectRoot config _cslPath watchSettings = do
stdoutInteractive <- hIsTerminalDevice stdout stdoutInteractive <- hIsTerminalDevice stdout
stdinInteractive <- hIsTerminalDevice stdin stdinInteractive <- hIsTerminalDevice stdin
let watchInputEnabled = stdoutInteractive && stdinInteractive let watchInputEnabled = stdoutInteractive && stdinInteractive
if watchInputEnabled
then
withWatchTui do withWatchTui do
serverStatusRef <- newIORef initialServerStatus serverStatusRef <- newIORef initialServerStatus
renderStateRef <- newIORef Nothing renderStateRef <- newIORef Nothing
startPreviewServer config watchSettings serverStatusRef startPreviewServer config watchSettings serverStatusRef
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef initialDashboardState renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef initialDashboardState
(_, initialDashboard) <- tuiLoop watchInputEnabled renderStateRef serverStatusRef TuiWatchStopped initialDashboardState
runWatchBuild else do
"build" putStrLn "hakysidian -tui requires an interactive terminal."
"initial build" pure (ExitFailure 1)
"initial build"
projectRoot
config
watchSettings
renderStateRef
serverStatusRef
initialDashboardState
initialSnapshot <- snapshotInputs projectRoot
watchLoop watchInputEnabled renderStateRef serverStatusRef initialSnapshot initialDashboard
where where
initialServerStatus initialServerStatus
| watchServerEnabled watchSettings = ServerStarting | watchServerEnabled watchSettings = ServerStarting
| otherwise = ServerDisabled | otherwise = ServerDisabled
watchLoop :: tuiLoop ::
Bool -> Bool ->
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) -> IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
IORef ServerStatus -> IORef ServerStatus ->
FileSnapshot -> TuiWatchState ->
DashboardState -> DashboardState ->
IO ExitCode IO ExitCode
watchLoop watchInputEnabled renderStateRef serverStatusRef previousSnapshot dashboard = do tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard = do
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef dashboard renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef dashboard
shouldQuit <- waitForWatchQuit watchInputEnabled watchLoopDelayMicros nextAction <- waitForTuiAction watchInputEnabled watchLoopDelayMicros
if shouldQuit case nextAction of
then pure ExitSuccess Just TuiQuit -> pure ExitSuccess
else do 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 nextSnapshot <- snapshotInputs projectRoot
if nextSnapshot == previousSnapshot if nextSnapshot == previousSnapshot
then watchLoop watchInputEnabled renderStateRef serverStatusRef previousSnapshot dashboard then tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard
else do else do
let changedFiles = diffSnapshots previousSnapshot nextSnapshot let changedFiles = diffSnapshots previousSnapshot nextSnapshot
command :: String command :: String
@@ -603,52 +679,66 @@ runWatch projectRoot config _cslPath watchSettings = do
else "build" else "build"
changeSummary = intercalate ", " changedFiles changeSummary = intercalate ", " changedFiles
(_, nextDashboard) <- (_, nextDashboard) <-
runWatchBuild runDashboardCommand
command command
command command
changeSummary changeSummary
("building (" ++ command ++ ")")
(watchCommandStatus command)
projectRoot projectRoot
config
watchSettings watchSettings
renderStateRef renderStateRef
serverStatusRef serverStatusRef
dashboard 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 :: ExitCode -> String
renderBuildResult ExitSuccess = "success" renderBuildResult ExitSuccess = "success"
renderBuildResult (ExitFailure code) = "failed (" ++ show code ++ ")" 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 ->
String -> String ->
String ->
(ExitCode -> String) ->
FilePath -> FilePath ->
Configuration ->
WatchSettings -> WatchSettings ->
IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) -> IORef (Maybe (TerminalSize, ServerStatus, DashboardState)) ->
IORef ServerStatus -> IORef ServerStatus ->
DashboardState -> DashboardState ->
IO (ExitCode, 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 startedAt <- watchTimestamp
let runningDashboard = let runningDashboard =
dashboard dashboard
{ dashboardStatus = "building (" ++ label ++ ")", { dashboardStatus = runningStatus,
dashboardLastChange = changeSummary, dashboardLastChange = changeSummary,
dashboardLastBuild = "running since " ++ startedAt dashboardLastBuild = "running since " ++ startedAt
} }
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef runningDashboard renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef runningDashboard
(exitCode, buildLines) <- runCapturedSiteCommand projectRoot command (exitCode, buildLines) <- runCapturedSiteCommand projectRoot command
finishedAt <- watchTimestamp finishedAt <- watchTimestamp
let loggedDashboard = let loggedDashboard =
appendLogBatch runningDashboard (label ++ ": " ++ changeSummary) finishedAt buildLines appendLogBatch runningDashboard (label ++ ": " ++ changeSummary) finishedAt buildLines
completedDashboard = completedDashboard =
loggedDashboard loggedDashboard
{ dashboardStatus = { dashboardStatus = completedStatus exitCode,
if exitCode == ExitSuccess
then "watching"
else "watching after failed " ++ label,
dashboardLastBuild = dashboardLastBuild =
renderBuildResult exitCode renderBuildResult exitCode
++ " at " ++ " at "
@@ -656,7 +746,7 @@ runWatchBuild command label changeSummary projectRoot config watchSettings rende
++ " via " ++ " via "
++ label ++ label
} }
renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatusRef completedDashboard renderWatchDashboard renderStateRef projectRoot watchSettings serverStatusRef completedDashboard
pure (exitCode, completedDashboard) pure (exitCode, completedDashboard)
startPreviewServer :: Configuration -> WatchSettings -> IORef ServerStatus -> IO () startPreviewServer :: Configuration -> WatchSettings -> IORef ServerStatus -> IO ()