diff --git a/ChangeLog.md b/ChangeLog.md index 09bf960ddf..d009859c52 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -25,6 +25,10 @@ Other enhancements: [#4068](https://github.com/commercialhaskell/stack/pull/4068). * Added new `--tar-dir` option to `stack sdist`, that allows to copy the resulting tarball to the specified directory. +* Introduced the `--interleaved-output` command line option and + `build.interleaved-output` config value which causes multiple concurrent + builds to dump to stderr at the same time with a `packagename> ` prefix. See + [#3225](https://github.com/commercialhaskell/stack/issues/3225). Bug fixes: diff --git a/doc/build_command.md b/doc/build_command.md index fd671af1da..e27384e02d 100644 --- a/doc/build_command.md +++ b/doc/build_command.md @@ -194,3 +194,9 @@ end up in a log file instead of on the console unless it contains errors or warnings, to avoid problems of interleaved output and decrease console noise. If you would like to see this content instead, you can use the `--dump-logs` command line option, or add `dump-logs: all` to your `stack.yaml` file. + +Alternatively, starting with Stack 1.8, you can pass `--interleaved-output` to +see output of all packages being built scroll by in a streaming fashion. The +output from each package built will be prefixed by the package name, e.g. `mtl> +Building ...`. Note that, unlike the default output, this will include the +output from dependencies being built, not just targets. diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md index 461406ae52..a34c871e80 100644 --- a/doc/yaml_configuration.md +++ b/doc/yaml_configuration.md @@ -787,6 +787,9 @@ build: reconfigure: false cabal-verbose: false split-objs: false + + # Since 1.8 + interleaved-output: false ``` The meanings of these settings correspond directly with the CLI flags of the diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 499c4ebc75..c66ffb5101 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -11,6 +11,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} -- | Perform a build module Stack.Build.Execute ( printPlan @@ -875,6 +876,12 @@ announceTask task x = logInfo $ ": " <> RIO.display x +-- | How we deal with output from GHC, either dumping to a log file or the +-- console (with some prefix). +data OutputType + = OTLogFile !(Path Abs File) !Handle + | OTConsole !Utf8Builder + -- | This sets up a context for executing build steps which need to run -- Cabal (via a compiled Setup.hs). In particular it does the following: -- @@ -901,15 +908,14 @@ withSingleContext :: forall env a. HasEnvConfig env -> (ExcludeTHLoading -> [String] -> RIO env ()) -- Function to run Cabal with args -> (Text -> RIO env ()) -- An 'announce' function, for different build phases - -> Bool -- Whether output should be directed to the console - -> Maybe (Path Abs File, Handle) -- Log file + -> OutputType -> RIO env a) -> RIO env a withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffix inner0 = withPackage $ \package cabalfp pkgDir -> - withLogFile pkgDir package $ \mlogFile -> - withCabal package pkgDir mlogFile $ \cabal -> - inner0 package cabalfp pkgDir cabal announce console mlogFile + withOutputType pkgDir package $ \outputType -> + withCabal package pkgDir outputType $ \cabal -> + inner0 package cabalfp pkgDir cabal announce outputType where announce = announceTask task @@ -944,8 +950,16 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi let cabalfp = dir cabalfpRel inner package cabalfp dir - withLogFile pkgDir package inner - | console = inner Nothing + withOutputType pkgDir package inner + -- If the user requested interleaved output, dump to the console with a + -- prefix. + | boptsInterleavedOutput eeBuildOpts = inner $ OTConsole $ RIO.display (packageName package) <> "> " + + -- Not in interleaved mode. When building a single wanted package, dump + -- to the console with no prefix. + | console = inner $ OTConsole mempty + + -- Neither condition applies, dump to a file. | otherwise = do logPath <- buildLogPath package msuffix ensureDir (parent logPath) @@ -957,15 +971,15 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi liftIO $ atomically $ writeTChan eeLogFiles (pkgDir, logPath) _ -> return () - withBinaryFile fp WriteMode $ \h -> inner (Just (logPath, h)) + withBinaryFile fp WriteMode $ \h -> inner $ OTLogFile logPath h withCabal :: Package -> Path Abs Dir - -> Maybe (Path Abs File, Handle) + -> OutputType -> ((ExcludeTHLoading -> [String] -> RIO env ()) -> RIO env a) -> RIO env a - withCabal package pkgDir mlogFile inner = do + withCabal package pkgDir outputType inner = do config <- view configL unless (configAllowDifferentUser config) $ @@ -1108,12 +1122,12 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi runExe exeName fullArgs = do compilerVer <- view actualCompilerVersionL runAndOutput compilerVer `catch` \ece -> do - bss <- - case mlogFile of - Nothing -> return [] - Just (logFile, h) -> do + (mlogFile, bss) <- + case outputType of + OTConsole _ -> return (Nothing, []) + OTLogFile logFile h -> do liftIO $ hClose h - withSourceFile (toFilePath logFile) $ \src -> + fmap (Just logFile,) $ withSourceFile (toFilePath logFile) $ \src -> runConduit $ src .| CT.decodeUtf8Lenient @@ -1124,31 +1138,32 @@ withSingleContext ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffi (Just taskProvides) exeName fullArgs - (fmap fst mlogFile) + mlogFile bss where runAndOutput :: CompilerVersion 'CVActual -> RIO env () - runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case mlogFile of - Just (_, h) -> + runAndOutput compilerVer = withWorkingDir (toFilePath pkgDir) $ withProcessContext menv $ case outputType of + OTLogFile _ h -> proc (toFilePath exeName) fullArgs $ runProcess_ . setStdin (byteStringInput "") . setStdout (useHandleOpen h) . setStderr (useHandleOpen h) - Nothing -> + OTConsole prefix -> void $ sinkProcessStderrStdout (toFilePath exeName) fullArgs - (outputSink KeepTHLoading LevelWarn compilerVer) - (outputSink stripTHLoading LevelInfo compilerVer) + (outputSink KeepTHLoading LevelWarn compilerVer prefix) + (outputSink stripTHLoading LevelInfo compilerVer prefix) outputSink :: HasCallStack => ExcludeTHLoading -> LogLevel -> CompilerVersion 'CVActual + -> Utf8Builder -> ConduitM S.ByteString Void (RIO env) () - outputSink excludeTH level compilerVer = + outputSink excludeTH level compilerVer prefix = CT.decodeUtf8Lenient .| mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer - .| CL.mapM_ (logGeneric "" level . RIO.display) + .| CL.mapM_ (logGeneric "" level . (prefix <>) . RIO.display) -- If users want control, we should add a config option for this makeAbsolute :: ConvertPathsToAbsolute makeAbsolute = case stripTHLoading of @@ -1347,7 +1362,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap bindir = toFilePath $ bcoSnapInstallRoot eeBaseConfigOpts bindirSuffix realConfigAndBuild cache allDepsMap = withSingleContext ac ee task (Just allDepsMap) Nothing - $ \package cabalfp pkgDir cabal announce _console _mlogFile -> do + $ \package cabalfp pkgDir cabal announce _outputType -> do executableBuildStatuses <- getExecutableBuildStatuses package pkgDir when (not (cabalIsSatisfied executableBuildStatuses) && taskIsTarget task) (logInfo @@ -1627,7 +1642,7 @@ singleTest topts testsToRun ac ee task installedMap = do -- FIXME: Since this doesn't use cabal, we should be able to avoid using a -- fullblown 'withSingleContext'. (allDepsMap, _cache) <- getConfigCache ee task installedMap True False - withSingleContext ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce _console mlogFile -> do + withSingleContext ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do config <- view configL let needHpc = toCoverage topts @@ -1697,15 +1712,17 @@ singleTest topts testsToRun ac ee task installedMap = do -- Clear "Progress: ..." message before -- redirecting output. - when (isNothing mlogFile) $ do + case outputType of + OTConsole _ -> do logStickyDone "" liftIO $ hFlush stdout liftIO $ hFlush stderr + OTLogFile _ _ -> pure () let output setter = - case mlogFile of - Nothing -> id - Just (_, h) -> setter (useHandleOpen h) + case outputType of + OTConsole _ -> id + OTLogFile _ h -> setter (useHandleOpen h) ec <- withWorkingDir (toFilePath pkgDir) $ proc (toFilePath exePath) args $ \pc0 -> do @@ -1721,7 +1738,9 @@ singleTest topts testsToRun ac ee task installedMap = do waitExitCode p -- Add a trailing newline, incase the test -- output didn't finish with a newline. - when (isNothing mlogFile) (logInfo "") + case outputType of + OTConsole _ -> logInfo "" + OTLogFile _ _ -> pure () -- Move the .tix file out of the package -- directory into the hpc work dir, for -- tidiness. @@ -1752,16 +1771,18 @@ singleTest topts testsToRun ac ee task installedMap = do generateHpcReport pkgDir package testsToRun' bs <- liftIO $ - case mlogFile of - Nothing -> return "" - Just (logFile, h) -> do + case outputType of + OTConsole _ -> return "" + OTLogFile logFile h -> do hClose h S.readFile $ toFilePath logFile unless (Map.null errs) $ throwM $ TestSuiteFailure (taskProvides task) errs - (fmap fst mlogFile) + (case outputType of + OTLogFile fp _ -> Just fp + OTConsole _ -> Nothing) bs setTestSuccess pkgDir @@ -1777,7 +1798,7 @@ singleBench :: HasEnvConfig env -> RIO env () singleBench beopts benchesToRun ac ee task installedMap = do (allDepsMap, _cache) <- getConfigCache ee task installedMap False True - withSingleContext ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _console _mlogFile -> do + withSingleContext ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do let args = map T.unpack benchesToRun <> maybe [] ((:[]) . ("--benchmark-options=" <>)) (beoAdditionalArgs beopts) diff --git a/src/Stack/Config/Build.hs b/src/Stack/Config/Build.hs index 5b3a23e94e..fb5d0a6f21 100644 --- a/src/Stack/Config/Build.hs +++ b/src/Stack/Config/Build.hs @@ -72,6 +72,9 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts (boptsSplitObjs defaultBuildOpts) buildMonoidSplitObjs , boptsSkipComponents = buildMonoidSkipComponents + , boptsInterleavedOutput = fromFirst + (boptsInterleavedOutput defaultBuildOpts) + buildMonoidInterleavedOutput } where -- These options are not directly used in bopts, instead they diff --git a/src/Stack/Options/BuildMonoidParser.hs b/src/Stack/Options/BuildMonoidParser.hs index f8047e9bd7..c89be1df6e 100644 --- a/src/Stack/Options/BuildMonoidParser.hs +++ b/src/Stack/Options/BuildMonoidParser.hs @@ -21,7 +21,8 @@ buildOptsMonoidParser hide0 = haddockHyperlinkSource <*> copyBins <*> copyCompilerTool <*> preFetch <*> keepGoing <*> keepTmpFiles <*> forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*> - benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents + benchOptsParser hideBool <*> reconfigure <*> cabalVerbose <*> splitObjs <*> skipComponents <*> + interleavedOutput where hideBool = hide0 /= BuildCmdGlobalOpts hide = @@ -167,3 +168,8 @@ buildOptsMonoidParser hide0 = (long "skip" <> help "Skip given component, can be specified multiple times" <> hide))) + interleavedOutput = + firstBoolFlags + "interleaved-output" + "Print concurrent GHC output to the console with a prefix for the package name" + hide diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index d134d41efb..b21ba37cf4 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -332,7 +332,7 @@ getSDistFileList lp = withExecuteEnv bopts boptsCli baseConfigOpts locals [] [] [] -- provide empty list of globals. This is a hack around custom Setup.hs files $ \ee -> - withSingleContext ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _console _mlogFile -> do + withSingleContext ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do let outFile = toFilePath tmpdir FP. "source-files-list" cabal KeepTHLoading ["sdist", "--list-sources", outFile] contents <- liftIO (S.readFile outFile) diff --git a/src/Stack/Types/Config/Build.hs b/src/Stack/Types/Config/Build.hs index 2b612a3eba..e0b9dec22d 100644 --- a/src/Stack/Types/Config/Build.hs +++ b/src/Stack/Types/Config/Build.hs @@ -88,6 +88,9 @@ data BuildOpts = -- ^ Whether to enable split-objs. ,boptsSkipComponents :: ![Text] -- ^ Which components to skip when building + ,boptsInterleavedOutput :: !Bool + -- ^ Should we use the interleaved GHC output when building + -- multiple packages? } deriving (Show) @@ -117,6 +120,7 @@ defaultBuildOpts = BuildOpts , boptsCabalVerbose = False , boptsSplitObjs = False , boptsSkipComponents = [] + , boptsInterleavedOutput = False } defaultBuildOptsCLI ::BuildOptsCLI @@ -185,6 +189,7 @@ data BuildOptsMonoid = BuildOptsMonoid , buildMonoidCabalVerbose :: !(First Bool) , buildMonoidSplitObjs :: !(First Bool) , buildMonoidSkipComponents :: ![Text] + , buildMonoidInterleavedOutput :: !(First Bool) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings BuildOptsMonoid) where @@ -216,6 +221,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where buildMonoidCabalVerbose <- First <$> o ..:? buildMonoidCabalVerboseArgName buildMonoidSplitObjs <- First <$> o ..:? buildMonoidSplitObjsName buildMonoidSkipComponents <- o ..:? buildMonoidSkipComponentsName ..!= mempty + buildMonoidInterleavedOutput <- First <$> o ..:? buildMonoidInterleavedOutputName return BuildOptsMonoid{..}) buildMonoidLibProfileArgName :: Text @@ -290,6 +296,9 @@ buildMonoidSplitObjsName = "split-objs" buildMonoidSkipComponentsName :: Text buildMonoidSkipComponentsName = "skip-components" +buildMonoidInterleavedOutputName :: Text +buildMonoidInterleavedOutputName = "interleaved-output" + instance Semigroup BuildOptsMonoid where (<>) = mappenddefault