summaryrefslogtreecommitdiff
path: root/Omni
diff options
context:
space:
mode:
Diffstat (limited to 'Omni')
-rwxr-xr-xOmni/Bild.hs16
-rw-r--r--Omni/Log/Concurrent.hs22
2 files changed, 22 insertions, 16 deletions
diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index 414049b..aa79877 100755
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -142,6 +142,7 @@ import qualified Network.HostName as HostName
import qualified Omni.Bild.Meta as Meta
import qualified Omni.Cli as Cli
import qualified Omni.Log as Log
+import qualified Omni.Log.Concurrent as LogC
import Omni.Namespace (Namespace (..))
import qualified Omni.Namespace as Namespace
import Omni.Test ((@=?))
@@ -954,12 +955,15 @@ build :: Bool -> Bool -> Int -> Int -> Analysis -> IO [Exit.ExitCode]
build andTest loud jobs cpus analysis = do
root <- Env.getEnv "CODEROOT"
let targets = Map.elems analysis
- results <- mapConcurrentlyBounded jobs (buildTarget root) targets
- pure (map fst results)
+ LogC.withLineManager jobs <| \lineMgr -> do
+ results <- mapConcurrentlyBounded jobs (buildTarget lineMgr root) targets
+ pure (map fst results)
where
- buildTarget :: FilePath -> Target -> IO (Exit.ExitCode, ByteString)
- buildTarget root target@Target {..} =
- case compiler of
+ buildTarget :: LogC.LineManager -> FilePath -> Target -> IO (Exit.ExitCode, ByteString)
+ buildTarget lineMgr root target@Target {..} = do
+ mLineNum <- LogC.reserveLine lineMgr namespace
+ let doRelease = LogC.releaseLine lineMgr mLineNum
+ result <- case compiler of
CPython -> case out of
Just _ ->
Log.info ["bild", "nix", "python", nschunk namespace]
@@ -1016,6 +1020,8 @@ build andTest loud jobs cpus analysis = do
Sbcl ->
Log.info ["bild", "dev", "lisp", nschunk namespace]
>> proc loud namespace (toNixFlag compiler) compilerFlags
+ doRelease (isSuccess (fst result) ?: (LogC.Success, LogC.Failed))
+ pure result
data Proc = Proc
{ loud :: Bool,
diff --git a/Omni/Log/Concurrent.hs b/Omni/Log/Concurrent.hs
index 2a46df5..5187367 100644
--- a/Omni/Log/Concurrent.hs
+++ b/Omni/Log/Concurrent.hs
@@ -88,13 +88,13 @@ reserveLine LineManager {..} ns =
if not lmSupportsANSI
then pure Nothing
else
- atomicModifyIORef' lmLines <| \lines ->
- case findFirstFree lines of
- Nothing -> (lines, Nothing)
+ atomicModifyIORef' lmLines <| \linesMap ->
+ case findFirstFree linesMap of
+ Nothing -> (linesMap, Nothing)
Just lineNum ->
let status = BuildStatus ns "" Building
- lines' = Map.insert lineNum (Just status) lines
- in (lines', Just lineNum)
+ linesMap' = Map.insert lineNum (Just status) linesMap
+ in (linesMap', Just lineNum)
where
findFirstFree :: Map Int (Maybe BuildStatus) -> Maybe Int
findFirstFree m =
@@ -127,16 +127,16 @@ updateLine LineManager {..} mLineNum ns output =
ANSI.hRestoreCursor IO.stderr
- modifyIORef' lmLines <| \lines ->
- Map.adjust (fmap (\bs -> bs {bsLastOutput = output})) lineNum lines
+ modifyIORef' lmLines <| \linesMap ->
+ Map.adjust (fmap (\bs -> bs {bsLastOutput = output})) lineNum linesMap
releaseLine :: LineManager -> Maybe Int -> BuildState -> IO ()
-releaseLine LineManager {..} mLineNum state =
+releaseLine LineManager {..} mLineNum buildState =
case mLineNum of
Nothing -> pure ()
Just lineNum -> do
- modifyIORef' lmLines <| \lines ->
- Map.insert lineNum Nothing lines
+ modifyIORef' lmLines <| \linesMap ->
+ Map.insert lineNum Nothing linesMap
when lmSupportsANSI <| do
current <- readIORef lmCurrentLine
@@ -145,7 +145,7 @@ releaseLine LineManager {..} mLineNum state =
ANSI.hCursorUp IO.stderr (current - lineNum)
ANSI.hClearLine IO.stderr
- let statusChar = case state of
+ let statusChar = case buildState of
Success -> "✓"
Failed -> "✗"
Building -> "…"