diff --git a/readme.md b/readme.md index 4e5cb02..97acf28 100644 --- a/readme.md +++ b/readme.md @@ -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 diff --git a/src/site.hs b/src/site.hs index bb49a29..10829ca 100644 --- a/src/site.hs +++ b/src/site.hs @@ -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,109 +569,176 @@ 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 - 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 + if watchInputEnabled + then + withWatchTui do + serverStatusRef <- newIORef initialServerStatus + renderStateRef <- newIORef Nothing + startPreviewServer config watchSettings serverStatusRef + 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 - nextSnapshot <- snapshotInputs projectRoot - if nextSnapshot == previousSnapshot - then watchLoop watchInputEnabled renderStateRef serverStatusRef previousSnapshot dashboard - else do - let changedFiles = diffSnapshots previousSnapshot nextSnapshot - command :: String - command = - if any (`M.notMember` nextSnapshot) (M.keys previousSnapshot) - then "rebuild" - else "build" - changeSummary = intercalate ", " changedFiles - (_, nextDashboard) <- - runWatchBuild - command - command - changeSummary - projectRoot - config - watchSettings - renderStateRef - serverStatusRef - dashboard - watchLoop watchInputEnabled renderStateRef serverStatusRef nextSnapshot nextDashboard + 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 tuiLoop watchInputEnabled renderStateRef serverStatusRef watchState dashboard + else do + let changedFiles = diffSnapshots previousSnapshot nextSnapshot + command :: String + command = + if any (`M.notMember` nextSnapshot) (M.keys previousSnapshot) + then "rebuild" + else "build" + changeSummary = intercalate ", " changedFiles + (_, nextDashboard) <- + runDashboardCommand + command + command + changeSummary + ("building (" ++ command ++ ")") + (watchCommandStatus command) + projectRoot + watchSettings + renderStateRef + serverStatusRef + dashboard + 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 ()