From 0bdf9e5b9ef10f1ef0fcc0beaa0d7363e8263ea4 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 16 Aug 2015 19:50:39 +0200 Subject: [PATCH 01/11] Add show-build-info command This allows users to get a JSON representation of various information about how Cabal would go about building a package. The output of this command is intended for external tools and therefore the format should remain stable. --- .../src/Distribution/Client/Setup.hs | 23 ++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index c710b4a384e..681565b4e68 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -23,7 +23,7 @@ module Distribution.Client.Setup , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , buildCommand, BuildFlags(..) , filterTestFlags - , replCommand, testCommand, benchmarkCommand, testOptions, benchmarkOptions + , replCommand, testCommand, showBuildInfoCommand, benchmarkCommand, testOptions, benchmarkOptions , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , filterHaddockArgs, filterHaddockFlags, haddockOptions @@ -178,6 +178,7 @@ globalCommand commands = CommandUI { , "outdated" , "haddock" , "hscolour" + , "show-build-info" , "exec" , "new-build" , "new-configure" @@ -264,6 +265,7 @@ globalCommand commands = CommandUI { , addCmd "upload" , addCmd "report" , par + , addCmd "show-build-info" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -801,6 +803,25 @@ filterTestFlags flags cabalLibVersion Cabal.testWrapper = NoFlag } +-- ------------------------------------------------------------ +-- * show-build-info command +-- ------------------------------------------------------------ + +showBuildInfoCommand :: CommandUI (BuildFlags, BuildExFlags) +showBuildInfoCommand = parent { + commandDefaultFlags = (commandDefaultFlags parent, mempty), + commandOptions = + \showOrParseArgs -> liftOptions fst setFst + (commandOptions parent showOrParseArgs) + ++ + liftOptions snd setSnd (buildExOptions showOrParseArgs) + } + where + setFst a (_,b) = (a,b) + setSnd b (a,_) = (a,b) + + parent = Cabal.showBuildInfoCommand defaultProgramDb + -- ------------------------------------------------------------ -- * Repl command -- ------------------------------------------------------------ From 956b3297a87b139a6a3f3bb6267f6864e5032489 Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 14 Sep 2019 20:49:27 +0200 Subject: [PATCH 02/11] Rebase work of cfraz89 and bgamari Add (currently nonfunctional) new-show-build-info Fix compile error Make new-show-build-info functional Use silent verbosity by default on showBuildInfo commands to keep output json clean Make show-build-info commands hidden Implement write-autogen-files Make new-write-autogen-files work Make new-write-autogen-files configure if necessary Use target selectors for new-show-build-info Don't prune plan for new-show-build-info Only configure in new-show-build-info and new-write-autogen-files if no persist build info file is found Wrap multiple target output of new-show-build-info in json list --- cabal-install/cabal-install.cabal | 2 + cabal-install/main/Main.hs | 114 ++++++-- .../Distribution/Client/CmdShowBuildInfo.hs | 254 ++++++++++++++++++ .../Client/CmdWriteAutogenFiles.hs | 220 +++++++++++++++ .../src/Distribution/Client/Setup.hs | 30 +++ 5 files changed, 604 insertions(+), 16 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs create mode 100644 cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a6618def56e..478aa95dfe3 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -75,6 +75,8 @@ library Distribution.Client.CmdBench Distribution.Client.CmdBuild Distribution.Client.CmdClean + Distribution.Client.CmdShowBuildInfo + Distribution.Client.CmdWriteAutogenFiles Distribution.Client.CmdConfigure Distribution.Client.CmdErrorMessages Distribution.Client.CmdExec diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 51786f996c5..c099312c686 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -45,6 +45,7 @@ import Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand + , WriteAutogenFilesFlags(..) ) import Distribution.Simple.Setup ( HaddockTarget(..) @@ -75,6 +76,8 @@ import qualified Distribution.Client.List as List import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdUpdate as CmdUpdate import qualified Distribution.Client.CmdBuild as CmdBuild +import qualified Distribution.Client.CmdShowBuildInfo as CmdShowBuildInfo +import qualified Distribution.Client.CmdWriteAutogenFiles as CmdWriteAutogenFiles import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdFreeze as CmdFreeze import qualified Distribution.Client.CmdHaddock as CmdHaddock @@ -127,7 +130,7 @@ import qualified Distribution.Simple as Simple import qualified Distribution.Make as Make import qualified Distribution.Types.UnqualComponentName as Make import Distribution.Simple.Build - ( startInterpreter ) + ( startInterpreter, initialBuildSteps ) import Distribution.Simple.Command ( CommandParse(..), CommandUI(..), Command, CommandSpec(..) , CommandType(..), commandsRun, commandAddAction, hiddenCommand @@ -150,7 +153,7 @@ import Distribution.Simple.Utils import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity - ( normal ) + ( Verbosity, normal, silent ) import Distribution.Version ( Version, mkVersion, orLaterVersion ) @@ -245,7 +248,11 @@ mainWorker args = do , hiddenCmd actAsSetupCommand actAsSetupAction , hiddenCmd manpageCommand (manpageAction commandSpecs) , regularCmd CmdListBin.listbinCommand CmdListBin.listbinAction - + -- ghc-mod supporting commands + , hiddenCmd CmdShowBuildInfo.showBuildInfoCommand + CmdShowBuildInfo.showBuildInfoAction + , hiddenCmd CmdWriteAutogenFiles.writeAutogenFilesCommand + CmdWriteAutogenFiles.writeAutogenFilesAction ] ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction @@ -260,7 +267,6 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction - , legacyCmd configureExCommand configureAction , legacyCmd buildCommand buildAction , legacyCmd replCommand replAction @@ -378,23 +384,79 @@ buildAction buildFlags extraArgs globalFlags = do nixShell verbosity distPref globalFlags config $ do build verbosity config' distPref buildFlags extraArgs +buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action +buildAction flags@(buildFlags, _) = buildActionForCommand + (Cabal.buildCommand defaultProgramDb) + verbosity + flags + where verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) + +showBuildInfoAction :: (BuildFlags, BuildExFlags) -> [String] -> Action +showBuildInfoAction flags@(buildFlags, _) = buildActionForCommand + (Cabal.showBuildInfoCommand defaultProgramDb) + verbosity + flags + -- Default silent verbosity so as not to pollute json output + where verbosity = fromFlagOrDefault silent (buildVerbosity buildFlags) + +buildActionForCommand :: CommandUI BuildFlags + -> Verbosity + -> (BuildFlags, BuildExFlags) + -> [String] + -> Action +buildActionForCommand commandUI verbosity (buildFlags, buildExFlags) extraArgs globalFlags + = do + let noAddSource = + fromFlagOrDefault DontSkipAddSourceDepsCheck (buildOnly buildExFlags) + (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + distPref <- findSavedDistPref config (buildDistPref buildFlags) + -- Calls 'configureAction' to do the real work, so nothing special has to be + -- done to support sandboxes. + config' <- reconfigure configureAction + verbosity + distPref + useSandbox + noAddSource + (buildNumJobs buildFlags) + mempty + [] + globalFlags + config + nixShell verbosity distPref globalFlags config $ do + maybeWithSandboxDirOnSearchPath useSandbox $ buildForCommand commandUI + verbosity + config' + distPref + buildFlags + extraArgs -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke -- 'reconfigure' twice. build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () -build verbosity config distPref buildFlags extraArgs = - setupWrapper verbosity setupOptions Nothing - (Cabal.buildCommand progDb) mkBuildFlags (const extraArgs) - where - progDb = defaultProgramDb - setupOptions = defaultSetupScriptOptions { useDistPref = distPref } - - mkBuildFlags version = filterBuildFlags version config buildFlags' - buildFlags' = buildFlags - { buildVerbosity = toFlag verbosity - , buildDistPref = toFlag distPref - } +build = buildForCommand (Cabal.buildCommand defaultProgramDb) + +buildForCommand :: CommandUI BuildFlags + -> Verbosity + -> SavedConfig + -> FilePath + -> BuildFlags + -> [String] + -> IO () +buildForCommand command verbosity config distPref buildFlags extraArgs = + setupWrapper verbosity + setupOptions + Nothing + command + mkBuildFlags + (const extraArgs) + where + setupOptions = defaultSetupScriptOptions { useDistPref = distPref } + + mkBuildFlags version = filterBuildFlags version config buildFlags' + buildFlags' = buildFlags { buildVerbosity = toFlag verbosity + , buildDistPref = toFlag distPref + } -- | Make sure that we don't pass new flags to setup scripts compiled against -- old versions of Cabal. @@ -968,3 +1030,23 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags + +--Further commands to support ghc-mod usage +writeAutogenFilesAction :: WriteAutogenFilesFlags -> [String] -> Action +writeAutogenFilesAction flags _ globalFlags = do + let verbosity = fromFlag (wafVerbosity flags) + load <- try (loadConfigOrSandboxConfig verbosity globalFlags) + let config = either (\(SomeException _) -> mempty) snd load + distPref <- findSavedDistPref config (wafDistPref flags) + pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref) + eLBI <- tryGetPersistBuildConfig distPref + case eLBI of + Left err -> case err of + -- Note: the build config could have been generated by a custom setup + -- script built against a different Cabal version, so it's crucial that + -- we ignore the bad version error here. + ConfigStateFileBadVersion _ _ _ -> pure () + _ -> die' verbosity (show err) + Right lbi -> do + initialBuildSteps distPref pkg lbi verbosity + pure () diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs new file mode 100644 index 00000000000..cc5a41bb6cc --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -0,0 +1,254 @@ +-- | cabal-install CLI command: build +-- +module Distribution.Client.CmdShowBuildInfo ( + -- * The @build@ CLI and action + showBuildInfoCommand, + showBuildInfoAction + ) where + +import Distribution.Client.ProjectOrchestration +import Distribution.Client.CmdErrorMessages +import Distribution.Client.CmdInstall.ClientInstallFlags + +import Distribution.Client.Setup + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) +import qualified Distribution.Client.Setup as Client +import Distribution.Simple.Setup + ( HaddockFlags, fromFlagOrDefault, TestFlags ) +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Verbosity + ( Verbosity, silent ) +import Distribution.Simple.Utils + ( wrapText, die') +import Distribution.Types.UnitId (UnitId) + +import qualified Data.Map as Map +import qualified Distribution.Simple.Setup as Cabal +import Distribution.Client.SetupWrapper +import Distribution.Simple.Program ( defaultProgramDb ) +import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.ProjectPlanning ( + setupHsConfigureFlags, setupHsConfigureArgs, + setupHsBuildFlags, setupHsBuildArgs, + setupHsScriptOptions + ) +import Distribution.Client.DistDirLayout (distBuildDirectory) +import Distribution.Client.Types ( PackageLocation(..), GenericReadyPackage(..) ) +import Distribution.Client.JobControl (newLock, Lock) +import Distribution.Simple.Configure (tryGetPersistBuildConfig) +import Data.List (find) + +showBuildInfoCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +showBuildInfoCommand = Client.installCommand { + commandName = "new-show-build-info", + commandSynopsis = "Show project build information", + commandUsage = usageAlternatives "new-show-build-info" [ "[TARGETS] [FLAGS]" ], + commandDescription = Just $ \_ -> wrapText $ + "Build one or more targets from within the project. The available " + ++ "targets are the packages in the project as well as individual " + ++ "components within those packages, including libraries, executables, " + ++ "test-suites or benchmarks. Targets can be specified by name or " + ++ "location. If no target is specified then the default is to build " + ++ "the package in the current directory.\n\n" + + ++ "Dependencies are built or rebuilt as necessary. Additional " + ++ "configuration flags can be specified on the command line and these " + ++ "extend the project configuration from the 'cabal.project', " + ++ "'cabal.project.local' and other files.", + commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " new-build\n" + ++ " Build the package in the current directory or all packages in the project\n" + ++ " " ++ pname ++ " new-build pkgname\n" + ++ " Build the package named pkgname in the project\n" + ++ " " ++ pname ++ " new-build ./pkgfoo\n" + ++ " Build the package in the ./pkgfoo directory\n" + ++ " " ++ pname ++ " new-build cname\n" + ++ " Build the component named cname module Distribution.Client.InstallPlanin the project\n" + ++ " " ++ pname ++ " new-build cname --module Distribution.Client.InstallPlanenable-profiling\n" + ++ " Build the component in profilingmodule Distribution.Client.InstallPlan mode (including dependencies as needed)\n\n" + + ++ cmdCommonHelpTextNewBuildBeta + } + + +-- | The @build@ command does a lot. It brings the install plan up to date, +-- selects that part of the plan needed by the given or implicit targets and +-- then executes the plan. +-- +-- For more details on how this works, see the module +-- "Distribution.Client.ProjectOrchestration" +-- +showBuildInfoAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) + -> [String] -> GlobalFlags -> IO () +showBuildInfoAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) + targetStrings globalFlags = do + + baseCtx <- establishProjectBaseContext verbosity cliConfig + let baseCtx' = baseCtx { + buildSettings = (buildSettings baseCtx) { + buildSettingDryRun = True + } + } + + targetSelectors <- either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings + + buildCtx <- + runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do + -- Interpret the targets on the command line as build targets + -- (as opposed to say repl or haddock targets). + targets <- either (reportTargetProblems verbosity) return + $ resolveTargets + selectPackageTargets + selectComponentTarget + TargetProblemCommon + elaboratedPlan + Nothing + targetSelectors + + -- Don't prune the plan though, as we want a list of all configured packages + return (elaboratedPlan, targets) + + scriptLock <- newLock + showTargets verbosity baseCtx' buildCtx scriptLock + + where + -- Default to silent verbosity otherwise it will pollute our json output + verbosity = fromFlagOrDefault silent (configVerbosity configFlags) + cliConfig = commandLineFlagsToProjectConfig + globalFlags configFlags configExFlags + installFlags defaultClientInstallFlags + haddockFlags + testFlags + +-- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks +showTargets :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () +showTargets verbosity baseCtx buildCtx lock = do + putStr "[" + mapM_ showSeparated (zip [0..] targets) + putStrLn "]" + where configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] + targets = fst <$> (Map.toList . targetsMap $ buildCtx) + doShowInfo unitId = showInfo verbosity baseCtx buildCtx lock configured unitId + showSeparated (idx, unitId) + | idx == length targets - 1 = doShowInfo unitId + | otherwise = doShowInfo unitId >> putStrLn "," + +showInfo :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () +showInfo verbosity baseCtx buildCtx lock pkgs targetUnitId + | Nothing <- mbPkg = die' verbosity $ "No unit " ++ show targetUnitId + | Just pkg <- mbPkg = do + let shared = elaboratedShared buildCtx + install = elaboratedPlanOriginal buildCtx + dirLayout = distDirLayout baseCtx + buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) + flags = setupHsBuildFlags pkg shared verbosity buildDir + args = setupHsBuildArgs pkg + srcDir = case (elabPkgSourceLocation pkg) of + LocalUnpackedPackage fp -> fp + _ -> "" + scriptOptions = setupHsScriptOptions + (ReadyPackage pkg) + install + shared + dirLayout + srcDir + buildDir + False + lock + configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir + configureArgs = setupHsConfigureArgs pkg + --Configure the package if there's no existing config + lbi <- tryGetPersistBuildConfig buildDir + case lbi of + Left _ -> setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.configureCommand defaultProgramDb) + (const $ configureFlags) + (const configureArgs) + Right _ -> pure () + setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.showBuildInfoCommand defaultProgramDb) + (const flags) + (const args) + where mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs + +-- | This defines what a 'TargetSelector' means for the @write-autogen-files@ command. +-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, +-- or otherwise classifies the problem. +-- +-- For the @write-autogen-files@ command select all components except non-buildable and disabled +-- tests\/benchmarks, fail if there are no such components +-- +selectPackageTargets :: TargetSelector + -> [AvailableTarget k] -> Either TargetProblem [k] +selectPackageTargets targetSelector targets + + -- If there are any buildable targets then we select those + | not (null targetsBuildable) + = Right targetsBuildable + + -- If there are targets but none are buildable then we report those + | not (null targets) + = Left (TargetProblemNoneEnabled targetSelector targets') + + -- If there are no targets at all then we report that + | otherwise + = Left (TargetProblemNoTargets targetSelector) + where + targets' = forgetTargetsDetail targets + targetsBuildable = selectBuildableTargetsWith + (buildable targetSelector) + targets + + -- When there's a target filter like "pkg:tests" then we do select tests, + -- but if it's just a target like "pkg" then we don't build tests unless + -- they are requested by default (i.e. by using --enable-tests) + buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False + buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False + buildable _ _ = True + +-- | For a 'TargetComponent' 'TargetSelector', check if the component can be +-- selected. +-- +-- For the @build@ command we just need the basic checks on being buildable etc. +-- +selectComponentTarget :: SubComponentTarget + -> AvailableTarget k -> Either TargetProblem k +selectComponentTarget subtarget = + either (Left . TargetProblemCommon) Right + . selectComponentTargetBasic subtarget + + +-- | The various error conditions that can occur when matching a +-- 'TargetSelector' against 'AvailableTarget's for the @build@ command. +-- +data TargetProblem = + TargetProblemCommon TargetProblemCommon + + -- | The 'TargetSelector' matches targets but none are buildable + | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] + + -- | There are no targets at all + | TargetProblemNoTargets TargetSelector + deriving (Eq, Show) + +reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a +reportTargetProblems verbosity = + die' verbosity . unlines . map renderTargetProblem + +renderTargetProblem :: TargetProblem -> String +renderTargetProblem (TargetProblemCommon problem) = + renderTargetProblemCommon "build" problem +renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = + renderTargetProblemNoneEnabled "build" targetSelector targets +renderTargetProblem(TargetProblemNoTargets targetSelector) = + renderTargetProblemNoTargets "build" targetSelector \ No newline at end of file diff --git a/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs b/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs new file mode 100644 index 00000000000..86a80b6fa53 --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs @@ -0,0 +1,220 @@ +-- | cabal-install CLI command: build +-- +module Distribution.Client.CmdWriteAutogenFiles ( + -- * The @build@ CLI and action + writeAutogenFilesCommand, + writeAutogenFilesAction + ) where + +import Distribution.Client.ProjectOrchestration +import Distribution.Client.CmdErrorMessages +import Distribution.Client.CmdInstall.ClientInstallFlags + +import Distribution.Client.Setup + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags, WriteAutogenFilesFlags(..) ) +import qualified Distribution.Client.Setup as Client +import Distribution.Simple.Setup + ( HaddockFlags, fromFlagOrDefault, Flag(..), TestFlags ) +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Verbosity + ( Verbosity, normal ) +import Distribution.Simple.Utils + ( wrapText, die' ) +import Distribution.Simple.Configure (tryGetPersistBuildConfig) + +import qualified Data.Map as Map +import qualified Distribution.Simple.Setup as Cabal +import Distribution.Client.SetupWrapper +import Distribution.Simple.Program ( defaultProgramDb ) +import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.ProjectPlanning ( + setupHsScriptOptions, setupHsConfigureFlags, setupHsConfigureArgs + ) +import Distribution.Client.DistDirLayout (distBuildDirectory) +import Distribution.Client.Types ( PackageLocation(..), GenericReadyPackage(..) ) +import Distribution.Client.JobControl (newLock, Lock) + +writeAutogenFilesCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) +writeAutogenFilesCommand = Client.installCommand { + commandName = "new-write-autogen-files", + commandSynopsis = "", + commandUsage = usageAlternatives "new-write-autogen-files" [ "[FLAGS]" ], + commandDescription = Just $ \_ -> wrapText $ + "Generate and write out the Paths_.hs and cabal_macros.h files\n" + ++ "for all components in the project", + commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " new-write-autogen-files\n" + ++ " Write for all packages in the project\n" + } + +writeAutogenFilesAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) + -> [String] -> GlobalFlags -> IO () +writeAutogenFilesAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) + targetStrings globalFlags = do + baseCtx <- establishProjectBaseContext verbosity cliConfig + let baseCtx' = baseCtx { + buildSettings = (buildSettings baseCtx) { + buildSettingDryRun = True + } + } + targetSelectors <- either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings + + buildCtx <- + runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do + -- Interpret the targets on the command line as build targets + -- (as opposed to say repl or haddock targets). + targets <- either (reportTargetProblems verbosity) return + $ resolveTargets + selectPackageTargets + selectComponentTarget + TargetProblemCommon + elaboratedPlan + Nothing + targetSelectors + + let elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuild + targets + elaboratedPlan + elaboratedPlan'' <- + if buildSettingOnlyDeps (buildSettings baseCtx') + then either (reportCannotPruneDependencies verbosity) return $ + pruneInstallPlanToDependencies (Map.keysSet targets) + elaboratedPlan' + else return elaboratedPlan' + + return (elaboratedPlan'', targets) + + scriptLock <- newLock + writeAutogenFiles verbosity baseCtx' buildCtx scriptLock (configured buildCtx) + + where + verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + cliConfig = commandLineFlagsToProjectConfig + globalFlags configFlags configExFlags + installFlags defaultClientInstallFlags + haddockFlags + testFlags + configured ctx = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanToExecute ctx)] + + +writeAutogenFiles :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> IO () +writeAutogenFiles verbosity baseCtx buildCtx lock pkgs = mapM_ runWrapper pkgs + where runWrapper pkg = do + let shared = elaboratedShared buildCtx + install = elaboratedPlanOriginal buildCtx + dirLayout = distDirLayout baseCtx + buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) + srcDir = case (elabPkgSourceLocation pkg) of + LocalUnpackedPackage fp -> fp + _ -> "" + scriptOptions = setupHsScriptOptions + (ReadyPackage pkg) + install + shared + dirLayout + srcDir + buildDir + False + lock + configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir + configureArgs = setupHsConfigureArgs pkg + --Configure the package if there's no existing config, + lbi <- tryGetPersistBuildConfig buildDir + case lbi of + Left _ -> setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.configureCommand defaultProgramDb) + (const $ configureFlags) + (const configureArgs) + Right _ -> pure () + setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.writeAutogenFilesCommand defaultProgramDb) + (const $ WriteAutogenFilesFlags (Flag buildDir) (Flag verbosity)) + (const []) + +-- | This defines what a 'TargetSelector' means for the @write-autogen-files@ command. +-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, +-- or otherwise classifies the problem. +-- +-- For the @write-autogen-files@ command select all components except non-buildable and disabled +-- tests\/benchmarks, fail if there are no such components +-- +selectPackageTargets :: TargetSelector + -> [AvailableTarget k] -> Either TargetProblem [k] +selectPackageTargets targetSelector targets + + -- If there are any buildable targets then we select those + | not (null targetsBuildable) + = Right targetsBuildable + + -- If there are targets but none are buildable then we report those + | not (null targets) + = Left (TargetProblemNoneEnabled targetSelector targets') + + -- If there are no targets at all then we report that + | otherwise + = Left (TargetProblemNoTargets targetSelector) + where + targets' = forgetTargetsDetail targets + targetsBuildable = selectBuildableTargetsWith + (buildable targetSelector) + targets + + -- When there's a target filter like "pkg:tests" then we do select tests, + -- but if it's just a target like "pkg" then we don't build tests unless + -- they are requested by default (i.e. by using --enable-tests) + buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False + buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False + buildable _ _ = True + +-- | For a 'TargetComponent' 'TargetSelector', check if the component can be +-- selected. +-- +-- For the @build@ command we just need the basic checks on being buildable etc. +-- +selectComponentTarget :: SubComponentTarget + -> AvailableTarget k -> Either TargetProblem k +selectComponentTarget subtarget = + either (Left . TargetProblemCommon) Right + . selectComponentTargetBasic subtarget + + +-- | The various error conditions that can occur when matching a +-- 'TargetSelector' against 'AvailableTarget's for the @build@ command. +-- +data TargetProblem = + TargetProblemCommon TargetProblemCommon + + -- | The 'TargetSelector' matches targets but none are buildable + | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] + + -- | There are no targets at all + | TargetProblemNoTargets TargetSelector + deriving (Eq, Show) + +reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a +reportTargetProblems verbosity = + die' verbosity . unlines . map renderTargetProblem + +renderTargetProblem :: TargetProblem -> String +renderTargetProblem (TargetProblemCommon problem) = + renderTargetProblemCommon "build" problem +renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = + renderTargetProblemNoneEnabled "build" targetSelector targets +renderTargetProblem(TargetProblemNoTargets targetSelector) = + renderTargetProblemNoTargets "build" targetSelector + +reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a +reportCannotPruneDependencies verbosity = + die' verbosity . renderCannotPruneDependencies + diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 681565b4e68..8ed6498aae1 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -49,6 +49,10 @@ module Distribution.Client.Setup , copyCommand , registerCommand + --ghc-mod support commands + , showBuildInfoCommand + , writeAutogenFilesCommand, WriteAutogenFilesFlags(..) + , parsePackageArgs , liftOptions , yesNoOpt ) where @@ -96,6 +100,7 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..) , CopyFlags(..), RegisterFlags(..) + , WriteAutogenFilesFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -179,6 +184,7 @@ globalCommand commands = CommandUI { , "haddock" , "hscolour" , "show-build-info" + , "write-autogen-files" , "exec" , "new-build" , "new-configure" @@ -266,6 +272,7 @@ globalCommand commands = CommandUI { , addCmd "report" , par , addCmd "show-build-info" + , addCmd "write-autogen-files" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -2493,3 +2500,26 @@ relevantConfigValuesText :: [String] -> String relevantConfigValuesText vs = "Relevant global configuration keys:\n" ++ concat [" " ++ v ++ "\n" |v <- vs] + + +-- ------------------------------------------------------------ +-- * Commands to support ghc-mod +-- ------------------------------------------------------------ + +showBuildInfoCommand :: CommandUI (BuildFlags, BuildExFlags) +showBuildInfoCommand = parent { + commandDefaultFlags = (commandDefaultFlags parent, mempty), + commandOptions = + \showOrParseArgs -> liftOptions fst setFst + (commandOptions parent showOrParseArgs) + ++ + liftOptions snd setSnd (buildExOptions showOrParseArgs) + } + where + setFst a (_,b) = (a,b) + setSnd b (a,_) = (a,b) + + parent = Cabal.showBuildInfoCommand defaultProgramDb + +writeAutogenFilesCommand :: CommandUI WriteAutogenFilesFlags +writeAutogenFilesCommand = Cabal.writeAutogenFilesCommand defaultProgramDb \ No newline at end of file From 8193561b16202c7a6b5733a91e9dd07b08b56e46 Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 14 Sep 2019 20:50:17 +0200 Subject: [PATCH 03/11] Improve s-b-i frontend command and add tests Also, rename new-show-build-info to show-build-info in ShowBuildInfo Get cabal-install building again Fix typo Don't hardcode cabal version in showbuildinfo tests Remove some unnecessary files from test package Refactor show-build-info tests Undo some changes no longer needed in Main.hs Add back explicit exports and fix typos Tidy up imports Update showBuildInfoAction documentation Cosmetic fixes --- Cabal/src/Distribution/Simple/BuildTarget.hs | 2 +- .../src/Distribution/Simple/ShowBuildInfo.hs | 2 +- cabal-install/cabal-install.cabal | 3 +- cabal-install/main/Main.hs | 124 ++----- .../src/Distribution/Client/CmdBuild.hs | 3 +- .../Distribution/Client/CmdShowBuildInfo.hs | 327 +++++++++++------- .../Client/CmdWriteAutogenFiles.hs | 220 ------------ .../src/Distribution/Client/Setup.hs | 34 +- .../src/Distribution/Client/SetupWrapper.hs | 2 +- .../PackageTests/ShowBuildInfo/A/A.cabal | 16 + .../PackageTests/ShowBuildInfo/A/Setup.hs | 2 + .../ShowBuildInfo/A/build-info-exe-exact.out | 1 + .../A/build-info-exe-exact.test.hs | 20 ++ ...build-info-multiple-exact-unit-id-file.out | 1 + ...d-info-multiple-exact-unit-id-file.test.hs | 44 +++ .../A/build-info-multiple-exact-unit-id.out | 1 + .../build-info-multiple-exact-unit-id.test.hs | 41 +++ .../A/build-info-multiple-exact.out | 1 + .../A/build-info-multiple-exact.test.hs | 41 +++ .../ShowBuildInfo/A/build-info-unknown.out | 12 + .../A/build-info-unknown.test.hs | 14 + .../ShowBuildInfo/A/cabal.project | 1 + .../PackageTests/ShowBuildInfo/A/src/A.hs | 4 + .../PackageTests/ShowBuildInfo/A/src/Main.hs | 4 + .../PackageTests/ShowBuildInfo/B/B.cabal | 10 + .../PackageTests/ShowBuildInfo/B/Setup.hs | 2 + .../ShowBuildInfo/B/build-info-lib-exact.out | 1 + .../B/build-info-lib-exact.test.hs | 20 ++ .../ShowBuildInfo/B/cabal.project | 1 + .../PackageTests/ShowBuildInfo/B/src/A.hs | 4 + .../ShowBuildInfo/Complex/Complex.cabal | 48 +++ .../ShowBuildInfo/Complex/Setup.hs | 2 + .../ShowBuildInfo/Complex/cabal.project | 1 + .../ShowBuildInfo/Complex/exe.out | 1 + .../ShowBuildInfo/Complex/exe.test.hs | 36 ++ .../ShowBuildInfo/Complex/lib.out | 1 + .../ShowBuildInfo/Complex/lib.test.hs | 35 ++ .../ShowBuildInfo/Complex/src/Lib.hs | 4 + .../ShowBuildInfo/Complex/src/Main.lhs | 9 + .../ShowBuildInfo/Complex/test/Main.hs | 1 + cabal-testsuite/cabal-testsuite.cabal | 1 + .../src/Test/Cabal/DecodeShowBuildInfo.hs | 65 ++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 43 files changed, 685 insertions(+), 479 deletions(-) delete mode 100644 cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs create mode 100644 cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs index e2f930ff68c..4f49e7a6bb2 100644 --- a/Cabal/src/Distribution/Simple/BuildTarget.hs +++ b/Cabal/src/Distribution/Simple/BuildTarget.hs @@ -67,7 +67,7 @@ import System.Directory ( doesFileExist, doesDirectoryExist ) import qualified Data.Map as Map -- | Take a list of 'String' build targets, and parse and validate them --- into actual 'TargetInfo's to be built/registered/whatever. +-- into actual 'TargetInfo's to be built\/registered\/whatever. readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo] readTargetInfos verbosity pkg_descr lbi args = do build_targets <- readBuildTargets verbosity pkg_descr args diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 631685b1d57..fb37327229a 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -2,7 +2,7 @@ -- This module defines a simple JSON-based format for exporting basic -- information about a Cabal package and the compiler configuration Cabal -- would use to build it. This can be produced with the --- @cabal new-show-build-info@ command. +-- @cabal show-build-info@ command. -- -- -- This format is intended for consumption by external tooling and should diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 478aa95dfe3..aa7c41a54bc 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -75,8 +75,6 @@ library Distribution.Client.CmdBench Distribution.Client.CmdBuild Distribution.Client.CmdClean - Distribution.Client.CmdShowBuildInfo - Distribution.Client.CmdWriteAutogenFiles Distribution.Client.CmdConfigure Distribution.Client.CmdErrorMessages Distribution.Client.CmdExec @@ -90,6 +88,7 @@ library Distribution.Client.CmdOutdated Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdSdist Distribution.Client.CmdTest Distribution.Client.CmdUpdate diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index c099312c686..8d3640dd845 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -45,7 +45,6 @@ import Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand - , WriteAutogenFilesFlags(..) ) import Distribution.Simple.Setup ( HaddockTarget(..) @@ -77,7 +76,6 @@ import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdUpdate as CmdUpdate import qualified Distribution.Client.CmdBuild as CmdBuild import qualified Distribution.Client.CmdShowBuildInfo as CmdShowBuildInfo -import qualified Distribution.Client.CmdWriteAutogenFiles as CmdWriteAutogenFiles import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdFreeze as CmdFreeze import qualified Distribution.Client.CmdHaddock as CmdHaddock @@ -130,7 +128,7 @@ import qualified Distribution.Simple as Simple import qualified Distribution.Make as Make import qualified Distribution.Types.UnqualComponentName as Make import Distribution.Simple.Build - ( startInterpreter, initialBuildSteps ) + ( startInterpreter ) import Distribution.Simple.Command ( CommandParse(..), CommandUI(..), Command, CommandSpec(..) , CommandType(..), commandsRun, commandAddAction, hiddenCommand @@ -153,7 +151,7 @@ import Distribution.Simple.Utils import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity - ( Verbosity, normal, silent ) + ( Verbosity, normal ) import Distribution.Version ( Version, mkVersion, orLaterVersion ) @@ -251,8 +249,6 @@ mainWorker args = do -- ghc-mod supporting commands , hiddenCmd CmdShowBuildInfo.showBuildInfoCommand CmdShowBuildInfo.showBuildInfoAction - , hiddenCmd CmdWriteAutogenFiles.writeAutogenFilesCommand - CmdWriteAutogenFiles.writeAutogenFilesAction ] ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction @@ -267,6 +263,7 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction + , legacyCmd configureExCommand configureAction , legacyCmd buildCommand buildAction , legacyCmd replCommand replAction @@ -385,78 +382,39 @@ buildAction buildFlags extraArgs globalFlags = do build verbosity config' distPref buildFlags extraArgs buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -buildAction flags@(buildFlags, _) = buildActionForCommand - (Cabal.buildCommand defaultProgramDb) - verbosity - flags - where verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) - -showBuildInfoAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -showBuildInfoAction flags@(buildFlags, _) = buildActionForCommand - (Cabal.showBuildInfoCommand defaultProgramDb) - verbosity - flags - -- Default silent verbosity so as not to pollute json output - where verbosity = fromFlagOrDefault silent (buildVerbosity buildFlags) - -buildActionForCommand :: CommandUI BuildFlags - -> Verbosity - -> (BuildFlags, BuildExFlags) - -> [String] - -> Action -buildActionForCommand commandUI verbosity (buildFlags, buildExFlags) extraArgs globalFlags - = do - let noAddSource = - fromFlagOrDefault DontSkipAddSourceDepsCheck (buildOnly buildExFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags - distPref <- findSavedDistPref config (buildDistPref buildFlags) - -- Calls 'configureAction' to do the real work, so nothing special has to be - -- done to support sandboxes. - config' <- reconfigure configureAction - verbosity - distPref - useSandbox - noAddSource - (buildNumJobs buildFlags) - mempty - [] - globalFlags - config - nixShell verbosity distPref globalFlags config $ do - maybeWithSandboxDirOnSearchPath useSandbox $ buildForCommand commandUI - verbosity - config' - distPref - buildFlags - extraArgs +buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do + let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) + noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck + (buildOnly buildExFlags) + (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + distPref <- findSavedDistPref config (buildDistPref buildFlags) + -- Calls 'configureAction' to do the real work, so nothing special has to be + -- done to support sandboxes. + config' <- + reconfigure configureAction + verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags) + mempty [] globalFlags config + nixShell verbosity distPref globalFlags config $ do + maybeWithSandboxDirOnSearchPath useSandbox $ + build verbosity config' distPref buildFlags extraArgs + -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke -- 'reconfigure' twice. build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () -build = buildForCommand (Cabal.buildCommand defaultProgramDb) - -buildForCommand :: CommandUI BuildFlags - -> Verbosity - -> SavedConfig - -> FilePath - -> BuildFlags - -> [String] - -> IO () -buildForCommand command verbosity config distPref buildFlags extraArgs = - setupWrapper verbosity - setupOptions - Nothing - command - mkBuildFlags - (const extraArgs) - where - setupOptions = defaultSetupScriptOptions { useDistPref = distPref } - - mkBuildFlags version = filterBuildFlags version config buildFlags' - buildFlags' = buildFlags { buildVerbosity = toFlag verbosity - , buildDistPref = toFlag distPref - } +build verbosity config distPref buildFlags extraArgs = + setupWrapper verbosity setupOptions Nothing + (Cabal.buildCommand progDb) mkBuildFlags (const extraArgs) + where + progDb = defaultProgramDb + setupOptions = defaultSetupScriptOptions { useDistPref = distPref } + + mkBuildFlags version = filterBuildFlags version config buildFlags' + buildFlags' = buildFlags + { buildVerbosity = toFlag verbosity + , buildDistPref = toFlag distPref + } -- | Make sure that we don't pass new flags to setup scripts compiled against -- old versions of Cabal. @@ -1030,23 +988,3 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags - ---Further commands to support ghc-mod usage -writeAutogenFilesAction :: WriteAutogenFilesFlags -> [String] -> Action -writeAutogenFilesAction flags _ globalFlags = do - let verbosity = fromFlag (wafVerbosity flags) - load <- try (loadConfigOrSandboxConfig verbosity globalFlags) - let config = either (\(SomeException _) -> mempty) snd load - distPref <- findSavedDistPref config (wafDistPref flags) - pkg <- fmap LBI.localPkgDescr (getPersistBuildConfig distPref) - eLBI <- tryGetPersistBuildConfig distPref - case eLBI of - Left err -> case err of - -- Note: the build config could have been generated by a custom setup - -- script built against a different Cabal version, so it's crucial that - -- we ignore the bad version error here. - ConfigStateFileBadVersion _ _ _ -> pure () - _ -> die' verbosity (show err) - Right lbi -> do - initialBuildSteps distPref pkg lbi verbosity - pure () diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ea59acfff19..cb8c557fafb 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -8,7 +8,8 @@ module Distribution.Client.CmdBuild ( -- * Internals exposed for testing selectPackageTargets, - selectComponentTarget + selectComponentTarget, + reportTargetProblems ) where import Prelude () diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index cc5a41bb6cc..98e0a72f855 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -1,11 +1,13 @@ --- | cabal-install CLI command: build +-- | cabal-install CLI command: show-build-info -- module Distribution.Client.CmdShowBuildInfo ( - -- * The @build@ CLI and action + -- * The @show-build-info@ CLI and action showBuildInfoCommand, showBuildInfoAction ) where +import Distribution.Client.Compat.Prelude + ( when, find, fromMaybe ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdInstall.ClientInstallFlags @@ -14,84 +16,104 @@ import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault, TestFlags ) + ( HaddockFlags, TestFlags, BenchmarkFlags + , fromFlagOrDefault ) import Distribution.Simple.Command - ( CommandUI(..), usageAlternatives ) + ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die') -import Distribution.Types.UnitId (UnitId) + ( wrapText, die', withTempDirectory ) +import Distribution.Types.UnitId + ( UnitId, mkUnitId ) +import Distribution.Types.Version + ( mkVersion ) +import Distribution.Types.PackageDescription + ( buildType ) +import Distribution.Deprecated.Text + ( display ) import qualified Data.Map as Map import qualified Distribution.Simple.Setup as Cabal import Distribution.Client.SetupWrapper -import Distribution.Simple.Program ( defaultProgramDb ) +import Distribution.Simple.Program + ( defaultProgramDb ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectPlanning.Types -import Distribution.Client.ProjectPlanning ( - setupHsConfigureFlags, setupHsConfigureArgs, - setupHsBuildFlags, setupHsBuildArgs, - setupHsScriptOptions - ) -import Distribution.Client.DistDirLayout (distBuildDirectory) -import Distribution.Client.Types ( PackageLocation(..), GenericReadyPackage(..) ) -import Distribution.Client.JobControl (newLock, Lock) -import Distribution.Simple.Configure (tryGetPersistBuildConfig) -import Data.List (find) - -showBuildInfoCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -showBuildInfoCommand = Client.installCommand { - commandName = "new-show-build-info", +import Distribution.Client.ProjectPlanning + ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags + , setupHsBuildArgs, setupHsScriptOptions ) +import Distribution.Client.DistDirLayout + ( distBuildDirectory ) +import Distribution.Client.Types + ( PackageLocation(..), GenericReadyPackage(..) ) +import Distribution.Client.JobControl + ( newLock, Lock ) +import Distribution.Simple.Configure + ( tryGetPersistBuildConfig ) +import qualified Distribution.Client.CmdInstall as CmdInstall + +import System.Directory + ( getTemporaryDirectory ) +import System.FilePath + ( () ) + +showBuildInfoCommand :: CommandUI ShowBuildInfoFlags +showBuildInfoCommand = CmdInstall.installCommand { + commandName = "show-build-info", commandSynopsis = "Show project build information", - commandUsage = usageAlternatives "new-show-build-info" [ "[TARGETS] [FLAGS]" ], + commandUsage = usageAlternatives "show-build-info" [ "[TARGETS] [FLAGS]" ], commandDescription = Just $ \_ -> wrapText $ - "Build one or more targets from within the project. The available " - ++ "targets are the packages in the project as well as individual " - ++ "components within those packages, including libraries, executables, " - ++ "test-suites or benchmarks. Targets can be specified by name or " - ++ "location. If no target is specified then the default is to build " - ++ "the package in the current directory.\n\n" - - ++ "Dependencies are built or rebuilt as necessary. Additional " - ++ "configuration flags can be specified on the command line and these " - ++ "extend the project configuration from the 'cabal.project', " - ++ "'cabal.project.local' and other files.", + "Provides detailed json output for the given package.\n" + ++ "Contains information about the different build components and compiler flags.\n", commandNotes = Just $ \pname -> "Examples:\n" - ++ " " ++ pname ++ " new-build\n" - ++ " Build the package in the current directory or all packages in the project\n" - ++ " " ++ pname ++ " new-build pkgname\n" - ++ " Build the package named pkgname in the project\n" - ++ " " ++ pname ++ " new-build ./pkgfoo\n" - ++ " Build the package in the ./pkgfoo directory\n" - ++ " " ++ pname ++ " new-build cname\n" - ++ " Build the component named cname module Distribution.Client.InstallPlanin the project\n" - ++ " " ++ pname ++ " new-build cname --module Distribution.Client.InstallPlanenable-profiling\n" - ++ " Build the component in profilingmodule Distribution.Client.InstallPlan mode (including dependencies as needed)\n\n" - - ++ cmdCommonHelpTextNewBuildBeta + ++ " " ++ pname ++ " show-build-info\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " show-build-info .\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " show-build-info ./pkgname \n" + ++ " Shows build information about the package located in './pkgname'\n" + ++ cmdCommonHelpTextNewBuildBeta, + commandOptions = \showOrParseArgs -> + Client.liftOptions buildInfoInstallCommandFlags (\pf flags -> flags { buildInfoInstallCommandFlags = pf }) (commandOptions CmdInstall.installCommand showOrParseArgs) + ++ + [ option [] ["buildinfo-json-output"] + "Write the result to the given file instead of stdout" + buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + (reqArg' "FILE" Just (maybe [] pure)), + option [] ["unit-ids-json"] + "Show build-info only for selected unit-id's." + buildInfoUnitIds (\pf flags -> flags { buildInfoUnitIds = pf }) + (reqArg' "UNIT-ID" (Just . words) (fromMaybe [])) + ], + commandDefaultFlags = defaultShowBuildInfoFlags + } +data ShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoInstallCommandFlags :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, BenchmarkFlags, ClientInstallFlags) + , buildInfoOutputFile :: Maybe FilePath + , buildInfoUnitIds :: Maybe [String] + } --- | The @build@ command does a lot. It brings the install plan up to date, --- selects that part of the plan needed by the given or implicit targets and --- then executes the plan. --- --- For more details on how this works, see the module --- "Distribution.Client.ProjectOrchestration" --- -showBuildInfoAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) - -> [String] -> GlobalFlags -> IO () -showBuildInfoAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) - targetStrings globalFlags = do - - baseCtx <- establishProjectBaseContext verbosity cliConfig - let baseCtx' = baseCtx { - buildSettings = (buildSettings baseCtx) { - buildSettingDryRun = True - } - } +defaultShowBuildInfoFlags :: ShowBuildInfoFlags +defaultShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty) + , buildInfoOutputFile = Nothing + , buildInfoUnitIds = Nothing + } + +-- | The @show-build-info@ exports information about a package and the compiler +-- configuration used to build it as JSON, that can be used by other tooling. +-- See "Distribution.Simple.ShowBuildInfo" for more information. +showBuildInfoAction :: ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () +showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, benchmarkFlags, clientInstallFlags) fileOutput unitIds) + targetStrings globalFlags = do + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand + let baseCtx' = baseCtx + { buildSettings = (buildSettings baseCtx) { buildSettingDryRun = True } + } targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings @@ -113,79 +135,128 @@ showBuildInfoAction (configFlags, configExFlags, installFlags, haddockFlags, tes return (elaboratedPlan, targets) scriptLock <- newLock - showTargets verbosity baseCtx' buildCtx scriptLock - + showTargets fileOutput unitIds verbosity baseCtx' buildCtx scriptLock where -- Default to silent verbosity otherwise it will pollute our json output verbosity = fromFlagOrDefault silent (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags - installFlags defaultClientInstallFlags + installFlags clientInstallFlags haddockFlags testFlags + benchmarkFlags -- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks -showTargets :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () -showTargets verbosity baseCtx buildCtx lock = do - putStr "[" - mapM_ showSeparated (zip [0..] targets) - putStrLn "]" +showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () +showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do + tempDir <- getTemporaryDirectory + withTempDirectory verbosity tempDir "show-build-info" $ \dir -> do + mapM_ (doShowInfo dir) targets + case fileOutput of + Nothing -> outputResult dir putStr targets + Just fp -> do + writeFile fp "" + outputResult dir (appendFile fp) targets + where configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = fst <$> (Map.toList . targetsMap $ buildCtx) - doShowInfo unitId = showInfo verbosity baseCtx buildCtx lock configured unitId - showSeparated (idx, unitId) - | idx == length targets - 1 = doShowInfo unitId - | otherwise = doShowInfo unitId >> putStrLn "," - -showInfo :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () -showInfo verbosity baseCtx buildCtx lock pkgs targetUnitId - | Nothing <- mbPkg = die' verbosity $ "No unit " ++ show targetUnitId - | Just pkg <- mbPkg = do - let shared = elaboratedShared buildCtx - install = elaboratedPlanOriginal buildCtx - dirLayout = distDirLayout baseCtx - buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) - flags = setupHsBuildFlags pkg shared verbosity buildDir - args = setupHsBuildArgs pkg - srcDir = case (elabPkgSourceLocation pkg) of - LocalUnpackedPackage fp -> fp - _ -> "" - scriptOptions = setupHsScriptOptions - (ReadyPackage pkg) - install - shared - dirLayout - srcDir - buildDir - False - lock - configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir - configureArgs = setupHsConfigureArgs pkg - --Configure the package if there's no existing config - lbi <- tryGetPersistBuildConfig buildDir - case lbi of - Left _ -> setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.configureCommand defaultProgramDb) - (const $ configureFlags) - (const configureArgs) - Right _ -> pure () - setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.showBuildInfoCommand defaultProgramDb) - (const flags) - (const args) - where mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs - --- | This defines what a 'TargetSelector' means for the @write-autogen-files@ command. + targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + doShowInfo :: FilePath -> UnitId -> IO () + doShowInfo dir unitId = + showInfo + (dir unitIdToFilePath unitId) + verbosity + baseCtx + buildCtx + lock + configured + unitId + + outputResult :: FilePath -> (String -> IO ()) -> [UnitId] -> IO () + outputResult dir printer units = do + let unroll [] = return () + unroll [x] = do + content <- readFile (dir unitIdToFilePath x) + printer content + unroll (x:xs) = do + content <- readFile (dir unitIdToFilePath x) + printer content + printer "," + unroll xs + printer "[" + unroll units + printer "]" + + unitIdToFilePath :: UnitId -> FilePath + unitIdToFilePath unitId = "build-info-" ++ display unitId ++ ".json" + +showInfo :: FilePath -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () +showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = + case mbPkg of + Nothing -> die' verbosity $ "No unit " ++ display targetUnitId + Just pkg -> do + let shared = elaboratedShared buildCtx + install = elaboratedPlanOriginal buildCtx + dirLayout = distDirLayout baseCtx + buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) + buildType' = buildType (elabPkgDescription pkg) + flags = setupHsBuildFlags pkg shared verbosity buildDir + args = setupHsBuildArgs pkg + srcDir = case (elabPkgSourceLocation pkg) of + LocalUnpackedPackage fp -> fp + _ -> "" + scriptOptions = setupHsScriptOptions + (ReadyPackage pkg) + install + shared + dirLayout + srcDir + buildDir + False + lock + configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir + configureArgs = setupHsConfigureArgs pkg + + -- Check cabal version is correct + (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions + (elabPkgDescription pkg) buildType' + when (cabalVersion < mkVersion [3, 0, 0, 0]) + ( die' verbosity $ "Only a Cabal version >= 3.0.0.0 is supported for this command.\n" + ++ "Found version: " ++ display cabalVersion ++ "\n" + ++ "For component: " ++ display targetUnitId + ) + -- Configure the package if there's no existing config + lbi <- tryGetPersistBuildConfig buildDir + case lbi of + Left _ -> setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.configureCommand defaultProgramDb) + (const configureFlags) + (const configureArgs) + Right _ -> pure () + + setupWrapper + verbosity + scriptOptions + (Just $ elabPkgDescription pkg) + (Cabal.showBuildInfoCommand defaultProgramDb) + (const (Cabal.ShowBuildInfoFlags + { Cabal.buildInfoBuildFlags = flags + , Cabal.buildInfoOutputFile = Just fileOutput + } + ) + ) + (const args) + where + mbPkg :: Maybe ElaboratedConfiguredPackage + mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs + +-- | This defines what a 'TargetSelector' means for the @show-build-info@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, -- or otherwise classifies the problem. -- --- For the @write-autogen-files@ command select all components except non-buildable and disabled +-- For the @show-build-info@ command select all components except non-buildable and disabled -- tests\/benchmarks, fail if there are no such components -- selectPackageTargets :: TargetSelector @@ -219,7 +290,7 @@ selectPackageTargets targetSelector targets -- | For a 'TargetComponent' 'TargetSelector', check if the component can be -- selected. -- --- For the @build@ command we just need the basic checks on being buildable etc. +-- For the @show-build-info@ command we just need the basic checks on being buildable etc. -- selectComponentTarget :: SubComponentTarget -> AvailableTarget k -> Either TargetProblem k @@ -229,7 +300,7 @@ selectComponentTarget subtarget = -- | The various error conditions that can occur when matching a --- 'TargetSelector' against 'AvailableTarget's for the @build@ command. +-- 'TargetSelector' against 'AvailableTarget's for the @show-build-info@ command. -- data TargetProblem = TargetProblemCommon TargetProblemCommon @@ -247,8 +318,8 @@ reportTargetProblems verbosity = renderTargetProblem :: TargetProblem -> String renderTargetProblem (TargetProblemCommon problem) = - renderTargetProblemCommon "build" problem + renderTargetProblemCommon "show-build-info" problem renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = - renderTargetProblemNoneEnabled "build" targetSelector targets + renderTargetProblemNoneEnabled "show-build-info" targetSelector targets renderTargetProblem(TargetProblemNoTargets targetSelector) = - renderTargetProblemNoTargets "build" targetSelector \ No newline at end of file + renderTargetProblemNoTargets "show-build-info" targetSelector diff --git a/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs b/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs deleted file mode 100644 index 86a80b6fa53..00000000000 --- a/cabal-install/src/Distribution/Client/CmdWriteAutogenFiles.hs +++ /dev/null @@ -1,220 +0,0 @@ --- | cabal-install CLI command: build --- -module Distribution.Client.CmdWriteAutogenFiles ( - -- * The @build@ CLI and action - writeAutogenFilesCommand, - writeAutogenFilesAction - ) where - -import Distribution.Client.ProjectOrchestration -import Distribution.Client.CmdErrorMessages -import Distribution.Client.CmdInstall.ClientInstallFlags - -import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags, WriteAutogenFilesFlags(..) ) -import qualified Distribution.Client.Setup as Client -import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault, Flag(..), TestFlags ) -import Distribution.Simple.Command - ( CommandUI(..), usageAlternatives ) -import Distribution.Verbosity - ( Verbosity, normal ) -import Distribution.Simple.Utils - ( wrapText, die' ) -import Distribution.Simple.Configure (tryGetPersistBuildConfig) - -import qualified Data.Map as Map -import qualified Distribution.Simple.Setup as Cabal -import Distribution.Client.SetupWrapper -import Distribution.Simple.Program ( defaultProgramDb ) -import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.Client.ProjectPlanning.Types -import Distribution.Client.ProjectPlanning ( - setupHsScriptOptions, setupHsConfigureFlags, setupHsConfigureArgs - ) -import Distribution.Client.DistDirLayout (distBuildDirectory) -import Distribution.Client.Types ( PackageLocation(..), GenericReadyPackage(..) ) -import Distribution.Client.JobControl (newLock, Lock) - -writeAutogenFilesCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -writeAutogenFilesCommand = Client.installCommand { - commandName = "new-write-autogen-files", - commandSynopsis = "", - commandUsage = usageAlternatives "new-write-autogen-files" [ "[FLAGS]" ], - commandDescription = Just $ \_ -> wrapText $ - "Generate and write out the Paths_.hs and cabal_macros.h files\n" - ++ "for all components in the project", - commandNotes = Just $ \pname -> - "Examples:\n" - ++ " " ++ pname ++ " new-write-autogen-files\n" - ++ " Write for all packages in the project\n" - } - -writeAutogenFilesAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) - -> [String] -> GlobalFlags -> IO () -writeAutogenFilesAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags) - targetStrings globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig - let baseCtx' = baseCtx { - buildSettings = (buildSettings baseCtx) { - buildSettingDryRun = True - } - } - targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings - - buildCtx <- - runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do - -- Interpret the targets on the command line as build targets - -- (as opposed to say repl or haddock targets). - targets <- either (reportTargetProblems verbosity) return - $ resolveTargets - selectPackageTargets - selectComponentTarget - TargetProblemCommon - elaboratedPlan - Nothing - targetSelectors - - let elaboratedPlan' = pruneInstallPlanToTargets - TargetActionBuild - targets - elaboratedPlan - elaboratedPlan'' <- - if buildSettingOnlyDeps (buildSettings baseCtx') - then either (reportCannotPruneDependencies verbosity) return $ - pruneInstallPlanToDependencies (Map.keysSet targets) - elaboratedPlan' - else return elaboratedPlan' - - return (elaboratedPlan'', targets) - - scriptLock <- newLock - writeAutogenFiles verbosity baseCtx' buildCtx scriptLock (configured buildCtx) - - where - verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig - globalFlags configFlags configExFlags - installFlags defaultClientInstallFlags - haddockFlags - testFlags - configured ctx = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanToExecute ctx)] - - -writeAutogenFiles :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> IO () -writeAutogenFiles verbosity baseCtx buildCtx lock pkgs = mapM_ runWrapper pkgs - where runWrapper pkg = do - let shared = elaboratedShared buildCtx - install = elaboratedPlanOriginal buildCtx - dirLayout = distDirLayout baseCtx - buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) - srcDir = case (elabPkgSourceLocation pkg) of - LocalUnpackedPackage fp -> fp - _ -> "" - scriptOptions = setupHsScriptOptions - (ReadyPackage pkg) - install - shared - dirLayout - srcDir - buildDir - False - lock - configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir - configureArgs = setupHsConfigureArgs pkg - --Configure the package if there's no existing config, - lbi <- tryGetPersistBuildConfig buildDir - case lbi of - Left _ -> setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.configureCommand defaultProgramDb) - (const $ configureFlags) - (const configureArgs) - Right _ -> pure () - setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.writeAutogenFilesCommand defaultProgramDb) - (const $ WriteAutogenFilesFlags (Flag buildDir) (Flag verbosity)) - (const []) - --- | This defines what a 'TargetSelector' means for the @write-autogen-files@ command. --- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, --- or otherwise classifies the problem. --- --- For the @write-autogen-files@ command select all components except non-buildable and disabled --- tests\/benchmarks, fail if there are no such components --- -selectPackageTargets :: TargetSelector - -> [AvailableTarget k] -> Either TargetProblem [k] -selectPackageTargets targetSelector targets - - -- If there are any buildable targets then we select those - | not (null targetsBuildable) - = Right targetsBuildable - - -- If there are targets but none are buildable then we report those - | not (null targets) - = Left (TargetProblemNoneEnabled targetSelector targets') - - -- If there are no targets at all then we report that - | otherwise - = Left (TargetProblemNoTargets targetSelector) - where - targets' = forgetTargetsDetail targets - targetsBuildable = selectBuildableTargetsWith - (buildable targetSelector) - targets - - -- When there's a target filter like "pkg:tests" then we do select tests, - -- but if it's just a target like "pkg" then we don't build tests unless - -- they are requested by default (i.e. by using --enable-tests) - buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False - buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False - buildable _ _ = True - --- | For a 'TargetComponent' 'TargetSelector', check if the component can be --- selected. --- --- For the @build@ command we just need the basic checks on being buildable etc. --- -selectComponentTarget :: SubComponentTarget - -> AvailableTarget k -> Either TargetProblem k -selectComponentTarget subtarget = - either (Left . TargetProblemCommon) Right - . selectComponentTargetBasic subtarget - - --- | The various error conditions that can occur when matching a --- 'TargetSelector' against 'AvailableTarget's for the @build@ command. --- -data TargetProblem = - TargetProblemCommon TargetProblemCommon - - -- | The 'TargetSelector' matches targets but none are buildable - | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] - - -- | There are no targets at all - | TargetProblemNoTargets TargetSelector - deriving (Eq, Show) - -reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a -reportTargetProblems verbosity = - die' verbosity . unlines . map renderTargetProblem - -renderTargetProblem :: TargetProblem -> String -renderTargetProblem (TargetProblemCommon problem) = - renderTargetProblemCommon "build" problem -renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = - renderTargetProblemNoneEnabled "build" targetSelector targets -renderTargetProblem(TargetProblemNoTargets targetSelector) = - renderTargetProblemNoTargets "build" targetSelector - -reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a -reportCannotPruneDependencies verbosity = - die' verbosity . renderCannotPruneDependencies - diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 8ed6498aae1..50e1efa3374 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -48,10 +48,7 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand - - --ghc-mod support commands - , showBuildInfoCommand - , writeAutogenFilesCommand, WriteAutogenFilesFlags(..) + --, showBuildInfoCommand , parsePackageArgs , liftOptions , yesNoOpt @@ -100,7 +97,6 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..) , CopyFlags(..), RegisterFlags(..) - , WriteAutogenFilesFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -184,7 +180,6 @@ globalCommand commands = CommandUI { , "haddock" , "hscolour" , "show-build-info" - , "write-autogen-files" , "exec" , "new-build" , "new-configure" @@ -272,7 +267,6 @@ globalCommand commands = CommandUI { , addCmd "report" , par , addCmd "show-build-info" - , addCmd "write-autogen-files" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -810,25 +804,6 @@ filterTestFlags flags cabalLibVersion Cabal.testWrapper = NoFlag } --- ------------------------------------------------------------ --- * show-build-info command --- ------------------------------------------------------------ - -showBuildInfoCommand :: CommandUI (BuildFlags, BuildExFlags) -showBuildInfoCommand = parent { - commandDefaultFlags = (commandDefaultFlags parent, mempty), - commandOptions = - \showOrParseArgs -> liftOptions fst setFst - (commandOptions parent showOrParseArgs) - ++ - liftOptions snd setSnd (buildExOptions showOrParseArgs) - } - where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - - parent = Cabal.showBuildInfoCommand defaultProgramDb - -- ------------------------------------------------------------ -- * Repl command -- ------------------------------------------------------------ @@ -2503,10 +2478,10 @@ relevantConfigValuesText vs = -- ------------------------------------------------------------ --- * Commands to support ghc-mod +-- * Commands to support show-build-info -- ------------------------------------------------------------ -showBuildInfoCommand :: CommandUI (BuildFlags, BuildExFlags) +showBuildInfoCommand :: CommandUI (Cabal.ShowBuildInfoFlags, BuildExFlags) showBuildInfoCommand = parent { commandDefaultFlags = (commandDefaultFlags parent, mempty), commandOptions = @@ -2520,6 +2495,3 @@ showBuildInfoCommand = parent { setSnd b (a,_) = (a,b) parent = Cabal.showBuildInfoCommand defaultProgramDb - -writeAutogenFilesCommand :: CommandUI WriteAutogenFilesFlags -writeAutogenFilesCommand = Cabal.writeAutogenFilesCommand defaultProgramDb \ No newline at end of file diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 22ccf021128..464452978fd 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -18,7 +18,7 @@ -- runs it with the given arguments. module Distribution.Client.SetupWrapper ( - getSetup, runSetup, runSetupCommand, setupWrapper, + getSetup, runSetup, runSetupCommand, setupWrapper, getSetupMethod, SetupScriptOptions(..), defaultSetupScriptOptions, ) where diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal new file mode 100644 index 00000000000..40f0a570d5a --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -0,0 +1,16 @@ +cabal-version: 2.4 +name: A +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: A + build-depends: base >=4.0.0 + hs-source-dirs: src + default-language: Haskell2010 + +executable A + main-is: Main.hs + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs new file mode 100644 index 00000000000..962cacaf416 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -0,0 +1,20 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["exe:A", "-v0"] + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:A" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" [] (componentModules component) + assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs new file mode 100644 index 00000000000..6c3109019e7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -0,0 +1,44 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withSourceCopy $ do + cwd <- fmap testCurrentDir getTestEnv + let fp = cwd "unit.json" + _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + buildInfos <- decodeBuildInfoFile fp + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:A" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" [] (componentModules component) + assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["A"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs new file mode 100644 index 00000000000..e17f1113720 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -0,0 +1,41 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:A" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" [] (componentModules component) + assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["A"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs new file mode 100644 index 00000000000..9ec29f3c90f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -0,0 +1,41 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:A" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" [] (componentModules component) + assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["A"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out new file mode 100644 index 00000000000..5f6512b4dc9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -0,0 +1,12 @@ +# cabal show-build-info +cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: +'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) +# cabal show-build-info +Resolving dependencies... +cabal: No unit B-inplace-0.1.0.0 +# cabal show-build-info +Configuring library for A-0.1.0.0.. +cabal: No unit B-inplace-0.1.0.0 +# cabal show-build-info +cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: +'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs new file mode 100644 index 00000000000..b07607b3779 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs @@ -0,0 +1,14 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + r <- fails $ cabal' "show-build-info" ["exe:B"] + assertOutputContains "Internal error in target matching." r + + r <- fails $ cabal' "show-build-info" ["--unit-ids-json=B-inplace-0.1.0.0"] + assertOutputContains "No unit B-inplace-0.1.0.0" r + + r <- fails $ cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace B-inplace-0.1.0.0"] + assertOutputContains "No unit B-inplace-0.1.0.0" r + + r <- fails $ cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace", "exe:B"] + assertOutputContains "Internal error in target matching." r diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs new file mode 100644 index 00000000000..ad7a0c07729 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs @@ -0,0 +1,4 @@ +module A where + +foo :: Int -> Int +foo = id \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs new file mode 100644 index 00000000000..65ae4a05d5d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal new file mode 100644 index 00000000000..5536cc34c4d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.4 +name: B +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: A + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs new file mode 100644 index 00000000000..3c32164830f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -0,0 +1,20 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["lib:B", "-v0"] + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "B-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["A"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs new file mode 100644 index 00000000000..6b02eec8ec0 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs @@ -0,0 +1,4 @@ +module A where + +foo :: Int -> Int +foo = id diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal new file mode 100644 index 00000000000..db2a4c566d8 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -0,0 +1,48 @@ +cabal-version: 2.4 +name: Complex +version: 0.1.0.0 +license: MIT + +library + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: Lib + other-modules: Paths_complex + + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + +executable Complex + main-is: Main.lhs + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + other-modules: Paths_complex + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints + -with-rtsopts=-T + +test-suite unit-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: hspec + main-is: Main.hs + +test-suite func-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: hspec + main-is: Main.hs + +benchmark complex-benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_complex + hs-source-dirs: + benchmark + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + base + , criterion + , Complex + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs new file mode 100644 index 00000000000..7d0560321a4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -0,0 +1,36 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["exe:Complex", "-v0"] + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:Complex" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace-Complex" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertBool "Component ghc-options contains all specified in .cabal" + (all + (`elem` componentCompilerArgs component) + [ "-threaded" + , "-rtsopts" + , "-with-rtsopts=-N" + , "-with-rtsopts=-T" + , "-Wredundant-constraints" + ] + ) + assertBool "Component ghc-options does not contain -Wall" + (all + (`notElem` componentCompilerArgs component) + [ "-Wall" + ] + ) + assertEqual "Component modules" ["Paths_complex"] (componentModules component) + assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs new file mode 100644 index 00000000000..76dbc720543 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -0,0 +1,35 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfos <- runShowBuildInfo ["lib:Complex", "-v0"] + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly one" 1 (length $ components buildInfo) + let [component] = components buildInfo + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertBool "Component ghc-options contains all specified in .cabal" + (all + (`elem` componentCompilerArgs component) + [ "-threaded" + , "-rtsopts" + , "-with-rtsopts=-N" + , "-Wall" + ] + ) + assertBool "Component ghc-options does not contain -Wredundant-constraints" + (all + (`notElem` componentCompilerArgs component) + [ "-Wredundant-constraints" + ] + ) + assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs new file mode 100644 index 00000000000..5d35e3e9617 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs @@ -0,0 +1,4 @@ +module Lib where + +foo :: Int -> Int +foo = (+1) \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs new file mode 100644 index 00000000000..a1b75006b8d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs @@ -0,0 +1,9 @@ +module Main where + +import Lib + +main :: IO () +main = do + let i = foo 5 + putStrLn "Hello, Haskell!" + print i diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 46f111e0c94..322175f9d75 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -39,6 +39,7 @@ library hs-source-dirs: src exposed-modules: Test.Cabal.CheckArMetadata + Test.Cabal.DecodeShowBuildInfo Test.Cabal.Monad Test.Cabal.OutputNormalizer Test.Cabal.Plan diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs new file mode 100644 index 00000000000..daa552fa754 --- /dev/null +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveGeneric #-} +module Test.Cabal.DecodeShowBuildInfo where + +import Test.Cabal.Prelude +import qualified Distribution.Simple.Utils as U (cabalVersion) +import Distribution.Text (display) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +runShowBuildInfo :: [String] -> TestM [BuildInfo] +runShowBuildInfo args = do + r <- cabal' "show-build-info" args + case eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) of + Left err -> fail $ "Could not parse show-build-info command: " ++ err + Right buildInfos -> return buildInfos + +decodeBuildInfoFile :: FilePath -> TestM [BuildInfo] +decodeBuildInfoFile fp = do + shouldExist fp + res <- liftIO $ eitherDecodeFileStrict fp + case res of + Left err -> fail $ "Could not parse show-build-info file: " ++ err + Right buildInfos -> return buildInfos + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } + +cabalVersionLibrary :: String +cabalVersionLibrary = display U.cabalVersion diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 7a5245415ed..37ccc1f5ea3 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -29,7 +29,7 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.System (OS(Windows,Linux,OSX), buildOS) import Distribution.Simple.Utils - ( withFileContents, withTempDirectory, tryFindPackageDesc ) + ( withFileContents, withTempDirectory, tryFindPackageDesc) import Distribution.Simple.Configure ( getPersistBuildConfig ) import Distribution.Version From decae3b381384dc77723dce2a835a15c34d7a3d8 Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 12 Jul 2021 09:37:03 +0200 Subject: [PATCH 04/11] Rework show-build-info command to avoid wrapper This means that cabal-install now extracts the LocalBuildInfo etc. itself for each component, and now assembles the JSON without the need for writing to temporary files. It also means that one build info JSON object can be returned instead of an array. It works by configuring each component separately as before, and instead of making its own build info object, it just collects the component information. This one build info object now reports the compiler used with the ElaboratedSharedConfig, which is shared across all components. Fix haddock parsing in TargetProblem Build dependencies in show-build-info Update .prod/.zinz templates Silence Haddock output --- Cabal/Cabal.cabal | 2 +- Cabal/src/Distribution/Simple/Build.hs | 2 +- .../src/Distribution/Simple/ShowBuildInfo.hs | 117 +++++------ Cabal/src/Distribution/Simple/Utils/Json.hs | 10 +- cabal-install/main/Main.hs | 17 -- .../Distribution/Client/CmdShowBuildInfo.hs | 184 ++++++++---------- .../src/Distribution/Client/Setup.hs | 18 +- .../PackageTests/ShowBuildInfo/A/A.cabal | 11 +- .../ShowBuildInfo/A/build-info-all.out | 1 + .../ShowBuildInfo/A/build-info-all.test.hs | 9 + .../A/build-info-exe-exact.test.hs | 4 +- ...d-info-multiple-exact-unit-id-file.test.hs | 30 ++- .../build-info-multiple-exact-unit-id.test.hs | 29 +-- .../A/build-info-multiple-exact.test.hs | 29 +-- .../PackageTests/ShowBuildInfo/A/src/Test.hs | 1 + .../PackageTests/ShowBuildInfo/B/B.cabal | 2 +- .../B/build-info-lib-exact.test.hs | 4 +- .../ShowBuildInfo/B/cabal.project | 1 + .../ShowBuildInfo/Complex/exe.test.hs | 4 +- .../ShowBuildInfo/Complex/lib.test.hs | 4 +- .../src/Test/Cabal/DecodeShowBuildInfo.hs | 4 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 22 files changed, 217 insertions(+), 268 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 1adb417f008..f9d4f129ad5 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -257,6 +257,7 @@ library Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress + Distribution.Utils.Json Distribution.Verbosity Distribution.Verbosity.Internal Distribution.Version @@ -337,7 +338,6 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo - Distribution.Simple.Utils.Json Distribution.ZinzaPrelude Paths_Cabal diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index c5963c733ab..a4d04ff3350 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -31,6 +31,7 @@ module Distribution.Simple.Build ( import Prelude () import Distribution.Compat.Prelude import Distribution.Utils.Generic +import Distribution.Utils.Json import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec @@ -77,7 +78,6 @@ import Distribution.Simple.Configure import Distribution.Simple.Register import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils -import Distribution.Simple.Utils.Json import Distribution.System import Distribution.Pretty diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index fb37327229a..23b56edbe40 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -54,7 +54,8 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- -module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where +module Distribution.Simple.ShowBuildInfo + ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where import Distribution.Compat.Prelude import Prelude () @@ -70,7 +71,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils (cabalVersion) -import Distribution.Simple.Utils.Json +import Distribution.Utils.Json import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty @@ -84,63 +85,69 @@ mkBuildInfo -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = info - where - targetToNameAndLBI target = - (componentLocalName $ targetCLBI target, targetCLBI target) - componentsToBuild = map targetToNameAndLBI targetsToBuild - (.=) :: String -> Json -> (String, Json) - k .= v = (k, v) +mkBuildInfo pkg_descr lbi _flags targetsToBuild = + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo pkg_descr lbi . targetCLBI) targetsToBuild) - info = JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) - , "compiler" .= mkCompilerInfo - , "components" .= JsonArray (map mkComponentInfo componentsToBuild) - ] +-- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and +-- 'mkComponentInfo' yourself. +mkBuildInfo' + :: Json -- ^ The 'Json' from 'mkCompilerInfo' + -> [Json] -- ^ The 'Json' from 'mkComponentInfo' + -> Json +mkBuildInfo' cmplrInfo componentInfos = + JsonObject + [ "cabal-version" .= JsonString (display cabalVersion) + , "compiler" .= cmplrInfo + , "components" .= JsonArray componentInfos + ] - mkCompilerInfo = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi) - , "compiler-id" .= JsonString (showCompilerId $ compiler lbi) - , "path" .= path - ] - where - path = maybe JsonNull (JsonString . programPath) - $ (flavorToProgram . compilerFlavor $ compiler lbi) - >>= flip lookupProgram (withPrograms lbi) +mkCompilerInfo :: ProgramDb -> Compiler -> Json +mkCompilerInfo programDb cmplr = JsonObject + [ "flavour" .= JsonString (prettyShow $ compilerFlavor cmplr) + , "compiler-id" .= JsonString (showCompilerId cmplr) + , "path" .= path + ] + where + path = maybe JsonNull (JsonString . programPath) + $ (flavorToProgram . compilerFlavor $ cmplr) + >>= flip lookupProgram programDb - flavorToProgram :: CompilerFlavor -> Maybe Program - flavorToProgram GHC = Just ghcProgram - flavorToProgram GHCJS = Just ghcjsProgram - flavorToProgram UHC = Just uhcProgram - flavorToProgram JHC = Just jhcProgram - flavorToProgram _ = Nothing + flavorToProgram :: CompilerFlavor -> Maybe Program + flavorToProgram GHC = Just ghcProgram + flavorToProgram GHCJS = Just ghcjsProgram + flavorToProgram UHC = Just uhcProgram + flavorToProgram JHC = Just jhcProgram + flavorToProgram _ = Nothing - mkComponentInfo (name, clbi) = JsonObject - [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) - , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) - , "modules" .= JsonArray (map (JsonString . display) modules) - , "src-files" .= JsonArray (map JsonString sourceFiles) - , "src-dirs" .= JsonArray (map JsonString $ map getSymbolicPath $ hsSourceDirs bi) - ] - where - bi = componentBuildInfo comp - comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name - compType = case comp of - CLib _ -> "lib" - CExe _ -> "exe" - CTest _ -> "test" - CBench _ -> "bench" - CFLib _ -> "flib" - modules = case comp of - CLib lib -> explicitLibModules lib - CExe exe -> exeModules exe - _ -> [] - sourceFiles = case comp of - CLib _ -> [] - CExe exe -> [modulePath exe] - _ -> [] +mkComponentInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo pkg_descr lbi clbi = JsonObject + [ "type" .= JsonString compType + , "name" .= JsonString (prettyShow name) + , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) + , "modules" .= JsonArray (map (JsonString . display) modules) + , "src-files" .= JsonArray (map JsonString sourceFiles) + , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi) + ] + where + name = componentLocalName clbi + bi = componentBuildInfo comp + comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name + compType = case comp of + CLib _ -> "lib" + CExe _ -> "exe" + CTest _ -> "test" + CBench _ -> "bench" + CFLib _ -> "flib" + modules = case comp of + CLib lib -> explicitLibModules lib + CExe exe -> exeModules exe + _ -> [] + sourceFiles = case comp of + CLib _ -> [] + CExe exe -> [modulePath exe] + _ -> [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component. diff --git a/Cabal/src/Distribution/Simple/Utils/Json.hs b/Cabal/src/Distribution/Simple/Utils/Json.hs index f90f2f38aa2..ba918b74880 100644 --- a/Cabal/src/Distribution/Simple/Utils/Json.hs +++ b/Cabal/src/Distribution/Simple/Utils/Json.hs @@ -1,7 +1,8 @@ --- | Utility json lib for Cabal --- TODO: Remove it again. -module Distribution.Simple.Utils.Json +-- | Extremely simple JSON helper. Don't do anything too fancy with this! + +module Distribution.Utils.Json ( Json(..) + , (.=) , renderJson ) where @@ -44,3 +45,6 @@ intercalate sep = go go [] = id go [x] = x go (x:xs) = x . showString' sep . go xs + +(.=) :: String -> Json -> (String, Json) +k .= v = (k, v) diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 8d3640dd845..2a2ab6b858e 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -381,23 +381,6 @@ buildAction buildFlags extraArgs globalFlags = do nixShell verbosity distPref globalFlags config $ do build verbosity config' distPref buildFlags extraArgs -buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do - let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) - noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags - distPref <- findSavedDistPref config (buildDistPref buildFlags) - -- Calls 'configureAction' to do the real work, so nothing special has to be - -- done to support sandboxes. - config' <- - reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags) - mempty [] globalFlags config - nixShell verbosity distPref globalFlags config $ do - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config' distPref buildFlags extraArgs - -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index 98e0a72f855..0ef119e7c95 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} -- | cabal-install CLI command: show-build-info -- module Distribution.Client.CmdShowBuildInfo ( @@ -13,36 +14,34 @@ import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) -import qualified Distribution.Client.Setup as Client + ( GlobalFlags ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, BenchmarkFlags - , fromFlagOrDefault ) + (Flag(..), haddockVerbosity, configVerbosity, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die', withTempDirectory ) + ( wrapText, die' ) import Distribution.Types.UnitId ( UnitId, mkUnitId ) import Distribution.Types.Version ( mkVersion ) import Distribution.Types.PackageDescription ( buildType ) -import Distribution.Deprecated.Text - ( display ) +import Distribution.Pretty + ( prettyShow ) import qualified Data.Map as Map import qualified Distribution.Simple.Setup as Cabal import Distribution.Client.SetupWrapper -import Distribution.Simple.Program - ( defaultProgramDb ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectPlanning ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags - , setupHsBuildArgs, setupHsScriptOptions ) + , setupHsScriptOptions ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout ( distBuildDirectory ) import Distribution.Client.Types @@ -50,16 +49,19 @@ import Distribution.Client.Types import Distribution.Client.JobControl ( newLock, Lock ) import Distribution.Simple.Configure - ( tryGetPersistBuildConfig ) -import qualified Distribution.Client.CmdInstall as CmdInstall + (getPersistBuildConfig, tryGetPersistBuildConfig ) -import System.Directory - ( getTemporaryDirectory ) -import System.FilePath - ( () ) +import Distribution.Simple.ShowBuildInfo +import Distribution.Utils.Json -showBuildInfoCommand :: CommandUI ShowBuildInfoFlags -showBuildInfoCommand = CmdInstall.installCommand { +import Distribution.Simple.BuildTarget (readTargetInfos) +import Distribution.Types.LocalBuildInfo (neededTargetsInBuildOrder') +import Distribution.Compat.Graph (IsNode(nodeKey)) +import Distribution.Simple.Setup (BuildFlags(buildArgs)) +import Distribution.Types.TargetInfo (TargetInfo(targetCLBI)) + +showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) +showBuildInfoCommand = CommandUI { commandName = "show-build-info", commandSynopsis = "Show project build information", commandUsage = usageAlternatives "show-build-info" [ "[TARGETS] [FLAGS]" ], @@ -75,9 +77,7 @@ showBuildInfoCommand = CmdInstall.installCommand { ++ " " ++ pname ++ " show-build-info ./pkgname \n" ++ " Shows build information about the package located in './pkgname'\n" ++ cmdCommonHelpTextNewBuildBeta, - commandOptions = \showOrParseArgs -> - Client.liftOptions buildInfoInstallCommandFlags (\pf flags -> flags { buildInfoInstallCommandFlags = pf }) (commandOptions CmdInstall.installCommand showOrParseArgs) - ++ + commandOptions = nixStyleOptions $ \_ -> [ option [] ["buildinfo-json-output"] "Write the result to the given file instead of stdout" buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) @@ -87,28 +87,25 @@ showBuildInfoCommand = CmdInstall.installCommand { buildInfoUnitIds (\pf flags -> flags { buildInfoUnitIds = pf }) (reqArg' "UNIT-ID" (Just . words) (fromMaybe [])) ], - commandDefaultFlags = defaultShowBuildInfoFlags - - } + commandDefaultFlags = defaultNixStyleFlags defaultShowBuildInfoFlags + } data ShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoInstallCommandFlags :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, BenchmarkFlags, ClientInstallFlags) - , buildInfoOutputFile :: Maybe FilePath + { buildInfoOutputFile :: Maybe FilePath , buildInfoUnitIds :: Maybe [String] } defaultShowBuildInfoFlags :: ShowBuildInfoFlags defaultShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty) - , buildInfoOutputFile = Nothing + { buildInfoOutputFile = Nothing , buildInfoUnitIds = Nothing } -- | The @show-build-info@ exports information about a package and the compiler -- configuration used to build it as JSON, that can be used by other tooling. -- See "Distribution.Simple.ShowBuildInfo" for more information. -showBuildInfoAction :: ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () -showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, benchmarkFlags, clientInstallFlags) fileOutput unitIds) +showBuildInfoAction :: NixStyleFlags ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () +showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput unitIds), ..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand let baseCtx' = baseCtx @@ -116,83 +113,67 @@ showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlag } targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings + =<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do -- Interpret the targets on the command line as build targets -- (as opposed to say repl or haddock targets). - targets <- either (reportTargetProblems verbosity) return + targets <- either (reportShowBuildInfoTargetProblems verbosity) return $ resolveTargets selectPackageTargets selectComponentTarget - TargetProblemCommon elaboratedPlan Nothing targetSelectors - -- Don't prune the plan though, as we want a list of all configured packages - return (elaboratedPlan, targets) + let elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuild + targets + elaboratedPlan + + -- This will be the build plan for building the dependencies required. + elaboratedPlan'' <- either (die' verbosity . renderCannotPruneDependencies) return + $ pruneInstallPlanToDependencies + (Map.keysSet targets) elaboratedPlan' + + return (elaboratedPlan'', targets) + + buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx + runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes scriptLock <- newLock showTargets fileOutput unitIds verbosity baseCtx' buildCtx scriptLock where -- Default to silent verbosity otherwise it will pollute our json output verbosity = fromFlagOrDefault silent (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig - globalFlags configFlags configExFlags - installFlags clientInstallFlags - haddockFlags - testFlags - benchmarkFlags - --- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks + -- Also shut up haddock since it dumps warnings to stdout + flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } } + cliConfig = commandLineFlagsToProjectConfig globalFlags flags' + mempty -- ClientInstallFlags, not needed here + showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do - tempDir <- getTemporaryDirectory - withTempDirectory verbosity tempDir "show-build-info" $ \dir -> do - mapM_ (doShowInfo dir) targets - case fileOutput of - Nothing -> outputResult dir putStr targets - Just fp -> do - writeFile fp "" - outputResult dir (appendFile fp) targets - - where configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds - doShowInfo :: FilePath -> UnitId -> IO () - doShowInfo dir unitId = - showInfo - (dir unitIdToFilePath unitId) - verbosity - baseCtx - buildCtx - lock - configured - unitId - - outputResult :: FilePath -> (String -> IO ()) -> [UnitId] -> IO () - outputResult dir printer units = do - let unroll [] = return () - unroll [x] = do - content <- readFile (dir unitIdToFilePath x) - printer content - unroll (x:xs) = do - content <- readFile (dir unitIdToFilePath x) - printer content - printer "," - unroll xs - printer "[" - unroll units - printer "]" - - unitIdToFilePath :: UnitId -> FilePath - unitIdToFilePath unitId = "build-info-" ++ display unitId ++ ".json" - -showInfo :: FilePath -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () -showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = + let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] + targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + + components <- concat <$> mapM (getComponentInfo verbosity baseCtx buildCtx + lock configured) targets + + let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) + + json = mkBuildInfo' compilerInfo components + res = renderJson json "" + + case fileOutput of + Nothing -> putStrLn res + Just fp -> writeFile fp res + +getComponentInfo :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO [Json] +getComponentInfo verbosity baseCtx buildCtx lock pkgs targetUnitId = case mbPkg of - Nothing -> die' verbosity $ "No unit " ++ display targetUnitId + Nothing -> die' verbosity $ "No unit " ++ prettyShow targetUnitId Just pkg -> do let shared = elaboratedShared buildCtx install = elaboratedPlanOriginal buildCtx @@ -200,7 +181,6 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) buildType' = buildType (elabPkgDescription pkg) flags = setupHsBuildFlags pkg shared verbosity buildDir - args = setupHsBuildArgs pkg srcDir = case (elabPkgSourceLocation pkg) of LocalUnpackedPackage fp -> fp _ -> "" @@ -221,33 +201,29 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = (elabPkgDescription pkg) buildType' when (cabalVersion < mkVersion [3, 0, 0, 0]) ( die' verbosity $ "Only a Cabal version >= 3.0.0.0 is supported for this command.\n" - ++ "Found version: " ++ display cabalVersion ++ "\n" - ++ "For component: " ++ display targetUnitId + ++ "Found version: " ++ prettyShow cabalVersion ++ "\n" + ++ "For component: " ++ prettyShow targetUnitId ) -- Configure the package if there's no existing config - lbi <- tryGetPersistBuildConfig buildDir - case lbi of + lbi' <- tryGetPersistBuildConfig buildDir + case lbi' of Left _ -> setupWrapper verbosity scriptOptions (Just $ elabPkgDescription pkg) - (Cabal.configureCommand defaultProgramDb) + (Cabal.configureCommand + (pkgConfigCompilerProgs (elaboratedShared buildCtx))) (const configureFlags) (const configureArgs) Right _ -> pure () - setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.showBuildInfoCommand defaultProgramDb) - (const (Cabal.ShowBuildInfoFlags - { Cabal.buildInfoBuildFlags = flags - , Cabal.buildInfoOutputFile = Just fileOutput - } - ) - ) - (const args) + -- Do the bit the Cabal library would normally do here + lbi <- getPersistBuildConfig buildDir + let pkgDesc = elabPkgDescription pkg + targets <- readTargetInfos verbosity pkgDesc lbi (buildArgs flags) + let targetsToBuild = neededTargetsInBuildOrder' pkgDesc lbi (map nodeKey targets) + return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild + where mbPkg :: Maybe ElaboratedConfiguredPackage mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 50e1efa3374..a5e74cf3009 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -48,8 +48,7 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand - --, showBuildInfoCommand - , parsePackageArgs + , liftOptions , yesNoOpt ) where @@ -97,6 +96,7 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..) , CopyFlags(..), RegisterFlags(..) + , ShowBuildInfoFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -2453,7 +2453,7 @@ usageFlags name pname = -- ------------------------------------------------------------ -- * Repo helpers --- ------------------------------------------------------------ +-- ------------------------------------------------------------bution/Client/Setup.hs showRemoteRepo :: RemoteRepo -> String showRemoteRepo = prettyShow @@ -2481,17 +2481,11 @@ relevantConfigValuesText vs = -- * Commands to support show-build-info -- ------------------------------------------------------------ -showBuildInfoCommand :: CommandUI (Cabal.ShowBuildInfoFlags, BuildExFlags) +showBuildInfoCommand :: CommandUI ShowBuildInfoFlags showBuildInfoCommand = parent { - commandDefaultFlags = (commandDefaultFlags parent, mempty), + commandDefaultFlags = commandDefaultFlags parent, commandOptions = - \showOrParseArgs -> liftOptions fst setFst - (commandOptions parent showOrParseArgs) - ++ - liftOptions snd setSnd (buildExOptions showOrParseArgs) + \showOrParseArgs -> commandOptions parent showOrParseArgs } where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - parent = Cabal.showBuildInfoCommand defaultProgramDb diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal index 40f0a570d5a..5a1e2977b66 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -5,12 +5,19 @@ license: BSD-3-Clause library exposed-modules: A - build-depends: base >=4.0.0 + build-depends: base >=4 hs-source-dirs: src default-language: Haskell2010 executable A main-is: Main.hs - build-depends: base >=4.0.0.0 + build-depends: base >=4 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite A-tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base >=4 hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs new file mode 100644 index 00000000000..aa2d0142358 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["-v0"] -- hide verbose output so we can parse + let comps = components buildInfo + assertEqual "Components, exactly three" 3 (length comps) + assertEqual "Test components, exactly one" 1 $ + length $ filter (\c -> "test" == componentType c) comps diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs index 962cacaf416..b027fcc15f7 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:A", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:A", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs index 6c3109019e7..8e40ea9bfad 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -5,20 +5,18 @@ main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv let fp = cwd "unit.json" _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - buildInfos <- decodeBuildInfoFile fp - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- decodeBuildInfoFile fp + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly two" 2 (length $ components buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -27,14 +25,8 @@ main = cabalTest $ withSourceCopy $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs index e17f1113720..252f211d1d6 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -2,20 +2,17 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -24,14 +21,8 @@ main = cabalTest $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs index 9ec29f3c90f..35f0fb18547 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -2,20 +2,17 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -24,14 +21,8 @@ main = cabalTest $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs new file mode 100644 index 00000000000..b918ddac664 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs @@ -0,0 +1 @@ +main = putStrLn "testing" diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal index 5536cc34c4d..1400971ae35 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal @@ -5,6 +5,6 @@ license: BSD-3-Clause library exposed-modules: A - build-depends: base >=4.0.0.0 + build-depends: base >=4.0.0.0, A hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs index 3c32164830f..c9aa76a41ab 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["lib:B", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["lib:B", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project index e6fdbadb439..b957b20d5c5 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project @@ -1 +1,2 @@ packages: . + ../A diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index 7d0560321a4..9d8cae95961 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:Complex", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:Complex", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index 76dbc720543..0cae3329d62 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["lib:Complex", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["lib:Complex", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index daa552fa754..35bbc5fb2a8 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -9,14 +9,14 @@ import qualified Data.Text.Encoding as T import Data.Aeson import GHC.Generics -runShowBuildInfo :: [String] -> TestM [BuildInfo] +runShowBuildInfo :: [String] -> TestM BuildInfo runShowBuildInfo args = do r <- cabal' "show-build-info" args case eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) of Left err -> fail $ "Could not parse show-build-info command: " ++ err Right buildInfos -> return buildInfos -decodeBuildInfoFile :: FilePath -> TestM [BuildInfo] +decodeBuildInfoFile :: FilePath -> TestM BuildInfo decodeBuildInfoFile fp = do shouldExist fp res <- liftIO $ eitherDecodeFileStrict fp diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 37ccc1f5ea3..7a5245415ed 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -29,7 +29,7 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.System (OS(Windows,Linux,OSX), buildOS) import Distribution.Simple.Utils - ( withFileContents, withTempDirectory, tryFindPackageDesc) + ( withFileContents, withTempDirectory, tryFindPackageDesc ) import Distribution.Simple.Configure ( getPersistBuildConfig ) import Distribution.Version From a52431485a94372aa54da0a1d168c990fba737ca Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 12 Jul 2021 09:40:24 +0200 Subject: [PATCH 05/11] Generate autogen files --- cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index 0ef119e7c95..2dcd46515bd 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -222,6 +222,12 @@ getComponentInfo verbosity baseCtx buildCtx lock pkgs targetUnitId = let pkgDesc = elabPkgDescription pkg targets <- readTargetInfos verbosity pkgDesc lbi (buildArgs flags) let targetsToBuild = neededTargetsInBuildOrder' pkgDesc lbi (map nodeKey targets) + + -- generate autogen files which will be needed by tooling + flip mapM_ targetsToBuild $ \target -> + componentInitialBuildSteps (Cabal.fromFlag (buildDistPref flags)) + pkgDesc lbi (targetCLBI target) verbosity + return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild where From dfb6f2bafca0a32dd05e95e000fe43911f9b5a3f Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 12 Jul 2021 10:32:22 +0200 Subject: [PATCH 06/11] Rework show-build-info to use ProjectPlanning/Building infrastructure This fixes a lot of edge cases for example where the package db wasn't created at the time of configuring. Manually doing the setup.hs wrapper stuff was hairy. Turns out we do need to keep the show-build-info part inside Cabal as we rely on LocalBuildInfo which can change between versions, and we would need to do this anyway if we wanted to utilise the ProjectPlanning/Building infrastructure. --- Cabal/src/Distribution/Simple.hs | 33 +-- Cabal/src/Distribution/Simple/Build.hs | 24 +- Cabal/src/Distribution/Simple/Setup.hs | 17 +- .../src/Distribution/Simple/ShowBuildInfo.hs | 50 ++-- .../Distribution/Client/CmdShowBuildInfo.hs | 214 ++++-------------- .../Distribution/Client/ProjectBuilding.hs | 53 +++-- .../Client/ProjectBuilding/Types.hs | 9 +- .../Distribution/Client/ProjectPlanning.hs | 27 ++- .../Client/ProjectPlanning/Types.hs | 1 + .../src/Distribution/Client/Setup.hs | 19 +- .../src/Distribution/Client/SetupWrapper.hs | 2 +- .../src/Distribution/Client/Utils.hs | 4 +- .../A/build-info-exe-exact.test.hs | 2 +- ...d-info-multiple-exact-unit-id-file.test.hs | 4 +- .../build-info-multiple-exact-unit-id.test.hs | 4 +- .../A/build-info-multiple-exact.test.hs | 4 +- .../ShowBuildInfo/A/build-info-unknown.out | 1 - .../PackageTests/ShowBuildInfo/A/src/A.hs | 2 +- .../B/build-info-lib-exact.test.hs | 2 +- .../PackageTests/ShowBuildInfo/C/C.cabal | 15 ++ .../PackageTests/ShowBuildInfo/C/Lib.hs | 3 + .../PackageTests/ShowBuildInfo/C/Test.hs | 1 + .../C/build-info-all-internal-deps.out | 1 + .../C/build-info-all-internal-deps.test.hs | 9 + .../ShowBuildInfo/C/cabal.project | 1 + .../ShowBuildInfo/Complex/Complex.cabal | 11 +- .../ShowBuildInfo/Complex/exe.test.hs | 4 +- .../ShowBuildInfo/Complex/lib.test.hs | 4 +- .../PackageTests/ShowBuildInfo/D/D.cabal | 9 + .../PackageTests/ShowBuildInfo/D/D1/D1.cabal | 9 + .../PackageTests/ShowBuildInfo/D/D1/Lib1.hs | 3 + .../PackageTests/ShowBuildInfo/D/Lib.hs | 6 + .../ShowBuildInfo/D/build-info-prune-deps.out | 2 + .../D/build-info-prune-deps.test.hs | 8 + .../ShowBuildInfo/D/cabal.project | 2 + .../src/Test/Cabal/DecodeShowBuildInfo.hs | 5 +- 36 files changed, 294 insertions(+), 271 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index f58d79f0f23..7756afc7e0b 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -107,6 +107,8 @@ import Data.List (unionBy, (\\)) import Distribution.PackageDescription.Parsec +import qualified Data.Text.IO as T + -- | A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the -- action specified on the command line. @@ -263,31 +265,34 @@ buildAction hooks flags args = do hooks flags' { buildArgs = args } args showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO () -showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do - distPref <- findDistPrefOrDefault (buildDistPref flags) - let verbosity = fromFlag $ buildVerbosity flags +showBuildInfoAction hooks flags args = do + let buildFlags = buildInfoBuildFlags flags + distPref <- findDistPrefOrDefault (buildDistPref buildFlags) + let verbosity = fromFlag $ buildVerbosity buildFlags lbi <- getBuildConfig hooks verbosity distPref - let flags' = flags { buildDistPref = toFlag distPref - , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) - } + let buildFlags' = + buildFlags { buildDistPref = toFlag distPref + , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) + } progs <- reconfigurePrograms verbosity - (buildProgramPaths flags') - (buildProgramArgs flags') + (buildProgramPaths buildFlags') + (buildProgramArgs buildFlags') (withPrograms lbi) - pbi <- preBuild hooks args flags' + pbi <- preBuild hooks args buildFlags' let lbi' = lbi { withPrograms = progs } pkg_descr0 = localPkgDescr lbi' pkg_descr = updatePackageDescription pbi pkg_descr0 -- TODO: Somehow don't ignore build hook? - buildInfoString <- showBuildInfo pkg_descr lbi' flags - case fileOutput of - Nothing -> putStr buildInfoString - Just fp -> writeFile fp buildInfoString + buildInfoText <- showBuildInfo pkg_descr lbi' flags + + case buildInfoOutputFile flags of + Nothing -> T.putStr buildInfoText + Just fp -> T.writeFile fp buildInfoText - postBuild hooks args flags' pkg_descr lbi' + postBuild hooks args buildFlags' pkg_descr lbi' replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index a4d04ff3350..2a9ab48b504 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -90,6 +90,7 @@ import Control.Monad import qualified Data.Set as Set import System.FilePath ( (), (<.>), takeDirectory ) import System.Directory ( getCurrentDirectory ) +import qualified Data.Text as Text -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package. @@ -134,15 +135,24 @@ build pkg_descr lbi flags suffixes = do showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file - -> LocalBuildInfo -- ^ Configuration information - -> BuildFlags -- ^ Flags that the user passed to build - -> IO String + -> LocalBuildInfo -- ^ Configuration information + -> ShowBuildInfoFlags -- ^ Flags that the user passed to build + -> IO Text.Text showBuildInfo pkg_descr lbi flags = do - let verbosity = fromFlag (buildVerbosity flags) - targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + let buildFlags = buildInfoBuildFlags flags + verbosity = fromFlag (buildVerbosity buildFlags) + targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs buildFlags) + pwd <- getCurrentDirectory let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) - doc = mkBuildInfo pkg_descr lbi flags targetsToBuild - return $ renderJson doc "" + result + | fromFlag (buildInfoComponentsOnly flags) = + let components = map (mkComponentInfo pwd pkg_descr lbi . targetCLBI) + targetsToBuild + in Text.unlines $ map (flip renderJson mempty) components + | otherwise = + let json = mkBuildInfo pwd pkg_descr lbi buildFlags targetsToBuild + in renderJson json mempty + return result repl :: PackageDescription -- ^ Mostly information from the .cabal file diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 92c4a842697..3a1863ee942 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -2153,15 +2153,18 @@ optionNumJobs get set = -- ------------------------------------------------------------ data ShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoBuildFlags :: BuildFlags - , buildInfoOutputFile :: Maybe FilePath + { buildInfoBuildFlags :: BuildFlags + , buildInfoOutputFile :: Maybe FilePath + , buildInfoComponentsOnly :: Flag Bool + -- ^ If 'True' then only print components, each separated by a newline } deriving (Show, Typeable) defaultShowBuildFlags :: ShowBuildInfoFlags defaultShowBuildFlags = ShowBuildInfoFlags - { buildInfoBuildFlags = defaultBuildFlags - , buildInfoOutputFile = Nothing + { buildInfoBuildFlags = defaultBuildFlags + , buildInfoOutputFile = Nothing + , buildInfoComponentsOnly = Flag False } showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags @@ -2198,8 +2201,12 @@ showBuildInfoCommand progDb = CommandUI ++ [ option [] ["buildinfo-json-output"] "Write the result to the given file instead of stdout" - buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + buildInfoOutputFile (\v flags -> flags { buildInfoOutputFile = v }) (reqArg' "FILE" Just (maybe [] pure)) + , option [] ["buildinfo-components-only"] + "Print out only the component info, each separated by a newline" + buildInfoComponentsOnly (\v flags -> flags { buildInfoComponentsOnly = v}) + trueArg ] } diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 23b56edbe40..8c75cd7bc91 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -54,9 +54,13 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- +{-# LANGUAGE OverloadedStrings #-} + module Distribution.Simple.ShowBuildInfo ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where +import qualified Data.Text as T + import Distribution.Compat.Prelude import Prelude () @@ -80,36 +84,37 @@ import Distribution.Utils.Path -- | Construct a JSON document describing the build information for a -- package. mkBuildInfo - :: PackageDescription -- ^ Mostly information from the .cabal file + :: FilePath -- ^ The source directory of the package + -> PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = - mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) - (map (mkComponentInfo pkg_descr lbi . targetCLBI) targetsToBuild) +mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = + JsonObject $ + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild) -- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and -- 'mkComponentInfo' yourself. mkBuildInfo' :: Json -- ^ The 'Json' from 'mkCompilerInfo' -> [Json] -- ^ The 'Json' from 'mkComponentInfo' - -> Json + -> [(T.Text, Json)] mkBuildInfo' cmplrInfo componentInfos = - JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) + [ "cabal-version" .= JsonString (T.pack (display cabalVersion)) , "compiler" .= cmplrInfo , "components" .= JsonArray componentInfos ] mkCompilerInfo :: ProgramDb -> Compiler -> Json mkCompilerInfo programDb cmplr = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor cmplr) - , "compiler-id" .= JsonString (showCompilerId cmplr) + [ "flavour" .= JsonString (T.pack (prettyShow $ compilerFlavor cmplr)) + , "compiler-id" .= JsonString (T.pack (showCompilerId cmplr)) , "path" .= path ] where - path = maybe JsonNull (JsonString . programPath) + path = maybe JsonNull (JsonString . T.pack . programPath) $ (flavorToProgram . compilerFlavor $ cmplr) >>= flip lookupProgram programDb @@ -120,16 +125,17 @@ mkCompilerInfo programDb cmplr = JsonObject flavorToProgram JHC = Just jhcProgram flavorToProgram _ = Nothing -mkComponentInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json -mkComponentInfo pkg_descr lbi clbi = JsonObject +mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "name" .= JsonString (T.pack $ prettyShow name) + , "unit-id" .= JsonString (T.pack $ prettyShow $ componentUnitId clbi) , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) - , "modules" .= JsonArray (map (JsonString . display) modules) - , "src-files" .= JsonArray (map JsonString sourceFiles) - , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi) - ] + , "modules" .= JsonArray (map (JsonString . T.pack . display) modules) + , "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles) + , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack) $ hsSourceDirs bi) + , "src-dir" .= JsonString (T.pack wdir) + ] <> cabalFile where name = componentLocalName clbi bi = componentBuildInfo comp @@ -148,6 +154,9 @@ mkComponentInfo pkg_descr lbi clbi = JsonObject CLib _ -> [] CExe exe -> [modulePath exe] _ -> [] + cabalFile + | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString (T.pack fp))] + | otherwise = [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component. @@ -155,7 +164,7 @@ getCompilerArgs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo - -> [String] + -> [T.Text] getCompilerArgs bi lbi clbi = case compilerFlavor $ compiler lbi of GHC -> ghc @@ -164,6 +173,7 @@ getCompilerArgs bi lbi clbi = "build arguments for compiler "++show c where -- This is absolutely awful - ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts + ghc = T.pack <$> + GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts where baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi) diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index 2dcd46515bd..60ffd0e2011 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} -- | cabal-install CLI command: show-build-info -- module Distribution.Client.CmdShowBuildInfo ( @@ -8,13 +8,14 @@ module Distribution.Client.CmdShowBuildInfo ( ) where import Distribution.Client.Compat.Prelude - ( when, find, fromMaybe ) + ( catMaybes ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages -import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Setup ( GlobalFlags ) +import Distribution.Client.TargetProblem + ( TargetProblem', TargetProblem (TargetProblemNoneEnabled, TargetProblemNoTargets) ) import Distribution.Simple.Setup (Flag(..), haddockVerbosity, configVerbosity, fromFlagOrDefault ) import Distribution.Simple.Command @@ -22,43 +23,23 @@ import Distribution.Simple.Command import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die' ) -import Distribution.Types.UnitId - ( UnitId, mkUnitId ) -import Distribution.Types.Version - ( mkVersion ) -import Distribution.Types.PackageDescription - ( buildType ) -import Distribution.Pretty - ( prettyShow ) + ( wrapText ) import qualified Data.Map as Map import qualified Distribution.Simple.Setup as Cabal -import Distribution.Client.SetupWrapper -import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.ProjectBuilding.Types import Distribution.Client.ProjectPlanning.Types -import Distribution.Client.ProjectPlanning - ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags - , setupHsScriptOptions ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout - ( distBuildDirectory ) -import Distribution.Client.Types - ( PackageLocation(..), GenericReadyPackage(..) ) -import Distribution.Client.JobControl - ( newLock, Lock ) -import Distribution.Simple.Configure - (getPersistBuildConfig, tryGetPersistBuildConfig ) + ( distProjectRootDirectory ) import Distribution.Simple.ShowBuildInfo import Distribution.Utils.Json -import Distribution.Simple.BuildTarget (readTargetInfos) -import Distribution.Types.LocalBuildInfo (neededTargetsInBuildOrder') -import Distribution.Compat.Graph (IsNode(nodeKey)) -import Distribution.Simple.Setup (BuildFlags(buildArgs)) -import Distribution.Types.TargetInfo (TargetInfo(targetCLBI)) +import Data.Either +import qualified Data.Text as T +import qualified Data.Text.IO as T showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -75,48 +56,38 @@ showBuildInfoCommand = CommandUI { ++ " " ++ pname ++ " show-build-info .\n" ++ " Shows build information about the current package\n" ++ " " ++ pname ++ " show-build-info ./pkgname \n" - ++ " Shows build information about the package located in './pkgname'\n" - ++ cmdCommonHelpTextNewBuildBeta, + ++ " Shows build information about the package located in './pkgname'\n", commandOptions = nixStyleOptions $ \_ -> [ option [] ["buildinfo-json-output"] "Write the result to the given file instead of stdout" buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) - (reqArg' "FILE" Just (maybe [] pure)), - option [] ["unit-ids-json"] - "Show build-info only for selected unit-id's." - buildInfoUnitIds (\pf flags -> flags { buildInfoUnitIds = pf }) - (reqArg' "UNIT-ID" (Just . words) (fromMaybe [])) + (reqArg' "FILE" Just (maybe [] pure)) ], commandDefaultFlags = defaultNixStyleFlags defaultShowBuildInfoFlags } data ShowBuildInfoFlags = ShowBuildInfoFlags { buildInfoOutputFile :: Maybe FilePath - , buildInfoUnitIds :: Maybe [String] } defaultShowBuildInfoFlags :: ShowBuildInfoFlags defaultShowBuildInfoFlags = ShowBuildInfoFlags { buildInfoOutputFile = Nothing - , buildInfoUnitIds = Nothing } -- | The @show-build-info@ exports information about a package and the compiler -- configuration used to build it as JSON, that can be used by other tooling. -- See "Distribution.Simple.ShowBuildInfo" for more information. showBuildInfoAction :: NixStyleFlags ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () -showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput unitIds), ..} +showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput), ..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand - let baseCtx' = baseCtx - { buildSettings = (buildSettings baseCtx) { buildSettingDryRun = True } - } targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings + =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings buildCtx <- - runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do + runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do -- Interpret the targets on the command line as build targets -- (as opposed to say repl or haddock targets). targets <- either (reportShowBuildInfoTargetProblems verbosity) return @@ -128,111 +99,49 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO targetSelectors let elaboratedPlan' = pruneInstallPlanToTargets - TargetActionBuild + TargetActionBuildInfo targets elaboratedPlan - -- This will be the build plan for building the dependencies required. - elaboratedPlan'' <- either (die' verbosity . renderCannotPruneDependencies) return - $ pruneInstallPlanToDependencies - (Map.keysSet targets) elaboratedPlan' - - return (elaboratedPlan'', targets) + return (elaboratedPlan', targets) buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes - scriptLock <- newLock - showTargets fileOutput unitIds verbosity baseCtx' buildCtx scriptLock - where - -- 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 } } - cliConfig = commandLineFlagsToProjectConfig globalFlags flags' - mempty -- ClientInstallFlags, not needed here - -showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () -showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do - let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + -- 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 - components <- concat <$> mapM (getComponentInfo verbosity baseCtx buildCtx - lock configured) targets + let componentBuildInfos = + concatMap T.lines $ -- Component infos are returned each on a newline + catMaybes (buildResultBuildInfo <$> buildResults) - let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) - (pkgConfigCompiler (elaboratedShared buildCtx)) + let compilerInfo = mkCompilerInfo + (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) - json = mkBuildInfo' compilerInfo components + components = map JsonRaw componentBuildInfos + fields = mkBuildInfo' compilerInfo components + json = JsonObject $ fields <> + [ ("project-root", JsonString (T.pack (distProjectRootDirectory (distDirLayout baseCtx)))) + ] res = renderJson json "" case fileOutput of - Nothing -> putStrLn res - Just fp -> writeFile fp res - -getComponentInfo :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO [Json] -getComponentInfo verbosity baseCtx buildCtx lock pkgs targetUnitId = - case mbPkg of - Nothing -> die' verbosity $ "No unit " ++ prettyShow targetUnitId - Just pkg -> do - let shared = elaboratedShared buildCtx - install = elaboratedPlanOriginal buildCtx - dirLayout = distDirLayout baseCtx - buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) - buildType' = buildType (elabPkgDescription pkg) - flags = setupHsBuildFlags pkg shared verbosity buildDir - srcDir = case (elabPkgSourceLocation pkg) of - LocalUnpackedPackage fp -> fp - _ -> "" - scriptOptions = setupHsScriptOptions - (ReadyPackage pkg) - install - shared - dirLayout - srcDir - buildDir - False - lock - configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir - configureArgs = setupHsConfigureArgs pkg - - -- Check cabal version is correct - (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions - (elabPkgDescription pkg) buildType' - when (cabalVersion < mkVersion [3, 0, 0, 0]) - ( die' verbosity $ "Only a Cabal version >= 3.0.0.0 is supported for this command.\n" - ++ "Found version: " ++ prettyShow cabalVersion ++ "\n" - ++ "For component: " ++ prettyShow targetUnitId - ) - -- Configure the package if there's no existing config - lbi' <- tryGetPersistBuildConfig buildDir - case lbi' of - Left _ -> setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.configureCommand - (pkgConfigCompilerProgs (elaboratedShared buildCtx))) - (const configureFlags) - (const configureArgs) - Right _ -> pure () - - -- Do the bit the Cabal library would normally do here - lbi <- getPersistBuildConfig buildDir - let pkgDesc = elabPkgDescription pkg - targets <- readTargetInfos verbosity pkgDesc lbi (buildArgs flags) - let targetsToBuild = neededTargetsInBuildOrder' pkgDesc lbi (map nodeKey targets) - - -- generate autogen files which will be needed by tooling - flip mapM_ targetsToBuild $ \target -> - componentInitialBuildSteps (Cabal.fromFlag (buildDistPref flags)) - pkgDesc lbi (targetCLBI target) verbosity + Nothing -> T.putStrLn res + Just fp -> T.writeFile fp res - return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild - - where - mbPkg :: Maybe ElaboratedConfiguredPackage - mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs + where + -- 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' + mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @show-build-info@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, @@ -242,7 +151,7 @@ getComponentInfo verbosity baseCtx buildCtx lock pkgs targetUnitId = -- tests\/benchmarks, fail if there are no such components -- selectPackageTargets :: TargetSelector - -> [AvailableTarget k] -> Either TargetProblem [k] + -> [AvailableTarget k] -> Either TargetProblem' [k] selectPackageTargets targetSelector targets -- If there are any buildable targets then we select those @@ -275,33 +184,10 @@ selectPackageTargets targetSelector targets -- For the @show-build-info@ command we just need the basic checks on being buildable etc. -- selectComponentTarget :: SubComponentTarget - -> AvailableTarget k -> Either TargetProblem k -selectComponentTarget subtarget = - either (Left . TargetProblemCommon) Right - . selectComponentTargetBasic subtarget - - --- | The various error conditions that can occur when matching a --- 'TargetSelector' against 'AvailableTarget's for the @show-build-info@ command. --- -data TargetProblem = - TargetProblemCommon TargetProblemCommon - - -- | The 'TargetSelector' matches targets but none are buildable - | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] - - -- | There are no targets at all - | TargetProblemNoTargets TargetSelector - deriving (Eq, Show) + -> AvailableTarget k -> Either TargetProblem' k +selectComponentTarget = selectComponentTargetBasic -reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a -reportTargetProblems verbosity = - die' verbosity . unlines . map renderTargetProblem -renderTargetProblem :: TargetProblem -> String -renderTargetProblem (TargetProblemCommon problem) = - renderTargetProblemCommon "show-build-info" problem -renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = - renderTargetProblemNoneEnabled "show-build-info" targetSelector targets -renderTargetProblem(TargetProblemNoTargets targetSelector) = - renderTargetProblemNoTargets "show-build-info" targetSelector +reportShowBuildInfoTargetProblems :: Verbosity -> [TargetProblem'] -> IO a +reportShowBuildInfoTargetProblems verbosity problems = + reportTargetProblems verbosity "show-build-info" problems \ No newline at end of file diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index fac7f863f2b..4ac1556d6e9 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -97,6 +97,7 @@ 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) @@ -378,12 +379,13 @@ packageFileMonitorKeyValues elab = -- elab_config = elab { - elabBuildTargets = [], - elabTestTargets = [], - elabBenchTargets = [], - elabReplTarget = Nothing, - elabHaddockTargets = [], - elabBuildHaddocks = False + elabBuildTargets = [], + elabBuildInfoTargets = [], + elabTestTargets = [], + elabBenchTargets = [], + elabReplTarget = Nothing, + elabHaddockTargets = [], + elabBuildHaddocks = False } -- The second part is the value used to guard the build step. So this is @@ -456,9 +458,10 @@ checkPackageFileMonitorChanged PackageFileMonitor{..} (MonitorUnchanged buildResult _, MonitorUnchanged _ _) -> return $ Right BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = Nothing, + buildResultBuildInfo = Nothing } where (docsResult, testsResult) = buildResult @@ -666,7 +669,7 @@ rebuildTarget verbosity BuildStatusDownload -> void $ waitAsyncPackageDownload verbosity downloadMap pkg _ -> return () - return $ BuildResult DocsNotTried TestsNotTried Nothing + return $ BuildResult DocsNotTried TestsNotTried Nothing Nothing | otherwise = -- We rely on the 'BuildStatus' to decide which phase to start from: case pkgBuildStatus of @@ -1066,9 +1069,10 @@ buildAndInstallUnpackedPackage verbosity noticeProgress ProgressCompleted return BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = mlogFile + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = mlogFile, + buildResultBuildInfo = Nothing } where @@ -1313,10 +1317,23 @@ buildInplaceUnpackedPackage verbosity Tar.createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest + -- Build info phase + buildInfo <- whenBuildInfo $ + -- 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 + return BuildResult { buildResultDocs = docsResult, buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultLogFile = Nothing, + buildResultBuildInfo = buildInfo } where @@ -1354,6 +1371,10 @@ buildInplaceUnpackedPackage verbosity | hasValidHaddockTargets pkg = action | otherwise = return () + whenBuildInfo action + | null (elabBuildInfoTargets pkg) = return Nothing + | otherwise = action + whenReRegister action = case buildStatus of -- We registered the package already @@ -1398,6 +1419,10 @@ buildInplaceUnpackedPackage verbosity haddockArgs v = flip filterHaddockArgs v $ setupHsHaddockArgs pkg + buildInfoCommand = Cabal.showBuildInfoCommand defaultProgramDb + buildInfoFlags _ = setupHsShowBuildInfoFlags pkg pkgshared verbosity builddir + buildInfoArgs _ = setupHsShowBuildInfoArgs pkg + scriptOptions = setupHsScriptOptions rpkg plan pkgshared distDirLayout srcdir builddir isParallelBuild cacheLock diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs index f9ac571f3b6..65fc6149ba5 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs @@ -32,6 +32,8 @@ import Distribution.Package (UnitId, PackageId) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.LocalBuildInfo (ComponentName) +import Data.Text (Text) + ------------------------------------------------------------------------------ -- Pre-build status: result of the dry run @@ -173,9 +175,10 @@ type BuildOutcome = Either BuildFailure BuildResult -- | Information arising from successfully building a single package. -- data BuildResult = BuildResult { - buildResultDocs :: DocsResult, - buildResultTests :: TestsResult, - buildResultLogFile :: Maybe FilePath + buildResultDocs :: DocsResult, + buildResultTests :: TestsResult, + buildResultLogFile :: Maybe FilePath, + buildResultBuildInfo :: Maybe Text } deriving Show diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 077c6422be4..e9868a87cf9 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -57,6 +57,8 @@ module Distribution.Client.ProjectPlanning ( setupHsRegisterFlags, setupHsHaddockFlags, setupHsHaddockArgs, + setupHsShowBuildInfoFlags, + setupHsShowBuildInfoArgs, packageHashInputs, @@ -1780,6 +1782,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBenchTargets = [] elabReplTarget = Nothing elabHaddockTargets = [] + elabBuildInfoTargets = [] elabBuildHaddocks = perPkgOptionFlag pkgid False packageConfigDocumentation @@ -2592,7 +2595,7 @@ nubComponentTargets = -> [(ComponentTarget, NonEmpty a)] wholeComponentOverrides ts = case [ ta | ta@(ComponentTarget _ WholeComponent, _) <- ts ] of - ((t, x):_) -> + ((t, x):_) -> let -- Delete tuple (t, x) from original list to avoid duplicates. -- Use 'deleteBy', to avoid additional Class constraint on 'nubComponentTargets'. @@ -2621,6 +2624,7 @@ pkgHasEphemeralBuildTargets elab = || (not . null) (elabTestTargets elab) || (not . null) (elabBenchTargets elab) || (not . null) (elabHaddockTargets elab) + || (not . null) (elabBuildInfoTargets elab) || (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab , subtarget /= WholeComponent ] @@ -2649,6 +2653,7 @@ data TargetAction = TargetActionConfigure | TargetActionTest | TargetActionBench | TargetActionHaddock + | TargetActionBuildInfo -- | Given a set of per-package\/per-component targets, take the subset of the -- install plan needed to build those targets. Also, update the package config @@ -2726,6 +2731,7 @@ setRootTargets targetAction perPkgTargetsMap = (Just tgts, TargetActionHaddock) -> foldr setElabHaddockTargets (elab { elabHaddockTargets = tgts , elabBuildHaddocks = True }) tgts + (Just tgts, TargetActionBuildInfo) -> elab { elabBuildInfoTargets = tgts } (Just _, TargetActionRepl) -> error "pruneInstallPlanToTargets: multiple repl targets" @@ -2769,14 +2775,15 @@ pruneInstallPlanPass1 pkgs = , null (elabBenchTargets elab) , isNothing (elabReplTarget elab) , null (elabHaddockTargets elab) + , null (elabBuildInfoTargets elab) ] then Just (installedUnitId elab) else Nothing - find_root (InstallPlan.Configured pkg) = is_root pkg -- When using the extra-packages stanza we need to -- look at installed packages as well. find_root (InstallPlan.Installed pkg) = is_root pkg + find_root (InstallPlan.Configured pkg) = is_root pkg find_root _ = Nothing -- Note [Sticky enabled testsuites] @@ -3684,6 +3691,22 @@ setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] setupHsHaddockArgs elab = map (showComponentTarget (packageId elab)) (elabHaddockTargets elab) +setupHsShowBuildInfoFlags :: ElaboratedConfiguredPackage + -> ElaboratedSharedConfig + -> Verbosity + -> FilePath + -> Cabal.ShowBuildInfoFlags +setupHsShowBuildInfoFlags pkg config verbosity builddir = + Cabal.ShowBuildInfoFlags { + buildInfoBuildFlags = setupHsBuildFlags pkg config verbosity builddir, + buildInfoOutputFile = Nothing, + buildInfoComponentsOnly = toFlag True + } + +setupHsShowBuildInfoArgs :: ElaboratedConfiguredPackage -> [String] +setupHsShowBuildInfoArgs elab = + map (showComponentTarget (packageId elab)) (elabBuildInfoTargets elab) + {- setupHsTestFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs index 0388886ecde..36bda12417e 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs @@ -321,6 +321,7 @@ data ElaboratedConfiguredPackage elabBenchTargets :: [ComponentTarget], elabReplTarget :: Maybe ComponentTarget, elabHaddockTargets :: [ComponentTarget], + elabBuildInfoTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index a5e74cf3009..d2953d0dff8 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -23,7 +23,7 @@ module Distribution.Client.Setup , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , buildCommand, BuildFlags(..) , filterTestFlags - , replCommand, testCommand, showBuildInfoCommand, benchmarkCommand, testOptions, benchmarkOptions + , replCommand, testCommand, benchmarkCommand, testOptions, benchmarkOptions , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , filterHaddockArgs, filterHaddockFlags, haddockOptions @@ -96,7 +96,6 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..) , CopyFlags(..), RegisterFlags(..) - , ShowBuildInfoFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -2453,7 +2452,7 @@ usageFlags name pname = -- ------------------------------------------------------------ -- * Repo helpers --- ------------------------------------------------------------bution/Client/Setup.hs +-- ------------------------------------------------------------ showRemoteRepo :: RemoteRepo -> String showRemoteRepo = prettyShow @@ -2475,17 +2474,3 @@ relevantConfigValuesText :: [String] -> String relevantConfigValuesText vs = "Relevant global configuration keys:\n" ++ concat [" " ++ v ++ "\n" |v <- vs] - - --- ------------------------------------------------------------ --- * Commands to support show-build-info --- ------------------------------------------------------------ - -showBuildInfoCommand :: CommandUI ShowBuildInfoFlags -showBuildInfoCommand = parent { - commandDefaultFlags = commandDefaultFlags parent, - commandOptions = - \showOrParseArgs -> commandOptions parent showOrParseArgs - } - where - parent = Cabal.showBuildInfoCommand defaultProgramDb diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 464452978fd..22ccf021128 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -18,7 +18,7 @@ -- runs it with the given arguments. module Distribution.Client.SetupWrapper ( - getSetup, runSetup, runSetupCommand, setupWrapper, getSetupMethod, + getSetup, runSetup, runSetupCommand, setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions, ) where diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 0b5fde29c9e..968b503d28f 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -111,8 +111,8 @@ removeExistingFile path = do -- it will clean up the file afterwards, it's lenient if the file is -- moved\/deleted. -- -withTempFileName :: FilePath - -> String +withTempFileName :: FilePath -- ^ Directory to create file in + -> String -- ^ Template for the file name -> (FilePath -> IO a) -> IO a withTempFileName tmpDir template action = Exception.bracket diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs index b027fcc15f7..66c0d3bfd32 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -15,4 +15,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs index 8e40ea9bfad..1c710f65022 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -23,7 +23,7 @@ main = cabalTest $ withSourceCopy $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -33,4 +33,4 @@ main = cabalTest $ withSourceCopy $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs index 252f211d1d6..0816c11abd3 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -19,7 +19,7 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -29,4 +29,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs index 35f0fb18547..880fe8ac71b 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -19,7 +19,7 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -29,4 +29,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out index 5f6512b4dc9..72752bfec16 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -5,7 +5,6 @@ cabal: Internal error in target matching. It should always be possible to find a Resolving dependencies... cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info -Configuring library for A-0.1.0.0.. cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs index ad7a0c07729..6b02eec8ec0 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs @@ -1,4 +1,4 @@ module A where foo :: Int -> Int -foo = id \ No newline at end of file +foo = id diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs index c9aa76a41ab..c836df828ca 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -15,4 +15,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal new file mode 100644 index 00000000000..6fe31714e7a --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.4 +name: C +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base, C + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs new file mode 100644 index 00000000000..12f5889322c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs @@ -0,0 +1,3 @@ +module Lib where + +f = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs new file mode 100644 index 00000000000..76a9bdb5d48 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs @@ -0,0 +1 @@ +main = pure () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs new file mode 100644 index 00000000000..db3e0adfd2b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["-v0"] + let comps = components buildInfo + assertEqual "Components, exactly three" 2 (length comps) + assertEqual "Test components, exactly one" 1 $ + length $ filter (\c -> "test" == componentType c) comps diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal index db2a4c566d8..b104678143d 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -8,7 +8,7 @@ library hs-source-dirs: src default-language: Haskell2010 exposed-modules: Lib - other-modules: Paths_complex + other-modules: Paths_Complex ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall @@ -17,32 +17,31 @@ executable Complex build-depends: base hs-source-dirs: src default-language: Haskell2010 - other-modules: Paths_complex + other-modules: Paths_Complex ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints -with-rtsopts=-T test-suite unit-test type: exitcode-stdio-1.0 hs-source-dirs: test - build-depends: hspec + build-depends: base main-is: Main.hs test-suite func-test type: exitcode-stdio-1.0 hs-source-dirs: test - build-depends: hspec + build-depends: base main-is: Main.hs benchmark complex-benchmarks type: exitcode-stdio-1.0 main-is: Main.hs other-modules: - Paths_complex + Paths_Complex hs-source-dirs: benchmark ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base - , criterion , Complex default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index 9d8cae95961..990bd65bcb2 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -29,6 +29,6 @@ main = cabalTest $ do [ "-Wall" ] ) - assertEqual "Component modules" ["Paths_complex"] (componentModules component) + assertEqual "Component modules" ["Paths_Complex"] (componentModules component) assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index 0cae3329d62..51eaf075e6e 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -28,6 +28,6 @@ main = cabalTest $ do [ "-Wredundant-constraints" ] ) - assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component modules" ["Lib", "Paths_Complex"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal new file mode 100644 index 00000000000..0af36bee5bb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: D +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib + build-depends: base, D1 + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal new file mode 100644 index 00000000000..09118f6e84e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: D1 +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib1 + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs new file mode 100644 index 00000000000..50919006b5f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs @@ -0,0 +1,3 @@ +module Lib1 where + +bar = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs new file mode 100644 index 00000000000..638711c17e5 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs @@ -0,0 +1,6 @@ +module Lib where + +-- Point of this is to make sure we can still get the build info even if one of +-- the components doesn't compile +foo :: String +foo = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out new file mode 100644 index 00000000000..8a876417a2c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out @@ -0,0 +1,2 @@ +# cabal clean +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs new file mode 100644 index 00000000000..e3c0edb3651 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + -- Make sure the vendored dependency D1 gets built + cabal' "clean" [] + r <- cabal' "show-build-info" ["-v1", "D", "D1"] + assertOutputContains "Building library for D1-0.1.0.0.." r + assertOutputDoesNotContain "Building library for D-0.1.0.0.." r diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project new file mode 100644 index 00000000000..e7083db0d01 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project @@ -0,0 +1,2 @@ +packages: . + ./D1 diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index 35bbc5fb2a8..5b33be70a7d 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -42,8 +42,9 @@ data ComponentInfo = ComponentInfo , componentUnitId :: String , componentCompilerArgs :: [String] , componentModules :: [String] - , componentSrcFiles :: [String] - , componentSrcDirs :: [String] + , componentSrcFiles :: [FilePath] + , componentHsSrcDirs :: [FilePath] + , componentSrcDir :: FilePath } deriving (Generic, Show) instance ToJSON BuildInfo where From 9794067337569d3e3dd046154cc3b22903edfd85 Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 12 Jul 2021 10:32:01 +0200 Subject: [PATCH 07/11] Port JSON module to Text based implementation Changes the internal representation of JSON to Text rather than String, and introduces the buildinfo-components-only flag in the Cabal part to make it easier to stitch back the JSON into an array in cabal-install. --- .../src/Distribution/Simple/ShowBuildInfo.hs | 3 +- Cabal/src/Distribution/Simple/Utils/Json.hs | 50 -------------- Cabal/src/Distribution/Utils/Json.hs | 65 +++++++++++++++++++ cabal-install/main/Main.hs | 2 +- 4 files changed, 67 insertions(+), 53 deletions(-) delete mode 100644 Cabal/src/Distribution/Simple/Utils/Json.hs create mode 100644 Cabal/src/Distribution/Utils/Json.hs diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 8c75cd7bc91..0ea6f96a7b9 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -79,7 +79,6 @@ import Distribution.Utils.Json import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty -import Distribution.Utils.Path -- | Construct a JSON document describing the build information for a -- package. @@ -133,7 +132,7 @@ mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) , "modules" .= JsonArray (map (JsonString . T.pack . display) modules) , "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles) - , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack) $ hsSourceDirs bi) + , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack . prettyShow) $ hsSourceDirs bi) , "src-dir" .= JsonString (T.pack wdir) ] <> cabalFile where diff --git a/Cabal/src/Distribution/Simple/Utils/Json.hs b/Cabal/src/Distribution/Simple/Utils/Json.hs deleted file mode 100644 index ba918b74880..00000000000 --- a/Cabal/src/Distribution/Simple/Utils/Json.hs +++ /dev/null @@ -1,50 +0,0 @@ --- | Extremely simple JSON helper. Don't do anything too fancy with this! - -module Distribution.Utils.Json - ( Json(..) - , (.=) - , renderJson - ) where - -data Json = JsonArray [Json] - | JsonBool !Bool - | JsonNull - | JsonNumber !Int - | JsonObject [(String, Json)] - | JsonString !String - -renderJson :: Json -> ShowS -renderJson (JsonArray objs) = - surround "[" "]" $ intercalate "," $ map renderJson objs -renderJson (JsonBool True) = showString "true" -renderJson (JsonBool False) = showString "false" -renderJson JsonNull = showString "null" -renderJson (JsonNumber n) = shows n -renderJson (JsonObject attrs) = - surround "{" "}" $ intercalate "," $ map render attrs - where - render (k,v) = (surround "\"" "\"" $ showString' k) . showString ":" . renderJson v -renderJson (JsonString s) = surround "\"" "\"" $ showString' s - -surround :: String -> String -> ShowS -> ShowS -surround begin end middle = showString begin . middle . showString end - -showString' :: String -> ShowS -showString' xs = showStringWorker xs - where - showStringWorker :: String -> ShowS - showStringWorker ('\"':as) = showString "\\\"" . showStringWorker as - showStringWorker ('\\':as) = showString "\\\\" . showStringWorker as - showStringWorker ('\'':as) = showString "\\\'" . showStringWorker as - showStringWorker (x:as) = showString [x] . showStringWorker as - showStringWorker [] = showString "" - -intercalate :: String -> [ShowS] -> ShowS -intercalate sep = go - where - go [] = id - go [x] = x - go (x:xs) = x . showString' sep . go xs - -(.=) :: String -> Json -> (String, Json) -k .= v = (k, v) diff --git a/Cabal/src/Distribution/Utils/Json.hs b/Cabal/src/Distribution/Utils/Json.hs new file mode 100644 index 00000000000..15573c9c05a --- /dev/null +++ b/Cabal/src/Distribution/Utils/Json.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Extremely simple JSON helper. Don't do anything too fancy with this! +module Distribution.Utils.Json + ( Json(..) + , (.=) + , renderJson + ) where + +import Data.Text (Text) +import qualified Data.Text as Text + +data Json = JsonArray [Json] + | JsonBool !Bool + | JsonNull + | JsonNumber !Int + | JsonObject [(Text, Json)] + | JsonRaw !Text + | JsonString !Text + +-- | A type to mirror 'ShowS' +type ShowT = Text -> Text + +renderJson :: Json -> ShowT +renderJson (JsonArray objs) = + surround "[" "]" $ intercalate "," $ map renderJson objs +renderJson (JsonBool True) = showText "true" +renderJson (JsonBool False) = showText "false" +renderJson JsonNull = showText "null" +renderJson (JsonNumber n) = showText $ Text.pack (show n) +renderJson (JsonObject attrs) = + surround "{" "}" $ intercalate "," $ map render attrs + where + render (k,v) = (surround "\"" "\"" $ showText' k) . showText ":" . renderJson v +renderJson (JsonString s) = surround "\"" "\"" $ showText' s +renderJson (JsonRaw s) = showText s + +surround :: Text -> Text -> ShowT -> ShowT +surround begin end middle = showText begin . middle . showText end + +showText :: Text -> ShowT +showText = (<>) + +showText' :: Text -> ShowT +showText' xs = showStringWorker xs + where + showStringWorker :: Text -> ShowT + showStringWorker t = + case Text.uncons t of + Just ('\r', as) -> showText "\\r" . showStringWorker as + Just ('\n', as) -> showText "\\n" . showStringWorker as + Just ('\"', as) -> showText "\\\"" . showStringWorker as + Just ('\\', as) -> showText "\\\\" . showStringWorker as + Just (x, as) -> showText (Text.singleton x) . showStringWorker as + Nothing -> showText "" + +intercalate :: Text -> [ShowT] -> ShowT +intercalate sep = go + where + go [] = id + go [x] = x + go (x:xs) = x . showText' sep . go xs + +(.=) :: Text -> Json -> (Text, Json) +k .= v = (k, v) diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 2a2ab6b858e..46f2521b392 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -151,7 +151,7 @@ import Distribution.Simple.Utils import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity - ( Verbosity, normal ) + ( normal ) import Distribution.Version ( Version, mkVersion, orLaterVersion ) From b79e4a1ec096f595bcf2e499cffc5d9ba41bdb48 Mon Sep 17 00:00:00 2001 From: Fendor Date: Fri, 4 Jun 2021 18:57:53 +0200 Subject: [PATCH 08/11] Extend s-b-i information in Cabal --- .../src/Distribution/Simple/ShowBuildInfo.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 0ea6f96a7b9..89e7d61d2f1 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -148,11 +148,26 @@ mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ modules = case comp of CLib lib -> explicitLibModules lib CExe exe -> exeModules exe - _ -> [] + CTest test -> + case testInterface test of + TestSuiteExeV10 _ _ -> [] + TestSuiteLibV09 _ modName -> [modName] + TestSuiteUnsupported _ -> [] + CBench bench -> benchmarkModules bench + CFLib flib -> foreignLibModules flib sourceFiles = case comp of CLib _ -> [] CExe exe -> [modulePath exe] - _ -> [] + CTest test -> + case testInterface test of + TestSuiteExeV10 _ fp -> [fp] + TestSuiteLibV09 _ _ -> [] + TestSuiteUnsupported _ -> [] + CBench bench -> case benchmarkInterface bench of + BenchmarkExeV10 _ fp -> [fp] + BenchmarkUnsupported _ -> [] + + CFLib _ -> [] cabalFile | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString (T.pack fp))] | otherwise = [] From 8bd4431bab30392383c08342c9e0a66d0e4f6364 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 8 Jul 2021 16:37:42 +0200 Subject: [PATCH 09/11] Cache show-build-info results in cache directory --- .../src/Distribution/Client/CmdBench.hs | 2 +- .../Distribution/Client/CmdShowBuildInfo.hs | 37 +++++++++---------- .../Distribution/Client/ProjectBuilding.hs | 23 ++++++------ 3 files changed, 31 insertions(+), 31 deletions(-) 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 4ac1556d6e9..460d095988f 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) @@ -1194,6 +1193,7 @@ buildInplaceUnpackedPackage :: Verbosity buildInplaceUnpackedPackage verbosity distDirLayout@DistDirLayout { distTempDirectory, + distProjectCacheDirectory, distPackageCacheDirectory, distDirectory } @@ -1318,22 +1318,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 @@ -1372,7 +1373,7 @@ buildInplaceUnpackedPackage verbosity | otherwise = return () whenBuildInfo action - | null (elabBuildInfoTargets pkg) = return Nothing + | null (elabBuildInfoTargets pkg) = return () | otherwise = action whenReRegister action From 8ce27f27bd9b20cb234d7bb80071b001bd8741a2 Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 13 Jul 2021 14:44:58 +0200 Subject: [PATCH 10/11] Add verbose output marker for show-build-info Simplifies writing tests for show-build-info Add trailing path separator to make testing simpler. --- Cabal/src/Distribution/Simple/ShowBuildInfo.hs | 4 +++- cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs | 6 +++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 89e7d61d2f1..2b323d1da5a 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -80,6 +80,8 @@ import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty +import System.FilePath (addTrailingPathSeparator) + -- | Construct a JSON document describing the build information for a -- package. mkBuildInfo @@ -133,7 +135,7 @@ mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ , "modules" .= JsonArray (map (JsonString . T.pack . display) modules) , "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles) , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack . prettyShow) $ hsSourceDirs bi) - , "src-dir" .= JsonString (T.pack wdir) + , "src-dir" .= JsonString (T.pack $ addTrailingPathSeparator wdir) ] <> cabalFile where name = componentLocalName clbi diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs index 78c8f15db2c..7bf1f3b60e4 100644 --- a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -23,7 +23,7 @@ import Distribution.Simple.Command import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText ) + ( wrapText, withOutputMarker ) import qualified Data.Map as Map import Distribution.Client.ProjectPlanning.Types @@ -122,12 +122,12 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO components = map JsonRaw componentBuildInfos fields = mkBuildInfo' compilerInfo components json = JsonObject $ fields <> - [ ("project-root", JsonString (T.pack (distProjectRootDirectory (distDirLayout baseCtx)))) + [ ("project-root", JsonString (T.pack (addTrailingPathSeparator $ distProjectRootDirectory (distDirLayout baseCtx)))) ] res = renderJson json "" case fileOutput of - Nothing -> T.putStrLn res + Nothing -> T.putStrLn $ T.pack $ withOutputMarker verbosity (T.unpack res) Just fp -> T.writeFile fp res where From 2b51b5eca90364f2fc740a2927093200755d59b6 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 8 Jul 2021 11:04:39 +0200 Subject: [PATCH 11/11] Re-design test-cases for show-build-info --- .../Configure/include/HsZlibConfig.h.in | 10 +- .../PackageTests/ShowBuildInfo/A/A.cabal | 2 +- .../ShowBuildInfo/{ => A}/B/B.cabal | 4 +- .../ShowBuildInfo/{B/src => A/B/lib}/A.hs | 2 +- .../PackageTests/ShowBuildInfo/A/Setup.hs | 2 - ...nfo-exe-exact.out => build-info-B-lib.out} | 0 .../ShowBuildInfo/A/build-info-B-lib.test.hs | 9 ++ ...id-file.out => build-info-B-outer-lib.out} | 0 .../A/build-info-B-outer-lib.test.hs | 10 ++ .../ShowBuildInfo/A/build-info-all.test.hs | 13 +- .../A/build-info-exe-exact.test.hs | 18 --- ...e-exact-unit-id.out => build-info-exe.out} | 0 .../ShowBuildInfo/A/build-info-exe.test.hs | 13 ++ ...d-info-multiple-exact-unit-id-file.test.hs | 36 ------ .../build-info-multiple-exact-unit-id.test.hs | 32 ----- .../A/build-info-multiple-exact.test.hs | 32 ----- .../A/build-info-multiple-targets-file.out | 4 + .../build-info-multiple-targets-file.test.hs | 13 ++ ...ct.out => build-info-multiple-targets.out} | 0 .../A/build-info-multiple-targets.test.hs | 9 ++ .../build-info-no-target.out} | 0 .../A/build-info-no-target.test.hs | 12 ++ .../build-info-test.out} | 0 .../ShowBuildInfo/A/build-info-test.test.hs | 13 ++ .../ShowBuildInfo/A/build-info-unknown.out | 7 -- .../A/build-info-unknown.test.hs | 15 +-- .../ShowBuildInfo/A/cabal.project | 2 +- .../PackageTests/ShowBuildInfo/B/Setup.hs | 2 - .../B/build-info-lib-exact.test.hs | 18 --- .../ShowBuildInfo/B/cabal.project | 2 - .../PackageTests/ShowBuildInfo/C/C.cabal | 15 --- .../PackageTests/ShowBuildInfo/C/Lib.hs | 3 - .../PackageTests/ShowBuildInfo/C/Test.hs | 1 - .../C/build-info-all-internal-deps.test.hs | 9 -- .../ShowBuildInfo/C/cabal.project | 1 - .../ShowBuildInfo/Complex/Complex.cabal | 91 +++++++++----- .../ShowBuildInfo/Complex/Setup.hs | 2 - .../ShowBuildInfo/Complex/app/Main.lhs | 8 ++ .../ShowBuildInfo/Complex/app/Other.hs | 3 + .../ShowBuildInfo/Complex/benchmark/Main.hs | 3 + .../ShowBuildInfo/Complex/cabal.project | 3 + .../ShowBuildInfo/Complex/exe.out | 1 - .../ShowBuildInfo/Complex/exe.test.hs | 34 ----- .../ShowBuildInfo/Complex/lib.out | 1 - .../ShowBuildInfo/Complex/lib.test.hs | 33 ----- .../another-framework.cabal | 8 ++ .../repo/criterion-1.1.4.0/criterion.cabal | 8 ++ .../test-framework.cabal | 8 ++ .../ShowBuildInfo/Complex/single.out | 40 ++++++ .../ShowBuildInfo/Complex/single.test.hs | 33 +++++ .../ShowBuildInfo/Complex/src/A.hs | 5 + .../ShowBuildInfo/Complex/src/B.hs | 3 + .../ShowBuildInfo/Complex/src/C.hs | 5 + .../ShowBuildInfo/Complex/src/D.hs | 5 + .../ShowBuildInfo/Complex/src/Lib.hs | 4 - .../ShowBuildInfo/Complex/src/Main.lhs | 9 -- .../Complex/test/{Main.hs => FuncMain.hs} | 0 .../ShowBuildInfo/Complex/test/UnitMain.hs | 1 + .../PackageTests/ShowBuildInfo/D/D.cabal | 9 -- .../PackageTests/ShowBuildInfo/D/D1/D1.cabal | 9 -- .../PackageTests/ShowBuildInfo/D/D1/Lib1.hs | 3 - .../PackageTests/ShowBuildInfo/D/Lib.hs | 6 - .../ShowBuildInfo/D/build-info-prune-deps.out | 2 - .../D/build-info-prune-deps.test.hs | 8 -- .../ShowBuildInfo/D/cabal.project | 2 - .../src/Test/Cabal/DecodeShowBuildInfo.hs | 116 +++++++++++++----- cabal-testsuite/src/Test/Cabal/Monad.hs | 13 +- .../src/Test/Cabal/OutputNormalizer.hs | 20 +++ 68 files changed, 420 insertions(+), 385 deletions(-) rename cabal-testsuite/PackageTests/ShowBuildInfo/{ => A}/B/B.cabal (79%) rename cabal-testsuite/PackageTests/ShowBuildInfo/{B/src => A/B/lib}/A.hs (65%) delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/A/{build-info-exe-exact.out => build-info-B-lib.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/A/{build-info-multiple-exact-unit-id-file.out => build-info-B-outer-lib.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/A/{build-info-multiple-exact-unit-id.out => build-info-exe.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/A/{build-info-multiple-exact.out => build-info-multiple-targets.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/{B/build-info-lib-exact.out => A/build-info-no-target.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs rename cabal-testsuite/PackageTests/ShowBuildInfo/{C/build-info-all-internal-deps.out => A/build-info-test.out} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs rename cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/{Main.hs => FuncMain.hs} (100%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project diff --git a/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in b/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in index aa500c7d2ce..b276a09c56f 100644 --- a/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in +++ b/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in @@ -3,12 +3,12 @@ /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H -/* Define to 1 if you have the header file. */ -#undef HAVE_MEMORY_H - /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H +/* Define to 1 if you have the header file. */ +#undef HAVE_STDIO_H + /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H @@ -45,5 +45,7 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION -/* Define to 1 if you have the ANSI C header files. */ +/* Define to 1 if all of the C90 standard headers exist (not just the ones + required in a freestanding environment). This macro is provided for + backward compatibility; new code need not use it. */ #undef STDC_HEADERS diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal index 5a1e2977b66..a1420d9676e 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -18,6 +18,6 @@ executable A test-suite A-tests type: exitcode-stdio-1.0 main-is: Test.hs - build-depends: base >=4 + build-depends: base >=4, A hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal similarity index 79% rename from cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal index 1400971ae35..e81b9eb3a1d 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal @@ -4,7 +4,7 @@ version: 0.1.0.0 license: BSD-3-Clause library - exposed-modules: A + exposed-modules: B build-depends: base >=4.0.0.0, A - hs-source-dirs: src + hs-source-dirs: lib default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs similarity index 65% rename from cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs index 6b02eec8ec0..8b74dfe6b43 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs @@ -1,4 +1,4 @@ -module A where +module B where foo :: Int -> Int foo = id diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs new file mode 100644 index 00000000000..f3ad330757e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["lib:B"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [libComp] = components buildInfo + assertLibComponent libComp "lib" ["B"] ["lib"] \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs new file mode 100644 index 00000000000..cbe6553cedb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["lib:B", "lib:A"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 2 (length $ components buildInfo) + let [libAComp, libBComp] = components buildInfo + assertLibComponent libAComp "lib" ["A"] ["src"] + assertLibComponent libBComp "lib" ["B"] ["lib"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs index aa2d0142358..ce34607f1b4 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs @@ -2,8 +2,11 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfo <- runShowBuildInfo ["-v0"] -- hide verbose output so we can parse - let comps = components buildInfo - assertEqual "Components, exactly three" 3 (length comps) - assertEqual "Test components, exactly one" 1 $ - length $ filter (\c -> "test" == componentType c) comps + buildInfo <- runShowBuildInfo ["all", "--enable-tests"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 4 (length $ components buildInfo) + let [libAComp, exeComp, testComp, libBComp] = components buildInfo + assertExeComponent exeComp "exe:A" ["Main.hs"] ["src"] + assertLibComponent libAComp "lib" ["A"] ["src"] + assertLibComponent libBComp "lib" ["B"] ["lib"] + assertTestComponent testComp "test:A-tests" ["Test.hs"] ["src"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs deleted file mode 100644 index 66c0d3bfd32..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs +++ /dev/null @@ -1,18 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["exe:A", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo - assertEqual "Component type" "exe" (componentType component) - assertEqual "Component name" "exe:A" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" [] (componentModules component) - assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs new file mode 100644 index 00000000000..213de15a7e4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["exe:A"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [exeComp] = components buildInfo + assertExeComponent exeComp "exe:A" ["Main.hs"] ["src"] + + -- Must not have library as a dependency as "exe:A" does not depend on it. + assertBool "Does not contain library as dependency" + (all (/= "A-0.1.0.0-inplace") $ componentCompilerArgs exeComp) \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs deleted file mode 100644 index 1c710f65022..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs +++ /dev/null @@ -1,36 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ withSourceCopy $ do - cwd <- fmap testCurrentDir getTestEnv - let fp = cwd "unit.json" - _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - buildInfo <- decodeBuildInfoFile fp - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly two" 2 (length $ components buildInfo) - let [libBuildInfo, exeBuildInfo] = components buildInfo - assertExe exeBuildInfo - assertLib libBuildInfo - where - assertExe :: ComponentInfo -> TestM () - assertExe component = do - assertEqual "Component type" "exe" (componentType component) - assertEqual "Component name" "exe:A" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" [] (componentModules component) - assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) - - assertLib :: ComponentInfo -> TestM () - assertLib component = do - assertEqual "Component type" "lib" (componentType component) - assertEqual "Component name" "lib" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" ["A"] (componentModules component) - assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs deleted file mode 100644 index 0816c11abd3..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs +++ /dev/null @@ -1,32 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - let [libBuildInfo, exeBuildInfo] = components buildInfo - assertExe exeBuildInfo - assertLib libBuildInfo - where - assertExe :: ComponentInfo -> TestM () - assertExe component = do - assertEqual "Component type" "exe" (componentType component) - assertEqual "Component name" "exe:A" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" [] (componentModules component) - assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) - - assertLib :: ComponentInfo -> TestM () - assertLib component = do - assertEqual "Component type" "lib" (componentType component) - assertEqual "Component name" "lib" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" ["A"] (componentModules component) - assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs deleted file mode 100644 index 880fe8ac71b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs +++ /dev/null @@ -1,32 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - let [libBuildInfo, exeBuildInfo] = components buildInfo - assertExe exeBuildInfo - assertLib libBuildInfo - where - assertExe :: ComponentInfo -> TestM () - assertExe component = do - assertEqual "Component type" "exe" (componentType component) - assertEqual "Component name" "exe:A" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" [] (componentModules component) - assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) - - assertLib :: ComponentInfo -> TestM () - assertLib component = do - assertEqual "Component type" "lib" (componentType component) - assertEqual "Component name" "lib" (componentName component) - assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" ["A"] (componentModules component) - assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out new file mode 100644 index 00000000000..3b4215e5719 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out @@ -0,0 +1,4 @@ +# cabal show-build-info +Resolving dependencies... +Configuring library for A-0.1.0.0.. +Configuring executable 'A' for A-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs new file mode 100644 index 00000000000..f0160428fd7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withSourceCopy $ do + cwd <- fmap testCurrentDir getTestEnv + let fp = cwd "unit.json" + _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "exe:A", "lib:A"] + buildInfo <- decodeBuildInfoFile fp + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 2 (length $ components buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo + assertExeComponent exeBuildInfo "exe:A" ["Main.hs"] ["src"] + assertLibComponent libBuildInfo "lib" ["A"] ["src"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs new file mode 100644 index 00000000000..4ab4185b8be --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["exe:A", "lib:A"] + assertCommonBuildInfo buildInfo + let [libBuildInfo, exeBuildInfo] = components buildInfo + assertExeComponent exeBuildInfo "exe:A" ["Main.hs"] ["src"] + assertLibComponent libBuildInfo "lib" ["A"] ["src"] \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs new file mode 100644 index 00000000000..6e11334d323 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs @@ -0,0 +1,12 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo [] + assertCommonBuildInfo buildInfo + let comps = components buildInfo + assertEqual "Number of Components" 2 (length comps) + assertBool "Contains main component executable" + (any (\c -> "exe:A" == componentName c) comps) + assertBool "Contains main component library" + (any (\c -> "lib" == componentName c) comps) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.out similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out rename to cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.out diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs new file mode 100644 index 00000000000..1d1df200639 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["test:A-tests"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [testComp] = components buildInfo + assertTestComponent testComp "test:A-tests" ["Test.hs"] ["src"] + + -- Must have library as a dependency as "test:A-tests" depends on it. + assertBool "Contains internal dependency" + (any (== "A-0.1.0.0-inplace") $ componentCompilerArgs testComp) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out index 72752bfec16..53db13639c8 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -1,11 +1,4 @@ # cabal show-build-info -cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: -'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) # cabal show-build-info -Resolving dependencies... -cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info -cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info -cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: -'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs index b07607b3779..20ef51ac600 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs @@ -1,14 +1,15 @@ import Test.Cabal.Prelude main = cabalTest $ do - r <- fails $ cabal' "show-build-info" ["exe:B"] + r <- fails $ cabal' "show-build-info" ["exe:B", "-v1"] assertOutputContains "Internal error in target matching." r - r <- fails $ cabal' "show-build-info" ["--unit-ids-json=B-inplace-0.1.0.0"] - assertOutputContains "No unit B-inplace-0.1.0.0" r + r <- fails $ cabal' "show-build-info" ["C", "-v1"] + assertOutputContains "Cannot show-build-info the package C, it is not in this project (either directly or indirectly)." r - r <- fails $ cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace B-inplace-0.1.0.0"] - assertOutputContains "No unit B-inplace-0.1.0.0" r - - r <- fails $ cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace", "exe:B"] + r <- fails $ cabal' "show-build-info" ["lib:C", "-v1"] assertOutputContains "Internal error in target matching." r + + r <- fails $ cabal' "show-build-info" ["benchmarks", "-v1"] + assertOutputContains "Cannot show-build-info the benchmarks in the package A-0.1.0.0 because it does not contain any benchmarks." r + diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project index e6fdbadb439..9a091f69b3b 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -1 +1 @@ -packages: . +packages: . ./B/ diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs deleted file mode 100644 index c836df828ca..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs +++ /dev/null @@ -1,18 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["lib:B", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo - assertEqual "Component type" "lib" (componentType component) - assertEqual "Component name" "lib" (componentName component) - assertEqual "Component unit-id" "B-0.1.0.0-inplace" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertEqual "Component modules" ["A"] (componentModules component) - assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project deleted file mode 100644 index b957b20d5c5..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project +++ /dev/null @@ -1,2 +0,0 @@ -packages: . - ../A diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal deleted file mode 100644 index 6fe31714e7a..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal +++ /dev/null @@ -1,15 +0,0 @@ -cabal-version: 2.4 -name: C -version: 0.1.0.0 -license: BSD-3-Clause - -library - exposed-modules: Lib - build-depends: base - default-language: Haskell2010 - -test-suite tests - type: exitcode-stdio-1.0 - main-is: Test.hs - build-depends: base, C - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs deleted file mode 100644 index 12f5889322c..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Lib where - -f = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs deleted file mode 100644 index 76a9bdb5d48..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs +++ /dev/null @@ -1 +0,0 @@ -main = pure () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs deleted file mode 100644 index db3e0adfd2b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs +++ /dev/null @@ -1,9 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["-v0"] - let comps = components buildInfo - assertEqual "Components, exactly three" 2 (length comps) - assertEqual "Test components, exactly one" 1 $ - length $ filter (\c -> "test" == componentType c) comps diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project deleted file mode 100644 index e6fdbadb439..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal index b104678143d..d8ea0a46eca 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -1,47 +1,72 @@ -cabal-version: 2.4 -name: Complex -version: 0.1.0.0 -license: MIT +cabal-version: 2.4 +name: Complex +version: 0.1.0.0 +license: MIT library - build-depends: base - hs-source-dirs: src - default-language: Haskell2010 - exposed-modules: Lib - other-modules: Paths_Complex + build-depends: base + hs-source-dirs: src doesnt-exist + default-language: Haskell2010 + exposed-modules: + A + B + + autogen-modules: Paths_Complex + other-modules: + C + D + Paths_Complex - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + ghc-options: -Wall executable Complex - main-is: Main.lhs - build-depends: base - hs-source-dirs: src - default-language: Haskell2010 - other-modules: Paths_Complex - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints - -with-rtsopts=-T + main-is: Main.lhs + build-depends: + , base + , Complex + + hs-source-dirs: app + autogen-modules: Paths_Complex + other-modules: + Other + Paths_Complex + + ghc-options: + -threaded -rtsopts "-with-rtsopts=-N -T" -Wredundant-constraints + + default-language: Haskell2010 test-suite unit-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - build-depends: base - main-is: Main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , another-framework + , base + + main-is: UnitMain.hs + default-language: Haskell2010 test-suite func-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - build-depends: base - main-is: Main.hs + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , base + , Complex + , test-framework + + main-is: FuncMain.hs + default-language: Haskell2010 benchmark complex-benchmarks - type: exitcode-stdio-1.0 - main-is: Main.hs - other-modules: - Paths_Complex - hs-source-dirs: - benchmark - ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Paths_Complex + autogen-modules: Paths_Complex + hs-source-dirs: benchmark + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: - base + , base , Complex + , criterion ^>=1.1.4 + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs new file mode 100644 index 00000000000..c1ea21ba48c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs @@ -0,0 +1,8 @@ +module Main where + +import A +import Other + +main = do + print foo + print bar diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs new file mode 100644 index 00000000000..5d0685b1815 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs @@ -0,0 +1,3 @@ +module Other where + +bar = () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs new file mode 100644 index 00000000000..7753bcff18c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = pure () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project index e6fdbadb439..b5bc61b1b15 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -1 +1,4 @@ packages: . + +tests: True +benchmarks: True \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out deleted file mode 100644 index 6fbda9790b7..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out +++ /dev/null @@ -1 +0,0 @@ -# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs deleted file mode 100644 index 990bd65bcb2..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ /dev/null @@ -1,34 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["exe:Complex", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo - assertEqual "Component type" "exe" (componentType component) - assertEqual "Component name" "exe:Complex" (componentName component) - assertEqual "Component unit-id" "Complex-0.1.0.0-inplace-Complex" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertBool "Component ghc-options contains all specified in .cabal" - (all - (`elem` componentCompilerArgs component) - [ "-threaded" - , "-rtsopts" - , "-with-rtsopts=-N" - , "-with-rtsopts=-T" - , "-Wredundant-constraints" - ] - ) - assertBool "Component ghc-options does not contain -Wall" - (all - (`notElem` componentCompilerArgs component) - [ "-Wall" - ] - ) - assertEqual "Component modules" ["Paths_Complex"] (componentModules component) - assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out deleted file mode 100644 index 6fbda9790b7..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out +++ /dev/null @@ -1 +0,0 @@ -# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs deleted file mode 100644 index 51eaf075e6e..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ /dev/null @@ -1,33 +0,0 @@ -import Test.Cabal.Prelude -import Test.Cabal.DecodeShowBuildInfo - -main = cabalTest $ do - buildInfo <- runShowBuildInfo ["lib:Complex", "-v0"] - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo - assertEqual "Component type" "lib" (componentType component) - assertEqual "Component name" "lib" (componentName component) - assertEqual "Component unit-id" "Complex-0.1.0.0-inplace" (componentUnitId component) - assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) - assertBool "Component ghc-options contains all specified in .cabal" - (all - (`elem` componentCompilerArgs component) - [ "-threaded" - , "-rtsopts" - , "-with-rtsopts=-N" - , "-Wall" - ] - ) - assertBool "Component ghc-options does not contain -Wredundant-constraints" - (all - (`notElem` componentCompilerArgs component) - [ "-Wredundant-constraints" - ] - ) - assertEqual "Component modules" ["Lib", "Paths_Complex"] (componentModules component) - assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal new file mode 100644 index 00000000000..173443e1906 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal @@ -0,0 +1,8 @@ +name: another-framework +version: 0.8.1.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal new file mode 100644 index 00000000000..e7cdc916530 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal @@ -0,0 +1,8 @@ +name: criterion +version: 1.1.4.0 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base, ghc-prim + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal new file mode 100644 index 00000000000..2235e2eeb39 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal @@ -0,0 +1,8 @@ +name: test-framework +version: 0.8.1.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out new file mode 100644 index 00000000000..ae4c421e26d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out @@ -0,0 +1,40 @@ +# cabal v2-update +Downloading the latest package list from test-local-repo +# cabal show-build-info +Resolving dependencies... +Configuring library for Complex-0.1.0.0.. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +Preprocessing library for Complex-0.1.0.0.. +Building library for Complex-0.1.0.0.. +Configuring executable 'Complex' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"lib","name":"lib","unit-id":"Complex-0.1.0.0-inplace","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-isrc","-idoesnt-exist","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for criterion-1.1.4.0.. +Preprocessing library for criterion-1.1.4.0.. +Building library for criterion-1.1.4.0.. +Installing library in +Configuring benchmark 'complex-benchmarks' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for test-framework-0.8.1.1.. +Preprocessing library for test-framework-0.8.1.1.. +Building library for test-framework-0.8.1.1.. +Installing library in +Configuring test suite 'func-test' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for another-framework-0.8.1.1.. +Preprocessing library for another-framework-0.8.1.1.. +Building library for another-framework-0.8.1.1.. +Installing library in +Configuring test suite 'unit-test' for Complex-0.1.0.0.. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs new file mode 100644 index 00000000000..f3d0622d0ff --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs @@ -0,0 +1,33 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withRepo "repo" $ do + runShowBuildInfoWithMarker ["exe:Complex"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [exeComp] = components buildInfo + assertExeComponent' exeComp "exe:Complex" ["Other", "Paths_Complex"] ["Main.lhs"] ["app"]) + + runShowBuildInfoWithMarker ["lib:Complex"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [libComp] = components buildInfo + assertLibComponent libComp "lib" ["A", "B", "C", "D", "Paths_Complex"] ["src", "doesnt-exist"]) + + runShowBuildInfoWithMarker ["benchmark:complex-benchmarks"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [benchComp] = components buildInfo + assertBenchComponent' benchComp "bench:complex-benchmarks" ["Paths_Complex"] ["Main.hs"] ["benchmark"]) + + runShowBuildInfoWithMarker ["test:func-test"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [testComp] = components buildInfo + assertTestComponent testComp "test:func-test" ["FuncMain.hs"] ["test"]) + + runShowBuildInfoWithMarker ["test:unit-test"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [testComp] = components buildInfo + assertTestComponent testComp "test:unit-test" ["UnitMain.hs"] ["test"]) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs new file mode 100644 index 00000000000..18032f68988 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs @@ -0,0 +1,5 @@ +module A where + +import D + +foo = d diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs new file mode 100644 index 00000000000..93b0222a65d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs @@ -0,0 +1,3 @@ +module B where + +b = 1 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs new file mode 100644 index 00000000000..419eb7eca64 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs @@ -0,0 +1,5 @@ +module C where + +import B + +c = b diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs new file mode 100644 index 00000000000..d9be40b5ba2 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs @@ -0,0 +1,5 @@ +module D where + +import C + +d = c diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs deleted file mode 100644 index 5d35e3e9617..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Lib where - -foo :: Int -> Int -foo = (+1) \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs deleted file mode 100644 index a1b75006b8d..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs +++ /dev/null @@ -1,9 +0,0 @@ -module Main where - -import Lib - -main :: IO () -main = do - let i = foo 5 - putStrLn "Hello, Haskell!" - print i diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/FuncMain.hs similarity index 100% rename from cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs rename to cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/FuncMain.hs diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal deleted file mode 100644 index 0af36bee5bb..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal +++ /dev/null @@ -1,9 +0,0 @@ -cabal-version: 2.4 -name: D -version: 0.1.0.0 -license: BSD-3-Clause - -library - exposed-modules: Lib - build-depends: base, D1 - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal deleted file mode 100644 index 09118f6e84e..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal +++ /dev/null @@ -1,9 +0,0 @@ -cabal-version: 2.4 -name: D1 -version: 0.1.0.0 -license: BSD-3-Clause - -library - exposed-modules: Lib1 - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs deleted file mode 100644 index 50919006b5f..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs +++ /dev/null @@ -1,3 +0,0 @@ -module Lib1 where - -bar = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs deleted file mode 100644 index 638711c17e5..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Lib where - --- Point of this is to make sure we can still get the build info even if one of --- the components doesn't compile -foo :: String -foo = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out deleted file mode 100644 index 8a876417a2c..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out +++ /dev/null @@ -1,2 +0,0 @@ -# cabal clean -# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs deleted file mode 100644 index e3c0edb3651..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs +++ /dev/null @@ -1,8 +0,0 @@ -import Test.Cabal.Prelude - -main = cabalTest $ do - -- Make sure the vendored dependency D1 gets built - cabal' "clean" [] - r <- cabal' "show-build-info" ["-v1", "D", "D1"] - assertOutputContains "Building library for D1-0.1.0.0.." r - assertOutputDoesNotContain "Building library for D-0.1.0.0.." r diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project deleted file mode 100644 index e7083db0d01..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project +++ /dev/null @@ -1,2 +0,0 @@ -packages: . - ./D1 diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index 5b33be70a7d..355559ff06c 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -2,50 +2,63 @@ module Test.Cabal.DecodeShowBuildInfo where import Test.Cabal.Prelude -import qualified Distribution.Simple.Utils as U (cabalVersion) import Distribution.Text (display) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Aeson +import GHC.Stack.Types import GHC.Generics +-- | Run 'show-build-info' silencing all output using '-v0'. +-- This is necessary to make sure no stray output from 'show-build-info' makes +-- parsing impossible. runShowBuildInfo :: [String] -> TestM BuildInfo runShowBuildInfo args = do - r <- cabal' "show-build-info" args - case eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) of - Left err -> fail $ "Could not parse show-build-info command: " ++ err - Right buildInfos -> return buildInfos + r <- cabal' "show-build-info" ("-v0":args) + decodeShowBuildInfo (resultOutput r) + +-- | Same as 'runShowBuildInfo' but does not require the verbosity '-v0'. +-- Uses "-vverbose +markoutput +nowrap" to extract the relevant json output. +runShowBuildInfoWithMarker :: [String] -> TestM BuildInfo +runShowBuildInfoWithMarker args = do + r <- cabal' "show-build-info" args + decodeShowBuildInfo (last . lines . getMarkedOutput $ resultOutput r) + +decodeShowBuildInfo :: String -> TestM BuildInfo +decodeShowBuildInfo s = case eitherDecodeStrict (T.encodeUtf8 $ T.pack s) of + Left err -> fail $ "Could not parse show-build-info command: " ++ err + Right buildInfos -> return buildInfos decodeBuildInfoFile :: FilePath -> TestM BuildInfo decodeBuildInfoFile fp = do - shouldExist fp - res <- liftIO $ eitherDecodeFileStrict fp - case res of - Left err -> fail $ "Could not parse show-build-info file: " ++ err - Right buildInfos -> return buildInfos + shouldExist fp + res <- liftIO $ eitherDecodeFileStrict fp + case res of + Left err -> fail $ "Could not parse show-build-info file: " ++ err + Right buildInfos -> return buildInfos data BuildInfo = BuildInfo - { cabalVersion :: String - , compiler :: CompilerInfo - , components :: [ComponentInfo] - } deriving (Generic, Show) + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) data CompilerInfo = CompilerInfo - { flavour :: String - , compilerId :: String - , path :: String - } deriving (Generic, Show) + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) data ComponentInfo = ComponentInfo - { componentType :: String - , componentName :: String - , componentUnitId :: String - , componentCompilerArgs :: [String] - , componentModules :: [String] - , componentSrcFiles :: [FilePath] - , componentHsSrcDirs :: [FilePath] - , componentSrcDir :: FilePath - } deriving (Generic, Show) + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [FilePath] + , componentHsSrcDirs :: [FilePath] + , componentSrcDir :: FilePath + } deriving (Generic, Show) instance ToJSON BuildInfo where toEncoding = genericToEncoding defaultOptions @@ -62,5 +75,50 @@ instance ToJSON ComponentInfo where instance FromJSON ComponentInfo where parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } -cabalVersionLibrary :: String -cabalVersionLibrary = display U.cabalVersion +-- ----------------------------------------------------------- +-- Assertion Helpers to define succinct test cases +-- ----------------------------------------------------------- + +assertCommonBuildInfo :: (HasCallStack, MonadIO m) => BuildInfo -> m () +assertCommonBuildInfo buildInfo = do + assertEqual "Cabal Version" (display cabalVersionLibrary) (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + +assertExeComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertExeComponent = assertExecutableComp "exe" + +assertExeComponent' :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> [String] -> m () +assertExeComponent' component compName modules sourceFiles sourceDirs = + assertArbitraryComp "exe" compName (not . null) (not . null) modules sourceFiles sourceDirs component + +assertLibComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertLibComponent component compName modules sourceDirs = + assertArbitraryComp "lib" compName (not . null) (not . null) modules [] sourceDirs component + +assertTestComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertTestComponent = assertExecutableComp "test" + +assertBenchComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertBenchComponent = assertExecutableComp "bench" + +assertBenchComponent' :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> [String] -> m () +assertBenchComponent' component compName modules sourceFiles sourceDirs = + assertArbitraryComp "bench" compName (not . null) (not . null) modules sourceFiles sourceDirs component + +assertExecutableComp :: (HasCallStack, MonadIO m) => String -> ComponentInfo -> String -> [String] -> [String] -> m () +assertExecutableComp compType component compName sourceFiles sourceDirs = + assertArbitraryComp compType compName (not . null) (not . null) [] sourceFiles sourceDirs component + +assertArbitraryComp :: (HasCallStack, MonadIO m) => String -> String -> + (String -> Bool) -> ([String] -> Bool) -> [String] -> [FilePath] -> + [FilePath] -> ComponentInfo -> m () +assertArbitraryComp compType compName unitIdPred compilerArgsPred modules sourceFiles sourceDirs component = do + assertEqual "Component type" compType (componentType component) + assertEqual "Component name" compName (componentName component) + assertBool "Component Unit Id" (unitIdPred $ componentUnitId component) + assertBool "Component compiler args" (compilerArgsPred $ componentCompilerArgs component) + assertEqual "Component modules" modules (componentModules component) + assertEqual "Component source files" sourceFiles (componentSrcFiles component) + assertEqual "Component source directories" sourceDirs (componentHsSrcDirs component) diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index c320282c301..4a216b4b602 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -47,6 +47,8 @@ module Test.Cabal.Monad ( CommonArgs(..), renderCommonArgs, commonArgParser, + -- * Version Constants + cabalVersionLibrary, ) where import Test.Cabal.Script @@ -62,9 +64,11 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.Simple.Configure ( configCompilerEx ) +import qualified Distribution.Simple.Utils as U (cabalVersion) import Distribution.Text import Distribution.Verbosity +import Distribution.Version import Data.Monoid ((<>), mempty) import qualified Control.Exception as E @@ -398,6 +402,7 @@ mkNormalizerEnv = do list_out <- liftIO $ readProcess (programPath ghc_pkg_program) ["list", "--global", "--simple-output"] "" tmpDir <- liftIO $ getTemporaryDirectory + return NormalizerEnv { normalizerRoot = addTrailingPathSeparator (testSourceDir env), @@ -410,8 +415,14 @@ mkNormalizerEnv = do normalizerKnownPackages = mapMaybe simpleParse (words list_out), normalizerPlatform - = testPlatform env + = testPlatform env, + normalizerCabalVersion + = cabalVersionLibrary } + where + +cabalVersionLibrary :: Version +cabalVersionLibrary = U.cabalVersion requireProgramM :: Program -> TestM ConfiguredProgram requireProgramM program = do diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index 4e6aec19890..a1529cc47f9 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -49,6 +49,25 @@ normalizeOutput nenv = "/incoming/new-" -- Normalize architecture . resub (posixRegexEscape (display (normalizerPlatform nenv))) "" + -- Remove ghc path from show-build-info output + . resub ("\"path\":\"[^\"]*\"}") + "\"path\":\"\"}" + -- Remove cabal version output from show-build-info output + . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"") + "{\"cabal-version\":\"\"" + -- Remove the package id for stuff such as: + -- > "-package-id","base-4.14.0.0-" + -- and replace it with: + -- > "-package-id","" + -- + -- Otherwise, output can not be properly normalized as on MacOs we remove + -- vowels from packages to make the names shorter. + -- E.g. "another-framework-0.8.1.1" -> "nthr-frmwrk-0.8.1.1" + -- + -- This makes it impossible to have a stable package id, thus remove it completely. + -- Check manually in your test-cases if the package-id needs to be verified. + . resub ("\"-package-id\",\"([^\"]*)\"") + "\"-package-id\",\"\"" -- Some GHC versions are chattier than others . resub "^ignoring \\(possibly broken\\) abi-depends field for packages" "" -- Normalize the current GHC version. Apply this BEFORE packageIdRegex, @@ -74,6 +93,7 @@ data NormalizerEnv = NormalizerEnv , normalizerGhcVersion :: Version , normalizerKnownPackages :: [PackageId] , normalizerPlatform :: Platform + , normalizerCabalVersion :: Version } posixSpecialChars :: [Char]