UI: Don't persist screens after they quit unless explicitly requested

Author: tek

packages/hix/lib/Hix/Data/Monad.hs

@@ -34,7 +34,8 @@ data AppResources =
     target :: OutputTarget,
     theme :: Theme,
     tui :: TuiHandlers M,
-    context :: [AppContext]
+    context :: [AppContext],
+    persistentUi :: Bool
   }
   deriving stock (Generic)
 

packages/hix/lib/Hix/Managed/Data/ReleaseConfig.hs

@@ -64,7 +64,10 @@ data ReleaseConfig =
     merge :: Bool,
     -- | Use the global Cabal configuration file instead of hermetic @/dev/null@.
     --   This allows using credentials configured in @~\/.cabal\/config@ but sacrifices reproducibility.
-    globalCabalConfig :: Bool
+    globalCabalConfig :: Bool,
+    -- | Keep the Brick UI screens rendered on the terminal after they are completed.
+    --   When 'False' (default), the cursor is reset to overwrite the UI and a log message is printed instead.
+    persistentUi :: Bool
   }
   deriving stock (Eq, Show)
 
@@ -85,5 +88,6 @@ instance Default ReleaseConfig where
       forceVersion = False,
       check = False,
       merge = False,
-      globalCabalConfig = False
+      globalCabalConfig = False,
+      persistentUi = False
     }

packages/hix/lib/Hix/Managed/Handlers/ReleaseUi/DistTargets/Run.hs

@@ -45,7 +45,8 @@ chooseDistTargetsNe debug checksPassed packages = do
       render,
       startEvent = unit,
       debug,
-      initialContext = uiDistTargets checksPassed packages
+      initialContext = uiDistTargets checksPassed packages,
+      screenLog = "Completed distribution target selection"
     }
 
 chooseDistTargets ::

packages/hix/lib/Hix/Managed/Handlers/ReleaseUi/UploadTargets/Run.hs

@@ -1,5 +1,7 @@
 module Hix.Managed.Handlers.ReleaseUi.UploadTargets.Run where
 
+import Exon (exon)
+
 import Hix.Class.Map (nList)
 import Hix.Data.Monad (M)
 import Hix.Data.PackageName (LocalPackage)
@@ -47,7 +49,8 @@ chooseUploadTargetsNe debug stage packages = do
       render,
       startEvent = unit,
       debug,
-      initialContext = uiUploadTargets stage packages
+      initialContext = uiUploadTargets stage packages,
+      screenLog = [exon|Completed #{showP stage} target selection|]
     }
 
 chooseUploadTargets ::

packages/hix/lib/Hix/Managed/Handlers/ReleaseUi/VersionProblems/Run.hs

@@ -38,5 +38,6 @@ chooseVersionProblems debug problems = do
       render,
       startEvent = unit,
       debug,
-      initialContext = uiVersionProblems problems
+      initialContext = uiVersionProblems problems,
+      screenLog = "Completed version problem review"
     }

packages/hix/lib/Hix/Managed/Handlers/ReleaseUi/Versions/Run.hs

@@ -41,5 +41,6 @@ chooseVersions debug sharedVersion targets = do
       render,
       startEvent = unit,
       debug,
-      initialContext = uiVersions sharedVersion targets
+      initialContext = uiVersions sharedVersion targets,
+      screenLog = "Completed version selection"
     }

packages/hix/lib/Hix/Managed/Release.hs

@@ -4,6 +4,7 @@ import Exon (exon)
 import Path (Abs, File, Path)
 
 import Hix.Class.Map (nMap, nNull, nSize)
+import qualified Hix.Data.Monad as AppResources
 import Hix.Data.Monad (AppResources (..), M, appRes)
 import Hix.Data.Options (ReleaseOptions (..))
 import Hix.Data.PackageName (LocalPackage)
@@ -36,7 +37,7 @@ import qualified Hix.Managed.Release.Report as Report
 import Hix.Managed.Release.Staged (ReleaseStage (..))
 import Hix.Managed.Release.StateVersions (updateStateVersions)
 import Hix.Managed.Release.Validation (ProblematicVersion, findProblematicVersions, validateVersionsBatch)
-import Hix.Monad (appContext, ask, clientError)
+import Hix.Monad (appContext, ask, clientError, local)
 import Hix.Pretty (showP)
 
 -- | Handle post-upload activities: execute hooks and commit git changes.
@@ -185,6 +186,7 @@ releaseCli options = do
   context <- jsonOrQueryProd ContextRelease options.context
   cabal <- cabalConfig context.hackage options.cabal
   handlers <- Release.handlersProd options cabal
-  release handlers options.config context >>= \case
-    ReleaseStage {state = ReleaseState {termination = Termination _}} -> clientError "Release failed."
-    _ -> unit
+  local (\ res -> res {AppResources.persistentUi = options.config.persistentUi}) do
+    release handlers options.config context >>= \case
+      ReleaseStage {state = ReleaseState {termination = Termination _}} -> clientError "Release failed."
+      _ -> unit

packages/hix/lib/Hix/Monad/Run.hs

@@ -35,6 +35,7 @@ runMTuiWith tui GlobalOptions {..} ma =
         context = [],
         cwd = resolvedCwd,
         root = resolvedRoot,
+        persistentUi = True,
         ..
       }
     ExceptT (runMUsing resources ma)

