From bffdc005275bf74cde864dabcfafec497dcf0013 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 14 Nov 2025 17:01:21 -0500
Subject: Implement concurrent analysis with [+] state indicator
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

- Add Analyzing state to BuildState enum - Refactor from sequential
foldM analyze to concurrent analyzeAll - Initialize all lines with
[+] during analysis phase - Update to [...] (Pending) after each
analysis completes - Uses mapConcurrentlyBounded with concurrency of
8 for analysis - Remove Log.info from analyzeOne (now handled by line
state) - Analysis now runs in parallel, improving efficiency - Flow:
[+] analyzing → [...] pending → [~] building → [✓]/[x] complete
---
 Omni/Bild.hs | 50 ++++++++++++++++++++++++++------------------------
 1 file changed, 26 insertions(+), 24 deletions(-)

(limited to 'Omni/Bild.hs')

diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index 90f6cd6..96ea9e9 100755
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -187,7 +187,7 @@ test_bildBild =
     case Namespace.fromPath root path of
       Nothing -> Test.assertFailure "can't find ns for bild"
       Just ns ->
-        analyze mempty ns
+        analyzeAll [ns]
           +> build False False 1 2
           +> \case
             [Exit.ExitFailure _] ->
@@ -204,7 +204,7 @@ test_bildExamples =
         |> traverse Dir.makeAbsolute
         /> map (Namespace.fromPath root)
         /> catMaybes
-        +> foldM analyze mempty
+        +> analyzeAll
         +> build False False 4 1
         +> \case
           [] -> Test.assertFailure "asdf"
@@ -214,15 +214,16 @@ move :: Cli.Arguments -> IO ()
 move args = do
   IO.hSetBuffering stdout IO.NoBuffering
   root <- Env.getEnv "CODEROOT"
-  Cli.getAllArgs args (Cli.argument "target")
-    |> filterM Dir.doesFileExist
-    +> filterGitIgnored
-    /> filter (\x -> isGitHook x |> don't)
-    +> traverse Dir.makeAbsolute
-    +> traverse (namespaceFromPathOrDie root)
-    /> filter isBuildableNs
-    +> foldM analyze mempty
-    +> printOrBuild root
+  namespaces <-
+    Cli.getAllArgs args (Cli.argument "target")
+      |> filterM Dir.doesFileExist
+      +> filterGitIgnored
+      /> filter (\x -> isGitHook x |> don't)
+      +> traverse Dir.makeAbsolute
+      +> traverse (namespaceFromPathOrDie root)
+      /> filter isBuildableNs
+  analysis <- analyzeAll namespaces
+  printOrBuild root analysis
     |> Timeout.timeout (toMillis minutes)
     +> \case
       Nothing ->
@@ -439,7 +440,7 @@ dev_getTarget fp = do
     |> \case
       Nothing -> panic "Could not get namespace from path"
       Just ns ->
-        analyze mempty ns
+        analyzeAll [ns]
           /> Map.lookup ns
           /> \case
             Nothing -> panic "Could not retrieve target from analysis"
@@ -527,22 +528,21 @@ removeVersion = takeWhile (/= '.') .> butlast2
 
 type Analysis = Map Namespace Target
 
-analyze :: Analysis -> Namespace -> IO Analysis
-analyze hmap ns = case Map.lookup ns hmap of
-  Nothing -> do
-    mTarget <- analyzeOne ns
-    pure <| maybe hmap (\t -> Map.insert ns t hmap) mTarget
-  Just _ -> pure hmap
+analyzeAll :: [Namespace] -> IO Analysis
+analyzeAll nss = do
+  LogC.withLineManager nss <| \lineMgr -> do
+    LogC.initializeLines lineMgr
+    targets <- mapConcurrentlyBounded 8 (analyzeOne lineMgr) nss
+    pure <| Map.fromList <| catMaybes <| zipWith (\ns mt -> (ns,) </ mt) nss targets
   where
-    analyzeOne :: Namespace -> IO (Maybe Target)
-    analyzeOne namespace@(Namespace parts ext) = do
+    analyzeOne :: LogC.LineManager -> Namespace -> IO (Maybe Target)
+    analyzeOne _lineMgr namespace@(Namespace parts ext) = do
       let path = Namespace.toPath namespace
       root <- Env.getEnv "CODEROOT"
       let abspath = root </> path
       let quapath = path
       user <- Env.getEnv "USER" /> Text.pack
       host <- HostName.getHostName /> Text.pack
-      Log.wipe >> Log.info ["+", nschunk namespace]
       contentLines <-
         withFile abspath ReadMode <| \h ->
           IO.hSetEncoding h IO.utf8_bom
@@ -552,7 +552,7 @@ analyze hmap ns = case Map.lookup ns hmap of
       -- dot-separated namespace instead
       isExe <- Dir.getPermissions quapath /> Dir.executable
       let defaultOut = isExe ?: (Just <| Namespace.dotSeparated parts, Nothing)
-      case ext of
+      result <- case ext of
         -- basically we don't support building these
         Namespace.Css -> pure Nothing
         Namespace.Json -> pure Nothing
@@ -565,7 +565,7 @@ analyze hmap ns = case Map.lookup ns hmap of
           contentLines
             |> Meta.detectAll "#"
             |> \Meta.Parsed {..} ->
-              detectPythonImports hmap contentLines +> \srcs ->
+              detectPythonImports mempty contentLines +> \srcs ->
                 Target
                   { builder = "python",
                     wrapper = Nothing,
@@ -620,7 +620,7 @@ analyze hmap ns = case Map.lookup ns hmap of
           contentLines
             |> Meta.detectAll "--"
             |> \Meta.Parsed {..} ->
-              detectHaskellImports hmap contentLines +> \(langdeps, srcs) ->
+              detectHaskellImports mempty contentLines +> \(langdeps, srcs) ->
                 Target
                   { builder = "haskell",
                     wrapper = Nothing,
@@ -789,6 +789,8 @@ analyze hmap ns = case Map.lookup ns hmap of
               }
               |> Just
               |> pure
+      LogC.updateLineState namespace LogC.Pending
+      pure result
 
 detectHaskellImports :: Analysis -> [Text] -> IO (Set Meta.Dep, Set FilePath)
 detectHaskellImports _ contentLines = do
-- 
cgit v1.2.3