diff --git a/cabal-install/src/Distribution/Client/CmdBench.hs b/cabal-install/src/Distribution/Client/CmdBench.hs index 7e65034e05a..a6d9aad58e3 100644 --- a/cabal-install/src/Distribution/Client/CmdBench.hs +++ b/cabal-install/src/Distribution/Client/CmdBench.hs @@ -118,7 +118,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig globalFlags flags + cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @bench@ command. diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index 60ffd0e2011..78c8f15db2c 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -8,7 +8,7 @@ module Distribution.Client.CmdShowBuildInfo ( ) where import Distribution.Client.Compat.Prelude - ( catMaybes ) + ( for ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages @@ -17,7 +17,7 @@ import Distribution.Client.Setup import Distribution.Client.TargetProblem ( TargetProblem', TargetProblem (TargetProblemNoneEnabled, TargetProblemNoTargets) ) import Distribution.Simple.Setup - (Flag(..), haddockVerbosity, configVerbosity, fromFlagOrDefault ) + ( configVerbosity, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity @@ -26,20 +26,19 @@ import Distribution.Simple.Utils ( wrapText ) import qualified Data.Map as Map -import qualified Distribution.Simple.Setup as Cabal -import Distribution.Client.ProjectBuilding.Types import Distribution.Client.ProjectPlanning.Types import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout - ( distProjectRootDirectory ) + ( distProjectRootDirectory, DistDirLayout (distProjectCacheDirectory) ) import Distribution.Simple.ShowBuildInfo import Distribution.Utils.Json -import Data.Either import qualified Data.Text as T import qualified Data.Text.IO as T +import System.FilePath +import Distribution.Types.UnitId (unUnitId) showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -108,13 +107,13 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes - -- We can ignore the errors here, since runProjectPostBuildPhase should - -- have already died and reported them if they exist - let (_errs, buildResults) = partitionEithers $ Map.elems buildOutcomes - - let componentBuildInfos = - concatMap T.lines $ -- Component infos are returned each on a newline - catMaybes (buildResultBuildInfo <$> buildResults) + let tm = targetsMap buildCtx + let units = Map.keys tm + let layout = distDirLayout baseCtx + let dir = distProjectCacheDirectory layout "buildinfo" + componentBuildInfos <- for units $ \unit -> do + let fp = dir (unUnitId unit) <.> "json" + T.strip <$> T.readFile fp let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) @@ -135,12 +134,12 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO -- Default to silent verbosity otherwise it will pollute our json output verbosity = fromFlagOrDefault silent (configVerbosity configFlags) -- Also shut up haddock since it dumps warnings to stdout - flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } - , configFlags = configFlags { Cabal.configTests = Flag True - , Cabal.configBenchmarks = Flag True - } - } - cliConfig = commandLineFlagsToProjectConfig globalFlags flags' + -- flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } + -- , configFlags = configFlags { Cabal.configTests = Flag True + -- , Cabal.configBenchmarks = Flag True + -- } + -- } + cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @show-build-info@ command. diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index d48e299f1c9..93ca16aa91b 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -97,7 +97,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text.IO as T import Control.Exception (Handler (..), SomeAsyncException, assert, catches, handle) import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile, renameDirectory) @@ -1193,6 +1192,7 @@ buildInplaceUnpackedPackage :: Verbosity buildInplaceUnpackedPackage verbosity distDirLayout@DistDirLayout { distTempDirectory, + distProjectCacheDirectory, distPackageCacheDirectory, distDirectory } @@ -1206,7 +1206,6 @@ buildInplaceUnpackedPackage verbosity rpkg@(ReadyPackage pkg) buildStatus srcdir builddir = do - --TODO: [code cleanup] there is duplication between the -- distdirlayout and the builddir here builddir is not -- enough, we also need the per-package cachedir @@ -1301,7 +1300,7 @@ buildInplaceUnpackedPackage verbosity -- whenRepl $ annotateFailureNoLog ReplFailed $ - setupInteractive replCommand replFlags replArgs + setupInteractive replCommand replFlags replArgs -- Haddock phase whenHaddock $ @@ -1317,22 +1316,23 @@ buildInplaceUnpackedPackage verbosity notice verbosity $ "Documentation tarball created: " ++ dest -- Build info phase - buildInfo <- whenBuildInfo $ + {- buildInfo <- -} + whenBuildInfo $ do -- Write the json to a temporary file to read it, since stdout can get -- cluttered - withTempDirectory verbosity distTempDirectory "build-info" $ \dir -> do - let fp = dir "out" - setupInteractive - buildInfoCommand - (\v -> (buildInfoFlags v) { Cabal.buildInfoOutputFile = Just fp }) - buildInfoArgs - Just <$> T.readFile fp + let dir = distProjectCacheDirectory "buildinfo" + let fp = dir (unUnitId $ elabUnitId pkg) <.> "json" + createDirectoryIfMissing True dir + setupInteractive + buildInfoCommand + (\v -> (buildInfoFlags v) { Cabal.buildInfoOutputFile = Just fp }) + buildInfoArgs return BuildResult { buildResultDocs = docsResult, buildResultTests = testsResult, buildResultLogFile = Nothing, - buildResultBuildInfo = buildInfo + buildResultBuildInfo = Nothing } where @@ -1351,7 +1351,8 @@ buildInplaceUnpackedPackage verbosity | null (elabBuildTargets pkg) -- NB: we have to build the test/bench suite! , null (elabTestTargets pkg) - , null (elabBenchTargets pkg) = return () + , null (elabBenchTargets pkg) + , null (elabBuildInfoTargets pkg) = return () | otherwise = action whenTest action @@ -1371,7 +1372,7 @@ buildInplaceUnpackedPackage verbosity | otherwise = return () whenBuildInfo action - | null (elabBuildInfoTargets pkg) = return Nothing + | null (elabBuildInfoTargets pkg) = return () | otherwise = action whenReRegister action