summaryrefslogtreecommitdiff
path: root/Omni/Bild.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Bild.hs')
-rw-r--r--Omni/Bild.hs116
1 files changed, 91 insertions, 25 deletions
diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index b4da154..73141e4 100644
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -151,16 +151,26 @@ import Omni.Namespace (Namespace (..))
import qualified Omni.Namespace as Namespace
import Omni.Test ((@=?))
import qualified Omni.Test as Test
+import Rainbow (chunk, fore, red)
+import qualified Rainbow
import qualified System.Directory as Dir
import qualified System.Environment as Env
import qualified System.Exit as Exit
-import System.FilePath (dropExtension, replaceExtension, takeDirectory, (</>))
+import System.FilePath (dropExtension, replaceExtension, takeDirectory, (<.>), (</>))
import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Process as Process
import qualified System.Timeout as Timeout
import qualified Text.Regex.Applicative as Regex
+-- | Tee conduit: write to both log file and downstream
+teeLog :: Maybe IO.Handle -> Conduit.ConduitT ByteString ByteString (Conduit.ResourceT IO) ()
+teeLog Nothing = Conduit.awaitForever Conduit.yield
+teeLog (Just h) =
+ Conduit.awaitForever <| \bs -> do
+ liftIO (writeBuildLog (Just h) bs)
+ Conduit.yield bs
+
mapConcurrentlyBounded :: Int -> (a -> IO b) -> [a] -> IO [b]
mapConcurrentlyBounded n f xs = do
sem <- QSemN.newQSemN n
@@ -572,11 +582,53 @@ outname = \case
Just o -> o
Nothing -> mempty
-bindir, intdir, nixdir, vardir :: FilePath
+bindir, intdir, nixdir, vardir, logdir :: FilePath
bindir = cab </> "bin"
intdir = cab </> "int"
nixdir = cab </> "nix"
vardir = cab </> "var"
+logdir = cab </> "var" </> "bild-logs"
+
+-- | Get log file path for a namespace
+logPathForNs :: Namespace -> FilePath
+logPathForNs ns = logdir </> Namespace.toPath ns <.> "log"
+
+-- | Clear log file at the start of a build
+clearBuildLog :: Namespace -> IO ()
+clearBuildLog ns = do
+ root <- getCoderoot
+ let path = root </> logPathForNs ns
+ Dir.createDirectoryIfMissing True (takeDirectory path)
+ writeFile path ""
+
+-- | Open a log file for appending, creating directories as needed
+openBuildLog :: Namespace -> IO (Maybe IO.Handle)
+openBuildLog ns = do
+ root <- getCoderoot
+ let path = root </> logPathForNs ns
+ Dir.createDirectoryIfMissing True (takeDirectory path)
+ h <- IO.openFile path IO.AppendMode
+ IO.hSetBuffering h IO.LineBuffering
+ pure (Just h)
+
+-- | Write to build log (if handle exists)
+writeBuildLog :: Maybe IO.Handle -> ByteString -> IO ()
+writeBuildLog Nothing _ = pure ()
+writeBuildLog (Just h) bs = ByteString.hPutStr h bs >> IO.hFlush h
+
+-- | Close build log
+closeBuildLog :: Maybe IO.Handle -> IO ()
+closeBuildLog Nothing = pure ()
+closeBuildLog (Just h) = IO.hClose h
+
+-- | Show where to find the build log
+showLogPath :: Namespace -> IO ()
+showLogPath ns = do
+ root <- getCoderoot
+ let path = root </> logPathForNs ns
+ Rainbow.hPutChunks IO.stderr [fore red <| chunk <| " see " <> Text.pack path]
+ IO.hPutStrLn IO.stderr ""
+ IO.hFlush IO.stderr
-- | Emulate the *nix hierarchy in the cabdir.
createHier :: String -> IO ()
@@ -586,7 +638,8 @@ createHier root =
[ root </> (outToPath <| Just ""),
root </> intdir,
root </> nixdir,
- root </> vardir
+ root </> vardir,
+ root </> logdir
]
-- >>> removeVersion "array-0.5.4.0-DFLKGIjfsadi"
@@ -1167,8 +1220,8 @@ test loud Target {..} =
cmd = root </> outToPath out,
args = ["test"],
ns = namespace,
- onFailure = loud ?: (Log.fail ["test", nschunk namespace] >> Log.br, LogC.updateLineState namespace LogC.Failed),
- onSuccess = loud ?: (Log.pass ["test", nschunk namespace] >> Log.br, LogC.updateLineState namespace LogC.Success)
+ onFailure = loud ?: (pure (), LogC.updateLineState namespace LogC.Failed),
+ onSuccess = loud ?: (pure (), LogC.updateLineState namespace LogC.Success)
}
|> run
CPython ->
@@ -1177,8 +1230,8 @@ test loud Target {..} =
cmd = root </> outToPath out,
args = ["test"],
ns = namespace,
- onFailure = loud ?: (Log.fail ["test", nschunk namespace] >> Log.br, LogC.updateLineState namespace LogC.Failed),
- onSuccess = loud ?: (Log.pass ["test", nschunk namespace] >> Log.br, LogC.updateLineState namespace LogC.Success)
+ onFailure = loud ?: (pure (), LogC.updateLineState namespace LogC.Failed),
+ onSuccess = loud ?: (pure (), LogC.updateLineState namespace LogC.Success)
}
|> run
_ ->
@@ -1384,6 +1437,8 @@ promoteWaiters Coordinator {..} completedNs = do
pipelineBuildOne :: Bool -> Bool -> Bool -> Int -> Int -> Target -> IO Exit.ExitCode
pipelineBuildOne andTest loud andCache jobs cpus target@Target {..} = do
root <- getCoderoot
+ -- Clear log file at the start of each build
+ unless loud (clearBuildLog namespace)
result <- case compiler of
CPython -> case out of
Just _ ->
@@ -1441,10 +1496,10 @@ cacheStorePath :: Bool -> Namespace -> FilePath -> IO ()
cacheStorePath loud ns storePath = do
mKeyPath <- Env.lookupEnv "NIX_CACHE_KEY"
case mKeyPath of
- Nothing -> Log.warn ["cache", "NIX_CACHE_KEY not set, skipping"]
+ Nothing -> loud ?| Log.warn ["cache", "NIX_CACHE_KEY not set, skipping"]
Just keyPath -> do
let s3Url = "s3://omni-nix-cache?profile=digitalocean&scheme=https&endpoint=nyc3.digitaloceanspaces.com"
- LogC.updateLine ns "signing..."
+ loud ?: (pure (), LogC.updateLine ns "signing...")
(signExit, _, signErr) <-
Process.readProcessWithExitCode
"nix"
@@ -1452,7 +1507,7 @@ cacheStorePath loud ns storePath = do
""
case signExit of
Exit.ExitSuccess -> do
- LogC.updateLine ns "pushing to cache..."
+ loud ?: (pure (), LogC.updateLine ns "pushing to cache...")
(pushExit, _, pushErr) <-
Process.readProcessWithExitCode
"nix"
@@ -1460,14 +1515,14 @@ cacheStorePath loud ns storePath = do
""
case pushExit of
Exit.ExitSuccess -> do
- loud ?| Log.good ["cache", "pushed", Text.pack storePath]
- Text.IO.putStrLn <| "STORE_PATH=" <> Text.pack storePath
+ -- Only print STORE_PATH in loud mode to avoid interfering with line manager
+ loud ?: (Text.IO.putStrLn <| "STORE_PATH=" <> Text.pack storePath, pure ())
Exit.ExitFailure _ -> do
- Log.fail ["cache", "push failed", Text.pack storePath]
- loud ?| putStrLn pushErr
+ -- Write error to log file, show path in normal mode
+ loud ?: (Log.fail ["cache", "push failed", Text.pack storePath] >> putStrLn pushErr, showLogPath ns)
Exit.ExitFailure _ -> do
- Log.fail ["cache", "sign failed", Text.pack storePath]
- loud ?| putStrLn signErr
+ -- Write error to log file, show path in normal mode
+ loud ?: (Log.fail ["cache", "sign failed", Text.pack storePath] >> putStrLn signErr, showLogPath ns)
pipelineBuild :: Bool -> Bool -> Bool -> Int -> Int -> Int -> [Namespace] -> (Namespace -> IO (Maybe Target)) -> IO [Exit.ExitCode]
pipelineBuild andTest loud andCache analysisWorkers buildWorkers cpus namespaces analyzeFn = do
@@ -1505,24 +1560,35 @@ run :: Proc -> IO (Exit.ExitCode, ByteString)
run Proc {..} = do
IO.hSetBuffering stdout IO.NoBuffering
loud ?| Log.info ["proc", unwords <| map str <| cmd : args]
+
+ -- Open log file for this build (skip if loud mode)
+ logHandle <- if loud then pure Nothing else openBuildLog ns
+
Conduit.proc cmd args
|> (\proc_ -> proc_ {Process.create_group = True})
|> Conduit.streamingProcess
+> \(stdin_, stdout_, stderr_, hdl) -> do
IO.hClose stdin_ -- Close stdin immediately since we don't use it
+
+ -- Insert teeLog to write to file while streaming
+ let stdoutWithLog = stdout_ .| teeLog logHandle
+ let stderrWithLog = stderr_ .| teeLog logHandle
+
(,,)
</ Async.Concurrently (Conduit.waitForStreamingProcess hdl)
- <*> Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_))
- <*> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_))
+ <*> Async.Concurrently (loud ?: (puts stdoutWithLog, logs ns stdoutWithLog))
+ <*> Async.Concurrently (loud ?: (puts stderrWithLog, logs ns stderrWithLog))
|> Async.runConcurrently
+> \case
(Exit.ExitFailure n, output, outerr) ->
- Conduit.closeStreamingProcessHandle hdl
- >> putStr outerr
+ closeBuildLog logHandle
+ >> Conduit.closeStreamingProcessHandle hdl
+ >> (loud ?: (putStr outerr, showLogPath ns))
>> onFailure
>> pure (Exit.ExitFailure n, output)
(Exit.ExitSuccess, output, _) ->
- Conduit.closeStreamingProcessHandle hdl
+ closeBuildLog logHandle
+ >> Conduit.closeStreamingProcessHandle hdl
>> onSuccess
>> pure (Exit.ExitSuccess, output)
@@ -1539,7 +1605,7 @@ proc loud namespace cmd args =
ns = namespace,
cmd = cmd,
args = map Text.unpack args,
- onFailure = Log.fail ["bild", nschunk namespace] >> Log.br,
+ onFailure = pure (), -- Let run() handle failure display
onSuccess = pure ()
}
|> run
@@ -1639,7 +1705,7 @@ nixBuild loud maxJobs cores target@(Target {..}) =
]
|> mconcat
|> map Text.unpack,
- onFailure = Log.fail ["bild", "instantiate", nschunk namespace] >> Log.br,
+ onFailure = pure (), -- Let run() handle failure display
onSuccess = pure ()
}
realise drv =
@@ -1657,7 +1723,7 @@ nixBuild loud maxJobs cores target@(Target {..}) =
"--cores",
str cores
],
- onFailure = Log.fail ["bild", "realise", nschunk namespace] >> Log.br,
+ onFailure = pure (), -- Let run() handle failure display
onSuccess = pure ()
}
symlink =
@@ -1672,7 +1738,7 @@ nixBuild loud maxJobs cores target@(Target {..}) =
nixdir </> outname out </> "bin" </> outname out,
bindir </> outname out
],
- onFailure = Log.fail ["bild", "symlink", nschunk namespace] >> Log.br,
+ onFailure = pure (), -- Let run() handle failure display
onSuccess = pure ()
}
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-30 11:25:55 +0000