summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Omni/Bild.hs22
-rw-r--r--Omni/Bild.nix1
-rw-r--r--Omni/Log/Concurrent.hs44
-rw-r--r--Omni/Log/Terminal.hs22
4 files changed, 27 insertions, 62 deletions
diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index 15e359f..4bb62a5 100644
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -555,11 +555,11 @@ analyzeAll :: [Namespace] -> IO Analysis
analyzeAll nss = do
LogC.withLineManager nss <| \lineMgr -> do
LogC.initializeLines lineMgr
- targets <- mapConcurrentlyBounded 8 (analyzeOne lineMgr) nss
+ targets <- mapConcurrentlyBounded 8 analyzeOne nss
pure <| Map.fromList <| catMaybes <| zipWith (\ns mt -> (ns,) </ mt) nss targets
where
- analyzeOne :: LogC.LineManager -> Namespace -> IO (Maybe Target)
- analyzeOne _lineMgr namespace@(Namespace parts ext) = do
+ analyzeOne :: Namespace -> IO (Maybe Target)
+ analyzeOne namespace@(Namespace parts ext) = do
let path = Namespace.toPath namespace
root <- Env.getEnv "CODEROOT"
let abspath = root </> path
@@ -1147,10 +1147,18 @@ build andTest loud jobs cpus analysis = do
root <- Env.getEnv "CODEROOT"
let targets = Map.elems analysis
let namespaces = map (\Target {..} -> namespace) targets
- LogC.withLineManager namespaces <| \lineMgr -> do
- LogC.initializeLines lineMgr
- results <- mapConcurrentlyBounded jobs (buildTarget root) targets
- pure (map fst results)
+ -- Use adaptive concurrent UI unless --loud is set
+ if loud
+ then do
+ -- Loud mode: simple output, no concurrent UI
+ results <- mapConcurrentlyBounded jobs (buildTarget root) targets
+ pure (map fst results)
+ else -- Adaptive UI based on terminal width
+
+ LogC.withLineManager namespaces <| \lineMgr -> do
+ LogC.initializeLines lineMgr
+ results <- mapConcurrentlyBounded jobs (buildTarget root) targets
+ pure (map fst results)
where
buildTarget :: FilePath -> Target -> IO (Exit.ExitCode, ByteString)
buildTarget root target@Target {..} = do
diff --git a/Omni/Bild.nix b/Omni/Bild.nix
index 6a7b87f..f6291ef 100644
--- a/Omni/Bild.nix
+++ b/Omni/Bild.nix
@@ -166,6 +166,7 @@
../Omni/Cli.hs
../Omni/Log.hs
../Omni/Log/Concurrent.hs
+ ../Omni/Log/Terminal.hs
../Omni/Namespace.hs
../Omni/Test.hs
];
diff --git a/Omni/Log/Concurrent.hs b/Omni/Log/Concurrent.hs
index d56d1cc..83289f3 100644
--- a/Omni/Log/Concurrent.hs
+++ b/Omni/Log/Concurrent.hs
@@ -47,14 +47,6 @@ withLineManager nss action = do
termInfo <- detectTerminal
case tiMode termInfo of
- SimpleFallback -> do
- -- Simple mode: no line reservations
- let mgr = LineManager {lmNamespaces = nss, lmTermInfo = termInfo}
- writeIORef currentLineManager (Just mgr)
- result <- action mgr
- writeIORef currentLineManager Nothing
- writeIORef namespaceLines Map.empty
- pure result
SingleLine -> do
-- Single-line mode: no reservations, updates in place
let mgr = LineManager {lmNamespaces = nss, lmTermInfo = termInfo}
@@ -64,8 +56,8 @@ withLineManager nss action = do
writeIORef currentLineManager Nothing
writeIORef namespaceLines Map.empty
pure result
- RichMultiLine -> do
- -- Multi-line mode: reserve lines (existing behavior)
+ MultiLine -> do
+ -- Multi-line mode: reserve lines for each namespace
let numLines = min (length nss) (tiHeight termInfo - 2)
IO.hPutStrLn IO.stderr ""
replicateM_ numLines (IO.hPutStrLn IO.stderr "")
@@ -88,9 +80,8 @@ withLineManager nss action = do
initializeLines :: LineManager -> IO ()
initializeLines LineManager {..} =
case tiMode lmTermInfo of
- SimpleFallback -> pure () -- No initialization needed
SingleLine -> pure () -- No initialization needed
- RichMultiLine -> do
+ MultiLine -> do
nsMap <- readIORef namespaceLines
forM_ (Map.toList nsMap) <| \(ns, _) -> do
ANSI.hSetCursorColumn IO.stderr 0
@@ -110,15 +101,6 @@ updateLine ns output = do
IO.hFlush IO.stderr
Just LineManager {..} ->
case tiMode lmTermInfo of
- SimpleFallback -> do
- -- Simple: just print with newline
- let nsText = Text.pack (Namespace.toPath ns)
- let msg =
- if Text.null output
- then "[~] " <> nsText
- else "[~] " <> nsText <> ": " <> output
- IO.hPutStrLn IO.stderr (Text.unpack msg)
- IO.hFlush IO.stderr
SingleLine -> do
-- Single line: update in place
let nsText = Text.pack (Namespace.toPath ns)
@@ -136,7 +118,7 @@ updateLine ns output = do
IO.hPutStr IO.stderr "\r"
IO.hPutStr IO.stderr (Text.unpack truncated)
IO.hFlush IO.stderr
- RichMultiLine -> do
+ MultiLine -> do
-- Multi-line: use reserved lines with truncation
nsMap <- readIORef namespaceLines
case Map.lookup ns nsMap of
@@ -165,22 +147,6 @@ updateLineState ns buildState = do
Nothing -> pure ()
Just LineManager {..} ->
case tiMode lmTermInfo of
- SimpleFallback -> do
- -- Simple: print completion status
- let nsText = Text.pack (Namespace.toPath ns)
- let (symbol, color) = case buildState of
- Success -> ("✓", green)
- Failed -> ("x", red)
- _ -> ("~", white)
- let msg = "[" <> symbol <> "] " <> nsText
- case buildState of
- Success -> do
- Rainbow.hPutChunks IO.stderr [fore color <| chunk msg]
- IO.hPutStrLn IO.stderr ""
- Failed -> do
- Rainbow.hPutChunks IO.stderr [fore color <| chunk msg]
- IO.hPutStrLn IO.stderr ""
- _ -> pure ()
SingleLine -> do
-- Single line: show completion, keep visible for success/failure
let nsText = Text.pack (Namespace.toPath ns)
@@ -198,7 +164,7 @@ updateLineState ns buildState = do
Failed -> IO.hPutStrLn IO.stderr "" -- Keep failures visible
_ -> pure () -- Transient states overwrite
IO.hFlush IO.stderr
- RichMultiLine -> do
+ MultiLine -> do
-- Multi-line: use reserved lines with truncation
nsMap <- readIORef namespaceLines
case Map.lookup ns nsMap of
diff --git a/Omni/Log/Terminal.hs b/Omni/Log/Terminal.hs
index 1230eb3..6d5d70c 100644
--- a/Omni/Log/Terminal.hs
+++ b/Omni/Log/Terminal.hs
@@ -16,9 +16,8 @@ import qualified System.Console.ANSI as ANSI
import qualified System.Environment as Env
data OutputMode
- = RichMultiLine -- Wide terminals (≥80 cols)
- | SingleLine -- Narrow terminals (40-79 cols)
- | SimpleFallback -- Very narrow (<40) or dumb terminals
+ = MultiLine -- Wide terminals (≥80 cols) - reserved lines per namespace
+ | SingleLine -- Narrow terminals (<80 cols) - rotating single line
deriving (Eq, Show)
data TerminalInfo = TerminalInfo
@@ -33,7 +32,6 @@ detectTerminal :: IO TerminalInfo
detectTerminal = do
term <- Env.lookupEnv "TERM"
area <- Env.lookupEnv "AREA"
- modeOverride <- Env.lookupEnv "BILD_OUTPUT_MODE"
-- Check if we support ANSI
let supportsANSI = case (term, area) of
@@ -48,19 +46,11 @@ detectTerminal = do
Just (h, w) -> (w, h)
Nothing -> (80, 24) -- sensible default
- -- Determine mode
- let autoMode
- | not supportsANSI = SimpleFallback
- | width < 40 = SimpleFallback
+ -- Determine mode based on terminal width
+ let mode
+ | not supportsANSI = SingleLine -- Fallback to single line for dumb terminals
| width < 80 = SingleLine
- | otherwise = RichMultiLine
-
- -- Allow manual override
- let mode = case modeOverride of
- Just "simple" -> SimpleFallback
- Just "single" -> SingleLine
- Just "rich" -> RichMultiLine
- _ -> autoMode
+ | otherwise = MultiLine
pure
TerminalInfo
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-16 14:50:12 +0000