diff options
Diffstat (limited to 'Omni')
| -rw-r--r-- | Omni/Bild.hs | 22 | ||||
| -rw-r--r-- | Omni/Bild.nix | 1 | ||||
| -rw-r--r-- | Omni/Log/Concurrent.hs | 44 | ||||
| -rw-r--r-- | Omni/Log/Terminal.hs | 22 |
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 |
