From 4c4dc3a991ffde0aa821f8669024787fb65635ba Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 14 Nov 2025 13:33:39 -0500
Subject: Create Omni/Log/Concurrent module for multi-line output

- Implement LineManager abstraction with IORef state - Line
reservation/update/release functions - ANSI cursor positioning for
concurrent updates - Terminal capability detection (ANSI vs dumb) -
Graceful fallback for non-ANSI terminals

Tasks: t-1a1DzES, t-1a1DGY0, t-1a1DOev, t-1a1DVM5
---
 Omni/Log/Concurrent.hs | 155 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 155 insertions(+)
 create mode 100644 Omni/Log/Concurrent.hs

(limited to 'Omni/Log/Concurrent.hs')

diff --git a/Omni/Log/Concurrent.hs b/Omni/Log/Concurrent.hs
new file mode 100644
index 0000000..2a46df5
--- /dev/null
+++ b/Omni/Log/Concurrent.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Concurrent logging with multi-line output support
+module Omni.Log.Concurrent
+  ( LineManager,
+    BuildState (..),
+    withLineManager,
+    reserveLine,
+    updateLine,
+    releaseLine,
+  )
+where
+
+import Alpha
+import Data.IORef (IORef, atomicModifyIORef', modifyIORef', newIORef, readIORef)
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import Omni.Namespace (Namespace)
+import qualified Omni.Namespace as Namespace
+import qualified System.Console.ANSI as ANSI
+import qualified System.Environment as Env
+import qualified System.IO as IO
+
+data BuildState = Building | Success | Failed
+  deriving (Eq, Show)
+
+data BuildStatus = BuildStatus
+  { bsTarget :: Namespace,
+    bsLastOutput :: Text,
+    bsState :: BuildState
+  }
+
+data LineManager = LineManager
+  { lmLines :: IORef (Map Int (Maybe BuildStatus)),
+    lmMaxLines :: Int,
+    lmCurrentLine :: IORef Int,
+    lmSupportsANSI :: Bool
+  }
+
+withLineManager :: Int -> (LineManager -> IO a) -> IO a
+withLineManager maxLines action = do
+  supportsANSI <- checkANSISupport
+
+  if not supportsANSI
+    then do
+      linesRef <- newIORef Map.empty
+      currentRef <- newIORef 0
+      action
+        LineManager
+          { lmLines = linesRef,
+            lmMaxLines = 1,
+            lmCurrentLine = currentRef,
+            lmSupportsANSI = False
+          }
+    else do
+      replicateM_ maxLines (IO.hPutStrLn IO.stderr "")
+      ANSI.hCursorUp IO.stderr maxLines
+
+      linesRef <- newIORef (Map.fromList [(i, Nothing) | i <- [0 .. maxLines - 1]])
+      currentRef <- newIORef maxLines
+
+      result <-
+        action
+          LineManager
+            { lmLines = linesRef,
+              lmMaxLines = maxLines,
+              lmCurrentLine = currentRef,
+              lmSupportsANSI = True
+            }
+
+      ANSI.hCursorDown IO.stderr maxLines
+      pure result
+
+checkANSISupport :: IO Bool
+checkANSISupport = do
+  term <- Env.lookupEnv "TERM"
+  area <- Env.lookupEnv "AREA"
+  pure <| case (term, area) of
+    (Just "dumb", _) -> False
+    (_, Just "Live") -> False
+    (Nothing, _) -> False
+    _ -> True
+
+reserveLine :: LineManager -> Namespace -> IO (Maybe Int)
+reserveLine LineManager {..} ns =
+  if not lmSupportsANSI
+    then pure Nothing
+    else
+      atomicModifyIORef' lmLines <| \lines ->
+        case findFirstFree lines of
+          Nothing -> (lines, Nothing)
+          Just lineNum ->
+            let status = BuildStatus ns "" Building
+                lines' = Map.insert lineNum (Just status) lines
+             in (lines', Just lineNum)
+  where
+    findFirstFree :: Map Int (Maybe BuildStatus) -> Maybe Int
+    findFirstFree m =
+      Map.toList m
+        |> filter (\(_, mbs) -> isNothing mbs)
+        |> map fst
+        |> listToMaybe
+
+updateLine :: LineManager -> Maybe Int -> Namespace -> Text -> IO ()
+updateLine LineManager {..} mLineNum ns output =
+  if not lmSupportsANSI
+    then do
+      IO.hPutStr IO.stderr (Text.unpack <| output <> "\n")
+      IO.hFlush IO.stderr
+    else case mLineNum of
+      Nothing -> pure ()
+      Just lineNum -> do
+        currentLine <- readIORef lmCurrentLine
+
+        ANSI.hSaveCursor IO.stderr
+        ANSI.hSetCursorColumn IO.stderr 0
+
+        let linesToMove = currentLine - lineNum
+        when (linesToMove > 0) <| ANSI.hCursorUp IO.stderr linesToMove
+        when (linesToMove < 0) <| ANSI.hCursorDown IO.stderr (abs linesToMove)
+
+        ANSI.hClearLine IO.stderr
+        IO.hPutStr IO.stderr (Text.unpack output)
+        IO.hFlush IO.stderr
+
+        ANSI.hRestoreCursor IO.stderr
+
+        modifyIORef' lmLines <| \lines ->
+          Map.adjust (fmap (\bs -> bs {bsLastOutput = output})) lineNum lines
+
+releaseLine :: LineManager -> Maybe Int -> BuildState -> IO ()
+releaseLine LineManager {..} mLineNum state =
+  case mLineNum of
+    Nothing -> pure ()
+    Just lineNum -> do
+      modifyIORef' lmLines <| \lines ->
+        Map.insert lineNum Nothing lines
+
+      when lmSupportsANSI <| do
+        current <- readIORef lmCurrentLine
+        ANSI.hSaveCursor IO.stderr
+        ANSI.hSetCursorColumn IO.stderr 0
+        ANSI.hCursorUp IO.stderr (current - lineNum)
+        ANSI.hClearLine IO.stderr
+
+        let statusChar = case state of
+              Success -> "✓"
+              Failed -> "✗"
+              Building -> "…"
+        IO.hPutStr IO.stderr statusChar
+        IO.hFlush IO.stderr
+
+        ANSI.hRestoreCursor IO.stderr
-- 
cgit v1.2.3