Fix output loss in quiet mode when a task fails

src/App.hs

@@ -190,17 +190,19 @@ main = do
 
     skipped <- readIORef appState.skipped
 
+    -- Wait for output stream handlers to finish before logging status messages,
+    -- to ensure all subprocess output is flushed first. This has to happen before
+    -- the quiet buffer is touched: the handlers are what fill it, and the child
+    -- exiting does not mean they have drained its pipes yet.
+    timeoutStream appState "stdout" $ wait stdoutHandler
+    timeoutStream appState "stderr" $ wait stderrHandler
+
     -- Handle quiet mode buffer based on exit code
     when appState.settings.quietMode do
       if exitCode == ExitSuccess
         then discardQuietBuffer appState  -- Success: discard buffered output
         else flushQuietBuffer appState toplevelStderr  -- Failure: show buffered output
 
-    -- Wait for output stream handlers to finish before logging status messages,
-    -- to ensure all subprocess output is flushed first.
-    timeoutStream appState "stdout" $ wait stdoutHandler
-    timeoutStream appState "stderr" $ wait stderrHandler
-
     logDebug appState $ "Command " <> show (args.cmd : args.args) <> " exited with code " <> show exitCode
     logDebugParent m_parentRequestPipe $ "Subtask " <> toText jobName <> " finished with " <> show exitCode
 

src/Utils.hs

@@ -41,8 +41,9 @@ outputLine appState toplevelOutput streamName line = do
       let formattedLine = timestampStr <> "[" <> jobName <> "] " <> streamName <> " | " <> line
       if appState.settings.quietMode
         then do
-          -- In quiet mode, add to buffer instead of outputting immediately
-          modifyIORef appState.quietBuffer (formattedLine :)
+          -- In quiet mode, add to buffer instead of outputting immediately. Atomic
+          -- because the stdout and stderr handlers append concurrently.
+          atomicModifyIORef' appState.quietBuffer \buffer -> (formattedLine : buffer, ())
         else
           -- Normal mode: output immediately
           B8.hPutStrLn toplevelOutput formattedLine

test/Spec.hs

@@ -159,7 +159,11 @@
             } \_ _ _ processHandle -> do
 
         output <- LBS.hGetContents pipeRead
-        -- FIXME: we can probably get a deadlock if the pipe is filled (since we're not reading from it yet)
+        -- Drain before reaping. hGetContents is lazy, so leaving this unevaluated until
+        -- after waitForProcess deadlocks as soon as the task writes more than the pipe
+        -- buffer holds (~64 KiB). std_out/std_err were passed as UseHandle, which closes
+        -- our copy of the write end, so the read terminates at EOF when the task exits.
+        _ <- evaluateWHNF (LBS.length output)
 
         exitCode <- waitForProcess processHandle
 
@@ -236,7 +240,7 @@
         modify (\s -> s { githubTokenExpirationOffset = readMaybe (toString n) })
         go rest
       ["#", "quiet"] -> do
         modify (\s -> (s :: Options) { quiet = True })
         go rest
       -- TODO: validate?
       _ ->