packages/hix/lib/Hix/Options.hs

@@ -509,6 +509,7 @@ releaseConfigParser = do
   check <- switch (long "check" <> help "Run flake checks before uploading")
   merge <- switch (long "merge" <> help "Merge the release branch back into the initial branch after successful uploads")
   globalCabalConfig <- switch (long "global-cabal-config" <> help "Use the global Cabal config for Hackage servers in addition to the flake config")
+  persistentUi <- switch (long "persistent-ui" <> help "Keep interactive UI screens visible on the terminal after completion")
   pure ReleaseConfig {candidates = selectCandidates publish candidatesSpec, ..}
   where
     versionHelp = "New version or increment (super|major|minor|patch)"

packages/hix/lib/Hix/Terminal/State.hs

@@ -2,11 +2,19 @@ module Hix.Terminal.State where
 
 import Control.Monad.Catch (bracket)
 import Data.IORef (IORef, newIORef, readIORef)
-import System.Console.ANSI (hHideCursor, hSaveCursor, hSetCursorColumn, hSetCursorPosition, hShowCursor)
+import System.Console.ANSI (
+  hClearLine,
+  hCursorDown,
+  hHideCursor,
+  hSaveCursor,
+  hSetCursorColumn,
+  hSetCursorPosition,
+  hShowCursor,
+  )
 import System.IO (BufferMode (..), Handle, hFlush, hGetBuffering, hPutStr, hSetBuffering, hSetEcho, stdin)
 import System.Posix (Fd)
 
-import Hix.Data.Monad (M)
+import Hix.Data.Monad (AppResources (..), M, appRes)
 import Hix.Error (ignoringIOErrors)
 import Hix.Monad (appContextVerboseIO)
 import Hix.Terminal.Geometry (runRender, terminalGeometry)
@@ -58,37 +66,56 @@ hInitializeTerminal tuiState = do
   stateRef <- newOutputState tuiState
   pure (bufMode, stateRef)
 
--- | After a Brick app exits, move the cursor below the rendered area so subsequent output
--- (log messages, next UI) doesn't overwrite the previous content.
-repositionCursor :: Handle -> IORef OutputState -> IO ()
-repositionCursor hOut stateRef = do
+-- | After a Brick app exits, reposition the cursor.
+--
+-- When @persistent@ is 'True', move below the rendered area so subsequent output doesn't
+-- overwrite the previous content.
+--
+-- When @persistent@ is 'False', move back to the first line of the rendered area and clear
+-- the lines so the next output starts where the UI was.
+repositionCursor :: Bool -> Handle -> IORef OutputState -> IO ()
+repositionCursor persistent hOut stateRef = do
   OutputState {firstLine, lastRenderHeight} <- readIORef stateRef
   when (lastRenderHeight > 0) do
-    -- Move to the last rendered line and emit a newline.
-    -- This works even when the cursor is at the bottom of the terminal,
-    -- where hSetCursorPosition would be clamped and fail to advance.
-    let lastLine = firstLine + lastRenderHeight - 1
-    hSetCursorPosition hOut lastLine 0
-    hPutStr hOut "\n"
-    hFlush hOut
+    if persistent
+    then do
+      -- Move to the last rendered line and emit a newline.
+      -- This works even when the cursor is at the bottom of the terminal,
+      -- where hSetCursorPosition would be clamped and fail to advance.
+      let lastLine = firstLine + lastRenderHeight - 1
+      hSetCursorPosition hOut lastLine 0
+      hPutStr hOut "\n"
+      hFlush hOut
+    else do
+      -- Move back to the first line and clear the rendered area.
+      hSetCursorPosition hOut firstLine 0
+      replicateM_ lastRenderHeight do
+        hClearLine hOut
+        hCursorDown hOut 1
+      hSetCursorPosition hOut firstLine 0
+      hFlush hOut
 
 hResetTerminal ::
+  Bool ->
   IORef VtyTuiResources ->
   (BufferMode, IORef OutputState) ->
   IO ()
-hResetTerminal tuiState (hInMode, stateRef) = do
+hResetTerminal persistent tuiState (hInMode, stateRef) = do
   VtyTuiResources {hIn, hOut} <- readIORef tuiState
-  ignoringIOErrors $ repositionCursor hOut stateRef
-  ignoringIOErrors $ hShowCursor hOut
-  ignoringIOErrors $ hFlush hOut
-  ignoringIOErrors $ hSetEcho hIn True
-  ignoringIOErrors $ hSetBuffering hIn hInMode
+  traverse_ @[] ignoringIOErrors [
+    repositionCursor persistent hOut stateRef,
+    hShowCursor hOut,
+    hFlush hOut,
+    hSetEcho hIn True,
+    hSetBuffering hIn hInMode
+    ]
 
 bracketTerminal ::
   IORef VtyTuiResources ->
   (IORef OutputState -> IO a) ->
   M a
-bracketTerminal tuiState use =
+bracketTerminal tuiState use = do
+  persistent <- appRes.persistentUi
   appContextVerboseIO "running brick app" do
-    bracket (hInitializeTerminal tuiState) (hResetTerminal tuiState) \ (_, stateRef) ->
+    bracket (hInitializeTerminal tuiState) (hResetTerminal persistent tuiState) \ (_, stateRef) ->
       use stateRef