From c183666d17f4292ca2159ef07a436655a7d68ee0 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 16 Aug 2015 19:50:39 +0200 Subject: [PATCH 01/24] 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. --- cabal-install/Distribution/Client/Setup.hs | 23 +++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 81b2709989c..71d74b7c82f 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/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 @@ -184,6 +184,7 @@ globalCommand commands = CommandUI { , "outdated" , "haddock" , "hscolour" + , "show-build-info" , "exec" , "new-build" , "new-configure" @@ -270,6 +271,7 @@ globalCommand commands = CommandUI { , addCmd "upload" , addCmd "report" , par + , addCmd "show-build-info" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -797,6 +799,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 26c3d917d81b15907ccf2dd40d57ff31c9b65ad3 Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 14 Sep 2019 20:49:27 +0200 Subject: [PATCH 02/24] 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 --- .../Distribution/Client/CmdShowBuildInfo.hs | 254 ++++++++++++++++++ .../Client/CmdWriteAutogenFiles.hs | 220 +++++++++++++++ cabal-install/Distribution/Client/Setup.hs | 29 ++ cabal-install/cabal-install.cabal | 2 + cabal-install/main/Main.hs | 116 ++++++-- 5 files changed, 604 insertions(+), 17 deletions(-) create mode 100644 cabal-install/Distribution/Client/CmdShowBuildInfo.hs create mode 100644 cabal-install/Distribution/Client/CmdWriteAutogenFiles.hs diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs new file mode 100644 index 00000000000..cc5a41bb6cc --- /dev/null +++ b/cabal-install/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/Distribution/Client/CmdWriteAutogenFiles.hs b/cabal-install/Distribution/Client/CmdWriteAutogenFiles.hs new file mode 100644 index 00000000000..86a80b6fa53 --- /dev/null +++ b/cabal-install/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/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 71d74b7c82f..94f3ba96172 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -52,6 +52,9 @@ module Distribution.Client.Setup , copyCommand , registerCommand + --ghc-mod support commands + , showBuildInfoCommand + , writeAutogenFilesCommand, WriteAutogenFilesFlags(..) , parsePackageArgs , liftOptions , yesNoOpt @@ -100,6 +103,7 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) + , WriteAutogenFilesFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -185,6 +189,7 @@ globalCommand commands = CommandUI { , "haddock" , "hscolour" , "show-build-info" + , "write-autogen-files" , "exec" , "new-build" , "new-configure" @@ -272,6 +277,7 @@ globalCommand commands = CommandUI { , addCmd "report" , par , addCmd "show-build-info" + , addCmd "write-autogen-files" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -2702,3 +2708,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 diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 5612816e4f8..086094ae437 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -162,6 +162,8 @@ executable cabal 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 04e1658ce70..86bee98cf28 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -49,6 +49,7 @@ import Distribution.Client.Setup , doctestCommand , copyCommand , registerCommand + , WriteAutogenFilesFlags(..) ) import Distribution.Simple.Setup ( HaddockTarget(..) @@ -80,6 +81,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 @@ -134,7 +137,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 @@ -157,7 +160,7 @@ import Distribution.Simple.Utils import Distribution.Text ( display ) import Distribution.Verbosity as Verbosity - ( Verbosity, normal ) + ( Verbosity, normal, silent ) import Distribution.Version ( Version, mkVersion, orLaterVersion ) import qualified Paths_cabal_install (version) @@ -253,7 +256,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 @@ -268,7 +275,6 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction - , legacyCmd configureExCommand configureAction , legacyCmd updateCommand updateAction , legacyCmd buildCommand buildAction @@ -389,23 +395,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. @@ -711,7 +773,7 @@ listAction listFlags extraArgs globalFlags = do , configHcPath = listHcPath listFlags } globalFlags' = savedGlobalFlags config `mappend` globalFlags - compProgdb <- if listNeedsCompiler listFlags + compProgdb <- if listNeedsCompiler listFlags then do (comp, _, progdb) <- configCompilerAux' configFlags return (Just (comp, progdb)) @@ -1017,3 +1079,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 () From 5338fdcf946b2648fa930a88b68bf00426b9dc6c Mon Sep 17 00:00:00 2001 From: fendor Date: Sat, 14 Sep 2019 20:50:17 +0200 Subject: [PATCH 03/24] Improve s-b-i frontend command and add tests Also, rename new-show-build-info to show-build-info in ShowBuildInfo --- Cabal/Distribution/Simple/ShowBuildInfo.hs | 2 +- cabal-install/Distribution/Client/CmdBuild.hs | 3 +- .../Distribution/Client/CmdShowBuildInfo.hs | 303 +++++++++++------- .../Client/CmdWriteAutogenFiles.hs | 220 ------------- cabal-install/Distribution/Client/Setup.hs | 34 +- .../Distribution/Client/SetupWrapper.hs | 2 +- cabal-install/cabal-install.cabal | 3 +- cabal-install/cabal-install.cabal.dev | 1 + cabal-install/main/Main.hs | 55 ++-- .../PackageTests/ShowBuildInfo/A/A.cabal | 32 ++ .../PackageTests/ShowBuildInfo/A/CHANGELOG.md | 5 + .../PackageTests/ShowBuildInfo/A/LICENSE | 30 ++ .../PackageTests/ShowBuildInfo/A/Setup.hs | 2 + .../ShowBuildInfo/A/build-info-exe-exact.out | 1 + .../A/build-info-exe-exact.test.hs | 68 ++++ ...build-info-multiple-exact-unit-id-file.out | 1 + ...d-info-multiple-exact-unit-id-file.test.hs | 92 ++++++ .../A/build-info-multiple-exact-unit-id.out | 1 + .../build-info-multiple-exact-unit-id.test.hs | 89 +++++ .../A/build-info-multiple-exact.out | 1 + .../A/build-info-multiple-exact.test.hs | 89 +++++ .../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 | 24 ++ .../PackageTests/ShowBuildInfo/B/CHANGELOG.md | 5 + .../PackageTests/ShowBuildInfo/B/LICENSE | 30 ++ .../PackageTests/ShowBuildInfo/B/Setup.hs | 2 + .../ShowBuildInfo/B/build-info-lib-exact.out | 1 + .../B/build-info-lib-exact.test.hs | 68 ++++ .../ShowBuildInfo/B/cabal.project | 1 + .../PackageTests/ShowBuildInfo/B/src/A.hs | 4 + .../ShowBuildInfo/Complex/CHANGELOG.md | 5 + .../ShowBuildInfo/Complex/Complex.cabal | 54 ++++ .../ShowBuildInfo/Complex/LICENSE | 20 ++ .../ShowBuildInfo/Complex/Setup.hs | 2 + .../ShowBuildInfo/Complex/cabal.project | 1 + .../ShowBuildInfo/Complex/exe.out | 1 + .../ShowBuildInfo/Complex/exe.test.hs | 84 +++++ .../ShowBuildInfo/Complex/lib.out | 1 + .../ShowBuildInfo/Complex/lib.test.hs | 83 +++++ .../ShowBuildInfo/Complex/src/Lib.hs | 4 + .../ShowBuildInfo/Complex/src/Main.lhs | 9 + .../ShowBuildInfo/Complex/test/Main.hs | 1 + 46 files changed, 1062 insertions(+), 407 deletions(-) delete mode 100644 cabal-install/Distribution/Client/CmdWriteAutogenFiles.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE 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/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE 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/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE 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 diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index 74f5de2d41b..b0bb0e16093 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/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/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 2fe43f596d1..fc26a62a014 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/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/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index cc5a41bb6cc..311595ca022 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -1,27 +1,41 @@ --- | cabal-install CLI command: build +-- | cabal-install CLI command: show-build-info -- -module Distribution.Client.CmdShowBuildInfo ( - -- * The @build@ CLI and action - showBuildInfoCommand, - showBuildInfoAction - ) where +module Distribution.Client.CmdShowBuildInfo where +-- ( +-- -- * The @show-build-info@ CLI and action +-- showBuildInfoCommand, +-- showBuildInfoAction +-- ) +import Distribution.Client.Compat.Prelude + ( when, find, fromMaybe ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, fromFlagOrDefault, TestFlags ) + ( HaddockFlags, TestFlags + , 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 @@ -31,67 +45,78 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectPlanning ( setupHsConfigureFlags, setupHsConfigureArgs, - setupHsBuildFlags, setupHsBuildArgs, + 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) +import qualified Distribution.Client.CmdInstall as CmdInstall -showBuildInfoCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags) -showBuildInfoCommand = Client.installCommand { - commandName = "new-show-build-info", +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, ClientInstallFlags) + , buildInfoOutputFile :: Maybe FilePath + , buildInfoUnitIds :: Maybe [String] + } + +defaultShowBuildInfoFlags :: ShowBuildInfoFlags +defaultShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty) + , buildInfoOutputFile = Nothing + , buildInfoUnitIds = Nothing + } --- | The @build@ command does a lot. It brings the install plan up to date, +-- | The @show-build-info@ 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 - } - } +showBuildInfoAction :: ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () +showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, 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 +138,127 @@ 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 -- 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 corrct + (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 +292,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 +302,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 @@ -251,4 +324,4 @@ renderTargetProblem (TargetProblemCommon problem) = renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = renderTargetProblemNoneEnabled "build" targetSelector targets renderTargetProblem(TargetProblemNoTargets targetSelector) = - renderTargetProblemNoTargets "build" targetSelector \ No newline at end of file + renderTargetProblemNoTargets "build" targetSelector diff --git a/cabal-install/Distribution/Client/CmdWriteAutogenFiles.hs b/cabal-install/Distribution/Client/CmdWriteAutogenFiles.hs deleted file mode 100644 index 86a80b6fa53..00000000000 --- a/cabal-install/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/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 94f3ba96172..d6922182dca 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -51,10 +51,7 @@ module Distribution.Client.Setup , doctestCommand , copyCommand , registerCommand - - --ghc-mod support commands - , showBuildInfoCommand - , writeAutogenFilesCommand, WriteAutogenFilesFlags(..) + --, showBuildInfoCommand , parsePackageArgs , liftOptions , yesNoOpt @@ -103,7 +100,6 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) - , WriteAutogenFilesFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -189,7 +185,6 @@ globalCommand commands = CommandUI { , "haddock" , "hscolour" , "show-build-info" - , "write-autogen-files" , "exec" , "new-build" , "new-configure" @@ -277,7 +272,6 @@ globalCommand commands = CommandUI { , addCmd "report" , par , addCmd "show-build-info" - , addCmd "write-autogen-files" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -805,25 +799,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 -- ------------------------------------------------------------ @@ -2711,10 +2686,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 = @@ -2728,6 +2703,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/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 22ccf021128..464452978fd 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/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-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 086094ae437..1d03ae9b57c 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -162,8 +162,6 @@ executable cabal Distribution.Client.CmdBench Distribution.Client.CmdBuild Distribution.Client.CmdClean - Distribution.Client.CmdShowBuildInfo - Distribution.Client.CmdWriteAutogenFiles Distribution.Client.CmdConfigure Distribution.Client.CmdErrorMessages Distribution.Client.CmdExec @@ -176,6 +174,7 @@ executable cabal Distribution.Client.CmdListBin Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdSdist Distribution.Client.CmdTest Distribution.Client.CmdUpdate diff --git a/cabal-install/cabal-install.cabal.dev b/cabal-install/cabal-install.cabal.dev index 8bdfc353862..a0b858f5182 100644 --- a/cabal-install/cabal-install.cabal.dev +++ b/cabal-install/cabal-install.cabal.dev @@ -166,6 +166,7 @@ library cabal-lib-client Distribution.Client.CmdListBin 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 86bee98cf28..6b404d5430e 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -49,7 +49,6 @@ import Distribution.Client.Setup , doctestCommand , copyCommand , registerCommand - , WriteAutogenFilesFlags(..) ) import Distribution.Simple.Setup ( HaddockTarget(..) @@ -82,7 +81,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 @@ -137,7 +135,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 @@ -160,7 +158,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 ) import qualified Paths_cabal_install (version) @@ -259,8 +257,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 @@ -402,13 +398,14 @@ buildAction flags@(buildFlags, _) = buildActionForCommand 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) +-- showBuildInfoAction :: (Cabal.ShowBuildInfoFlags, BuildExFlags) -> [String] -> Action +-- showBuildInfoAction (showBuildInfoFlags, buildEx) = buildActionForCommand +-- (Cabal.showBuildInfoCommand defaultProgramDb) +-- showBuildInfoFlags +-- verbosity +-- (Cabal.buildInfoBuildFlags showBuildInfoFlags, buildEx) +-- -- Default silent verbosity so as not to pollute json output +-- where verbosity = fromFlagOrDefault silent (buildVerbosity (Cabal.buildInfoBuildFlags showBuildInfoFlags )) buildActionForCommand :: CommandUI BuildFlags -> Verbosity @@ -423,23 +420,13 @@ buildActionForCommand commandUI verbosity (buildFlags, buildExFlags) extraArgs g 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 + config' <- reconfigure + configureAction verbosity distPref useSandbox noAddSource + (buildNumJobs buildFlags) mempty [] globalFlags config + + nixShell verbosity distPref globalFlags config $ + 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 @@ -447,6 +434,7 @@ buildActionForCommand commandUI verbosity (buildFlags, buildExFlags) extraArgs g build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () build = buildForCommand (Cabal.buildCommand defaultProgramDb) +-- | Helper function buildForCommand :: CommandUI BuildFlags -> Verbosity -> SavedConfig @@ -455,12 +443,7 @@ buildForCommand :: CommandUI BuildFlags -> [String] -> IO () buildForCommand command verbosity config distPref buildFlags extraArgs = - setupWrapper verbosity - setupOptions - Nothing - command - mkBuildFlags - (const extraArgs) + setupWrapper verbosity setupOptions Nothing command mkBuildFlags (const extraArgs) where setupOptions = defaultSetupScriptOptions { useDistPref = distPref } diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal new file mode 100644 index 00000000000..2873a450394 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -0,0 +1,32 @@ +cabal-version: 2.4 +-- Initial package description 'A.cabal' generated by 'cabal init'. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: A +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD-3-Clause +license-file: LICENSE +author: Foo Bar +maintainer: cabal-dev@haskell.org +-- copyright: +-- category: +extra-source-files: CHANGELOG.md + +library + exposed-modules: A + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0 + hs-source-dirs: src + default-language: Haskell2010 + +executable A + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md new file mode 100644 index 00000000000..cfa8b563c0e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for A + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE new file mode 100644 index 00000000000..671281e7a8b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Foo Bar + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Foo Bar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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..7c8a2be90ea --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["exe:A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.1.0.0" (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) + return () + +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 '-' } \ 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-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..abdc7d649f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ withSourceCopy $do + cwd <- fmap testCurrentDir getTestEnv + let fp = cwd "unit.json" + r <- 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"] + shouldExist fp + buildInfoEither <- liftIO $ eitherDecodeFileStrict fp + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.1.0.0" (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" "3.1.0.0" (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) + +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 '-' } \ No newline at end of file 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..63d928bc21c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.1.0.0" (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" "3.1.0.0" (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) + +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 '-' } \ No newline at end of file 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..14b523e3992 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["exe:A", "lib:A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.1.0.0" (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" "3.1.0.0" (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) + +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 '-' } \ No newline at end of file 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..5356e76f67c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -0,0 +1 @@ +packages: . \ No newline at end of file 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..d8ed91d655b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal @@ -0,0 +1,24 @@ +cabal-version: 2.4 +-- Initial package description 'B.cabal' generated by 'cabal init'. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: B +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD-3-Clause +license-file: LICENSE +author: Foo Bar +maintainer: cabal-dev@haskell.org +-- copyright: +-- category: +extra-source-files: CHANGELOG.md + +library + exposed-modules: A + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md new file mode 100644 index 00000000000..5cf6ac2adb2 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for B + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE new file mode 100644 index 00000000000..671281e7a8b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Foo Bar + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Foo Bar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 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..c09a36a274f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["lib:B", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.1.0.0" (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) + return () + +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 '-' } \ No newline at end of file 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..ad7a0c07729 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/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/Complex/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md new file mode 100644 index 00000000000..624468cdfdb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for Complex + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal new file mode 100644 index 00000000000..9047830cd4f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -0,0 +1,54 @@ +cabal-version: 2.4 +name: Complex +version: 0.1.0.0 +license: MIT +license-file: LICENSE +author: Bla Bla +maintainer: "" +category: Testing +extra-source-files: CHANGELOG.md + + +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/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE new file mode 100644 index 00000000000..a234fc7e8dd --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2019 Bla Bla + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 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..5356e76f67c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -0,0 +1 @@ +packages: . \ No newline at end of file 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..e56a02600ff --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["exe:Complex", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.1.0.0" (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) + return () + +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 '-' } \ No newline at end of file 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..d119eb633d9 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "show-build-info" ["lib:Complex", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.1.0.0" (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) + return () + +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 '-' } \ No newline at end of file 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..3ef47688534 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs @@ -0,0 +1 @@ +main = return () \ No newline at end of file From 6faaac953f25588d0addd2ab543b0ccade66b9a9 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 30 Apr 2020 17:13:46 +0100 Subject: [PATCH 04/24] Get cabal-install building again --- .../Distribution/Client/CmdShowBuildInfo.hs | 9 +++++---- cabal-install/main/Main.hs | 19 ------------------- 2 files changed, 5 insertions(+), 23 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 311595ca022..5b456a301c8 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -18,7 +18,7 @@ import Distribution.Client.Setup ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup - ( HaddockFlags, TestFlags + ( HaddockFlags, TestFlags, BenchmarkFlags , fromFlagOrDefault ) import Distribution.Simple.Command @@ -91,14 +91,14 @@ showBuildInfoCommand = CmdInstall.installCommand { } data ShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoInstallCommandFlags :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ClientInstallFlags) + { buildInfoInstallCommandFlags :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, BenchmarkFlags, ClientInstallFlags) , buildInfoOutputFile :: Maybe FilePath , buildInfoUnitIds :: Maybe [String] } defaultShowBuildInfoFlags :: ShowBuildInfoFlags defaultShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty) + { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty) , buildInfoOutputFile = Nothing , buildInfoUnitIds = Nothing } @@ -111,7 +111,7 @@ defaultShowBuildInfoFlags = ShowBuildInfoFlags -- "Distribution.Client.ProjectOrchestration" -- showBuildInfoAction :: ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () -showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, clientInstallFlags) fileOutput unitIds) +showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, benchmarkFlags, clientInstallFlags) fileOutput unitIds) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand let baseCtx' = baseCtx @@ -147,6 +147,7 @@ showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlag 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 :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 6b404d5430e..388e7503b45 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -1063,22 +1063,3 @@ manpageAction commands flags extraArgs _ = do 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 () From d0cf8d7e69c46e686bcffa4fb36d99168e06d334 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Fri, 1 May 2020 20:18:08 +0100 Subject: [PATCH 05/24] Fix typo --- cabal-install/Distribution/Client/CmdShowBuildInfo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 5b456a301c8..e8ba5d8bfe2 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -219,7 +219,7 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir configureArgs = setupHsConfigureArgs pkg - -- check cabal version is corrct + -- check cabal version is correct (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions (elabPkgDescription pkg) buildType' when (cabalVersion < mkVersion [3, 0, 0,0]) From b17c1cc33f0bc1ea96ce7160dd7af656b4733343 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Fri, 1 May 2020 20:18:15 +0100 Subject: [PATCH 06/24] Don't hardcode cabal version in showbuildinfo tests --- .../ShowBuildInfo/A/build-info-exe-exact.test.hs | 2 +- .../A/build-info-multiple-exact-unit-id-file.test.hs | 4 ++-- .../A/build-info-multiple-exact-unit-id.test.hs | 4 ++-- .../ShowBuildInfo/A/build-info-multiple-exact.test.hs | 4 ++-- .../ShowBuildInfo/B/build-info-lib-exact.test.hs | 2 +- .../PackageTests/ShowBuildInfo/Complex/exe.test.hs | 2 +- .../PackageTests/ShowBuildInfo/Complex/lib.test.hs | 2 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 6 +++++- 8 files changed, 15 insertions(+), 11 deletions(-) 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 7c8a2be90ea..5cf0c800c14 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 @@ -14,7 +14,7 @@ main = cabalTest $ do Right buildInfos -> do assertEqual "Build Infos, exactly one" 1 (length buildInfos) let [buildInfo] = buildInfos - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) 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 abdc7d649f4..61262f12bd2 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 where assertExe :: BuildInfo -> TestM () assertExe buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) @@ -39,7 +39,7 @@ main = cabalTest $ withSourceCopy $do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) 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 63d928bc21c..5fe552ce24d 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 @@ -20,7 +20,7 @@ main = cabalTest $ do where assertExe :: BuildInfo -> TestM () assertExe buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) @@ -36,7 +36,7 @@ main = cabalTest $ do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) 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 14b523e3992..ce0d80ec350 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 @@ -20,7 +20,7 @@ main = cabalTest $ do where assertExe :: BuildInfo -> TestM () assertExe buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) @@ -36,7 +36,7 @@ main = cabalTest $ do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) 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 c09a36a274f..21891f6c905 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 @@ -14,7 +14,7 @@ main = cabalTest $ do Right buildInfos -> do assertEqual "Build Infos, exactly one" 1 (length buildInfos) let [buildInfo] = buildInfos - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index e56a02600ff..d56637ebc2b 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -14,7 +14,7 @@ main = cabalTest $ do Right buildInfos -> do assertEqual "Build Infos, exactly one" 1 (length buildInfos) let [buildInfo] = buildInfos - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index d119eb633d9..7f90ab36b94 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -14,7 +14,7 @@ main = cabalTest $ do Right buildInfos -> do assertEqual "Build Infos, exactly one" 1 (length buildInfos) let [buildInfo] = buildInfos - assertEqual "Cabal Version" "3.1.0.0" (cabalVersion buildInfo) + assertEqual "Cabal Version" cabalVersionString (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) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 2c95c4e4f70..e5262cd0196 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, cabalVersion ) import Distribution.Simple.Configure ( getPersistBuildConfig ) import Distribution.Version @@ -39,6 +39,7 @@ import Distribution.Types.LocalBuildInfo import Distribution.PackageDescription import Distribution.PackageDescription.Parsec import Distribution.Verbosity (normal) +import Distribution.Text import Distribution.Compat.Stack @@ -992,3 +993,6 @@ withShorterPathForNewBuildStore test = do then takeDrive `fmap` getCurrentDirectory else getTemporaryDirectory withTempDirectory normal tempDir "cabal-test-store" test + +cabalVersionString :: String +cabalVersionString = display cabalVersion \ No newline at end of file From 815a16d64237f3d62f888061c31415c026531649 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 3 May 2020 14:36:38 +0100 Subject: [PATCH 07/24] Remove some unnecessary files from test package --- .../PackageTests/ShowBuildInfo/A/A.cabal | 16 ---------- .../PackageTests/ShowBuildInfo/A/CHANGELOG.md | 5 ---- .../PackageTests/ShowBuildInfo/A/LICENSE | 30 ------------------- .../PackageTests/ShowBuildInfo/B/B.cabal | 14 --------- .../PackageTests/ShowBuildInfo/B/CHANGELOG.md | 5 ---- .../PackageTests/ShowBuildInfo/B/LICENSE | 30 ------------------- .../ShowBuildInfo/Complex/CHANGELOG.md | 5 ---- .../ShowBuildInfo/Complex/Complex.cabal | 6 ---- .../ShowBuildInfo/Complex/LICENSE | 20 ------------- 9 files changed, 131 deletions(-) delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md delete mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal index 2873a450394..40f0a570d5a 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -1,32 +1,16 @@ cabal-version: 2.4 --- Initial package description 'A.cabal' generated by 'cabal init'. For --- further documentation, see http://haskell.org/cabal/users-guide/ - name: A version: 0.1.0.0 --- synopsis: --- description: --- bug-reports: license: BSD-3-Clause -license-file: LICENSE -author: Foo Bar -maintainer: cabal-dev@haskell.org --- copyright: --- category: -extra-source-files: CHANGELOG.md library exposed-modules: A - -- other-modules: - -- other-extensions: build-depends: base >=4.0.0 hs-source-dirs: src default-language: Haskell2010 executable A main-is: Main.hs - -- other-modules: - -- other-extensions: build-depends: base >=4.0.0.0 hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md deleted file mode 100644 index cfa8b563c0e..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for A - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE deleted file mode 100644 index 671281e7a8b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2019, Foo Bar - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Foo Bar nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal index d8ed91d655b..5536cc34c4d 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal @@ -1,24 +1,10 @@ cabal-version: 2.4 --- Initial package description 'B.cabal' generated by 'cabal init'. For --- further documentation, see http://haskell.org/cabal/users-guide/ - name: B version: 0.1.0.0 --- synopsis: --- description: --- bug-reports: license: BSD-3-Clause -license-file: LICENSE -author: Foo Bar -maintainer: cabal-dev@haskell.org --- copyright: --- category: -extra-source-files: CHANGELOG.md library exposed-modules: A - -- other-modules: - -- other-extensions: build-depends: base >=4.0.0.0 hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md deleted file mode 100644 index 5cf6ac2adb2..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for B - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE deleted file mode 100644 index 671281e7a8b..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2019, Foo Bar - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Foo Bar nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md deleted file mode 100644 index 624468cdfdb..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md +++ /dev/null @@ -1,5 +0,0 @@ -# Revision history for Complex - -## 0.1.0.0 -- YYYY-mm-dd - -* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal index 9047830cd4f..db2a4c566d8 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -2,12 +2,6 @@ cabal-version: 2.4 name: Complex version: 0.1.0.0 license: MIT -license-file: LICENSE -author: Bla Bla -maintainer: "" -category: Testing -extra-source-files: CHANGELOG.md - library build-depends: base diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE deleted file mode 100644 index a234fc7e8dd..00000000000 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE +++ /dev/null @@ -1,20 +0,0 @@ -Copyright (c) 2019 Bla Bla - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. From 3a956b1e3a14f33badc32c83cb1b63c61ef4d50e Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 3 May 2020 14:55:04 +0100 Subject: [PATCH 08/24] Refactor show-build-info tests --- .../A/build-info-exe-exact.test.hs | 82 +++---------- ...d-info-multiple-exact-unit-id-file.test.hs | 68 ++--------- .../build-info-multiple-exact-unit-id.test.hs | 64 ++-------- .../A/build-info-multiple-exact.test.hs | 64 ++-------- .../B/build-info-lib-exact.test.hs | 82 +++---------- .../ShowBuildInfo/Complex/exe.test.hs | 114 +++++------------- .../ShowBuildInfo/Complex/lib.test.hs | 112 +++++------------ cabal-testsuite/cabal-testsuite.cabal | 1 + .../src/Test/Cabal/DecodeShowBuildInfo.hs | 65 ++++++++++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 6 +- 10 files changed, 192 insertions(+), 466 deletions(-) create mode 100644 cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs 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 5cf0c800c14..962cacaf416 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 @@ -1,68 +1,20 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["exe:A", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos - assertEqual "Cabal Version" cabalVersionString (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) - return () - -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 '-' } \ No newline at end of file + 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.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs index 61262f12bd2..6c3109019e7 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 @@ -1,29 +1,19 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics - -main = cabalTest $ withSourceCopy $do +main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv let fp = cwd "unit.json" - r <- 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"] - shouldExist fp - buildInfoEither <- liftIO $ eitherDecodeFileStrict fp - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos - assertExe exeBuildInfo - assertLib libBuildInfo - return () + _ <- 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" cabalVersionString (cabalVersion buildInfo) + 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) @@ -39,7 +29,7 @@ main = cabalTest $ withSourceCopy $do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionString (cabalVersion buildInfo) + 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) @@ -52,41 +42,3 @@ main = cabalTest $ withSourceCopy $do assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - -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 '-' } \ No newline at end of file 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 5fe552ce24d..e17f1113720 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 @@ -1,26 +1,16 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos - assertExe exeBuildInfo - assertLib libBuildInfo - return () + 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" cabalVersionString (cabalVersion buildInfo) + 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) @@ -36,7 +26,7 @@ main = cabalTest $ do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionString (cabalVersion buildInfo) + 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) @@ -49,41 +39,3 @@ main = cabalTest $ do assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - -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 '-' } \ No newline at end of file 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 ce0d80ec350..9ec29f3c90f 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 @@ -1,26 +1,16 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["exe:A", "lib:A", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos - assertExe exeBuildInfo - assertLib libBuildInfo - return () + 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" cabalVersionString (cabalVersion buildInfo) + 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) @@ -36,7 +26,7 @@ main = cabalTest $ do assertLib :: BuildInfo -> TestM () assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionString (cabalVersion buildInfo) + 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) @@ -49,41 +39,3 @@ main = cabalTest $ do assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - -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 '-' } \ No newline at end of file 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 21891f6c905..3c32164830f 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 @@ -1,68 +1,20 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["lib:B", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos - assertEqual "Cabal Version" cabalVersionString (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) - return () - -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 '-' } \ No newline at end of file + 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/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index d56637ebc2b..7d0560321a4 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -1,84 +1,36 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["exe:Complex", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos - assertEqual "Cabal Version" cabalVersionString (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) - return () - -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 '-' } \ No newline at end of file + 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.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index 7f90ab36b94..76dbc720543 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -1,83 +1,35 @@ -{-# LANGUAGE DeriveGeneric #-} import Test.Cabal.Prelude - -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Aeson -import GHC.Generics +import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - r <- cabal' "show-build-info" ["lib:Complex", "-v0"] - let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] - case buildInfoEither of - Left err -> fail $ "Could not parse build-info command" ++ err - Right buildInfos -> do - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos - assertEqual "Cabal Version" cabalVersionString (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) - return () - -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 '-' } \ No newline at end of file + 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/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index b9bf0fa9e24..f99d320c733 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 e5262cd0196..6232f417a93 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, cabalVersion ) + ( withFileContents, withTempDirectory, tryFindPackageDesc) import Distribution.Simple.Configure ( getPersistBuildConfig ) import Distribution.Version @@ -39,7 +39,6 @@ import Distribution.Types.LocalBuildInfo import Distribution.PackageDescription import Distribution.PackageDescription.Parsec import Distribution.Verbosity (normal) -import Distribution.Text import Distribution.Compat.Stack @@ -993,6 +992,3 @@ withShorterPathForNewBuildStore test = do then takeDrive `fmap` getCurrentDirectory else getTemporaryDirectory withTempDirectory normal tempDir "cabal-test-store" test - -cabalVersionString :: String -cabalVersionString = display cabalVersion \ No newline at end of file From 947a9088791ece0e972a6e73df2938cb79c8058e Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 3 May 2020 15:15:56 +0100 Subject: [PATCH 09/24] Undo some changes no longer needed in Main.hs --- cabal-install/main/Main.hs | 84 +++++++++++++------------------------- 1 file changed, 29 insertions(+), 55 deletions(-) diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 388e7503b45..37329d27264 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -271,6 +271,7 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction + , legacyCmd configureExCommand configureAction , legacyCmd updateCommand updateAction , legacyCmd buildCommand buildAction @@ -392,65 +393,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 :: (Cabal.ShowBuildInfoFlags, BuildExFlags) -> [String] -> Action --- showBuildInfoAction (showBuildInfoFlags, buildEx) = buildActionForCommand --- (Cabal.showBuildInfoCommand defaultProgramDb) --- showBuildInfoFlags --- verbosity --- (Cabal.buildInfoBuildFlags showBuildInfoFlags, buildEx) --- -- Default silent verbosity so as not to pollute json output --- where verbosity = fromFlagOrDefault silent (buildVerbosity (Cabal.buildInfoBuildFlags showBuildInfoFlags )) - -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 $ - 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) - --- | Helper function -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. @@ -1062,4 +1037,3 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags - From f3bafbea3b024f7007b0c03580af858a02a4caa6 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 3 May 2020 16:43:46 +0100 Subject: [PATCH 10/24] Add back explicit exports and fix typos --- .../Distribution/Client/CmdShowBuildInfo.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index e8ba5d8bfe2..62b97dcc905 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -1,11 +1,10 @@ -- | cabal-install CLI command: show-build-info -- -module Distribution.Client.CmdShowBuildInfo where --- ( --- -- * The @show-build-info@ CLI and action --- showBuildInfoCommand, --- showBuildInfoAction --- ) +module Distribution.Client.CmdShowBuildInfo ( + -- * The @show-build-info@ CLI and action + showBuildInfoCommand, + showBuildInfoAction + ) where import Distribution.Client.Compat.Prelude ( when, find, fromMaybe ) @@ -219,7 +218,7 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir configureArgs = setupHsConfigureArgs pkg - -- check cabal version is correct + -- Check cabal version is correct (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions (elabPkgDescription pkg) buildType' when (cabalVersion < mkVersion [3, 0, 0,0]) @@ -227,7 +226,7 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = ++ "Found version: " ++ display cabalVersion ++ "\n" ++ "For component: " ++ display targetUnitId ) - --Configure the package if there's no existing config + -- Configure the package if there's no existing config lbi <- tryGetPersistBuildConfig buildDir case lbi of Left _ -> setupWrapper From 781695b18c98a6ae914c98b0ea6e850b71f8a051 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Sun, 3 May 2020 16:47:26 +0100 Subject: [PATCH 11/24] Tidy up imports --- .../Distribution/Client/CmdShowBuildInfo.hs | 38 ++++++++++--------- 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 62b97dcc905..f5f63190d94 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -13,16 +13,13 @@ import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags - ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, TestFlags, BenchmarkFlags - , fromFlagOrDefault - ) + , fromFlagOrDefault ) import Distribution.Simple.Command - ( CommandUI(..), option, reqArg', usageAlternatives - ) + ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils @@ -39,22 +36,27 @@ import Distribution.Deprecated.Text 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 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 (()) +import System.Directory + ( getTemporaryDirectory ) +import System.FilePath + ( () ) showBuildInfoCommand :: CommandUI ShowBuildInfoFlags showBuildInfoCommand = CmdInstall.installCommand { From fe2bab91aefa12cfc1947620d3a0393b3dc50c95 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 4 May 2020 12:51:07 +0100 Subject: [PATCH 12/24] Update showBuildInfoAction documentation --- cabal-install/Distribution/Client/CmdShowBuildInfo.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index f5f63190d94..d05a8c1cd5e 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -104,13 +104,9 @@ defaultShowBuildInfoFlags = ShowBuildInfoFlags , buildInfoUnitIds = Nothing } --- | The @show-build-info@ 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" --- +-- | 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 From af54a71a25fceb68d41dfa6988da7a91209a048b Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 1 Jun 2020 12:46:10 +0100 Subject: [PATCH 13/24] Cosmetic fixes --- Cabal/Distribution/Simple/BuildTarget.hs | 2 +- cabal-install/Distribution/Client/CmdShowBuildInfo.hs | 8 ++++---- .../PackageTests/ShowBuildInfo/A/cabal.project | 2 +- cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs | 2 +- .../PackageTests/ShowBuildInfo/Complex/cabal.project | 2 +- .../PackageTests/ShowBuildInfo/Complex/test/Main.hs | 2 +- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index 8d1ce3687c1..b702e16ec38 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -66,7 +66,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-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index d05a8c1cd5e..98e0a72f855 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -219,7 +219,7 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = -- Check cabal version is correct (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions (elabPkgDescription pkg) buildType' - when (cabalVersion < mkVersion [3, 0, 0,0]) + 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 @@ -318,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 + renderTargetProblemNoTargets "show-build-info" targetSelector diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project index 5356e76f67c..e6fdbadb439 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -1 +1 @@ -packages: . \ No newline at end of file +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs index ad7a0c07729..6b02eec8ec0 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/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/Complex/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project index 5356e76f67c..e6fdbadb439 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -1 +1 @@ -packages: . \ No newline at end of file +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs index 3ef47688534..b3549c2fe3d 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs @@ -1 +1 @@ -main = return () \ No newline at end of file +main = return () From 9708c4be0e8b495bbb6392960c64f5c900a6f37f Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 2 Jun 2020 19:15:58 +0100 Subject: [PATCH 14/24] Modernize CmdShowBuildInfo --- cabal-install/Distribution/Client/CmdBuild.hs | 3 +- .../Distribution/Client/CmdShowBuildInfo.hs | 94 ++++++------------- cabal-install/Distribution/Client/Setup.hs | 17 ++-- cabal-install/main/Main.hs | 17 ---- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 5 files changed, 39 insertions(+), 94 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index fc26a62a014..2fe43f596d1 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -8,8 +8,7 @@ module Distribution.Client.CmdBuild ( -- * Internals exposed for testing selectPackageTargets, - selectComponentTarget, - reportTargetProblems + selectComponentTarget ) where import Prelude () diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 98e0a72f855..170f3bcf841 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} -- | cabal-install CLI command: show-build-info -- module Distribution.Client.CmdShowBuildInfo ( @@ -10,14 +11,13 @@ import Distribution.Client.Compat.Prelude ( when, find, fromMaybe ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages -import Distribution.Client.CmdInstall.ClientInstallFlags +import Distribution.Client.TargetProblem + ( TargetProblem (..), TargetProblem' ) import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) -import qualified Distribution.Client.Setup as Client + ( GlobalFlags ) import Distribution.Simple.Setup - ( HaddockFlags, TestFlags, BenchmarkFlags - , fromFlagOrDefault ) + (configVerbosity, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity @@ -30,8 +30,8 @@ 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 @@ -43,6 +43,8 @@ import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectPlanning ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags , setupHsBuildArgs, setupHsScriptOptions ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout ( distBuildDirectory ) import Distribution.Client.Types @@ -51,15 +53,14 @@ 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 { +showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) +showBuildInfoCommand = CommandUI { commandName = "show-build-info", commandSynopsis = "Show project build information", commandUsage = usageAlternatives "show-build-info" [ "[TARGETS] [FLAGS]" ], @@ -75,9 +76,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 +86,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 @@ -122,11 +118,10 @@ showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlag 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 @@ -139,12 +134,8 @@ showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlag 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 + cliConfig = commandLineFlagsToProjectConfig globalFlags flags + mempty -- ClientInstallFlags, not needed here -- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () @@ -187,12 +178,12 @@ showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do printer "]" unitIdToFilePath :: UnitId -> FilePath - unitIdToFilePath unitId = "build-info-" ++ display unitId ++ ".json" + unitIdToFilePath unitId = "build-info-" ++ prettyShow 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 + Nothing -> die' verbosity $ "No unit " ++ prettyShow targetUnitId Just pkg -> do let shared = elaboratedShared buildCtx install = elaboratedPlanOriginal buildCtx @@ -221,8 +212,8 @@ 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 @@ -260,7 +251,7 @@ showInfo fileOutput 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 @@ -293,33 +284,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 diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index d6922182dca..0e7ed98dc9e 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -51,7 +51,7 @@ module Distribution.Client.Setup , doctestCommand , copyCommand , registerCommand - --, showBuildInfoCommand + , parsePackageArgs , liftOptions , yesNoOpt @@ -100,6 +100,7 @@ import Distribution.Simple.Setup , HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) + , ShowBuildInfoFlags(..) , readPackageDbList, showPackageDbList , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg @@ -2661,7 +2662,7 @@ parsePackageArgs = traverse p where Right pvc -> Right pvc Left err -> Left $ show arg ++ " is not valid syntax for a package name or" - ++ " package dependency. " ++ err + ++ " package dependency. " ++ err showRemoteRepo :: RemoteRepo -> String showRemoteRepo = prettyShow @@ -2689,17 +2690,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-install/main/Main.hs b/cabal-install/main/Main.hs index 37329d27264..a6e0d845848 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -392,23 +392,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-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 6232f417a93..2c95c4e4f70 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 7a59fd4a68397da23028efe5926fcf4c6b838af4 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 3 Jun 2020 15:54:49 +0100 Subject: [PATCH 15/24] 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. --- Cabal/Cabal.cabal | 4 +- Cabal/Distribution/Simple/Build.hs | 2 +- Cabal/Distribution/Simple/ShowBuildInfo.hs | 117 ++++++++++-------- Cabal/Distribution/{Simple => }/Utils/Json.hs | 10 +- .../Distribution/Client/CmdShowBuildInfo.hs | 117 ++++++------------ .../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 + .../B/build-info-lib-exact.test.hs | 4 +- .../ShowBuildInfo/Complex/exe.test.hs | 4 +- .../ShowBuildInfo/Complex/lib.test.hs | 4 +- .../src/Test/Cabal/DecodeShowBuildInfo.hs | 4 +- 17 files changed, 169 insertions(+), 211 deletions(-) rename Cabal/Distribution/{Simple => }/Utils/Json.hs (89%) 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 72c09023ef0..9e4b21ce20c 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -530,6 +530,7 @@ library Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress + Distribution.Utils.Json Distribution.Verbosity Distribution.Verbosity.Internal Distribution.Version @@ -609,7 +610,6 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo - Distribution.Simple.Utils.Json Distribution.ZinzaPrelude Paths_Cabal @@ -689,7 +689,7 @@ test-suite unit-tests Distribution.Described Distribution.Utils.CharSet Distribution.Utils.GrammarRegex - + main-is: UnitTests.hs build-depends: array, diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index c7e5ebfdb92..671ab8564cd 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/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 @@ -76,7 +77,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/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index b0bb0e16093..b831d8c9172 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/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 @@ -83,63 +84,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 $ 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/Distribution/Simple/Utils/Json.hs b/Cabal/Distribution/Utils/Json.hs similarity index 89% rename from Cabal/Distribution/Simple/Utils/Json.hs rename to Cabal/Distribution/Utils/Json.hs index f90f2f38aa2..ba918b74880 100644 --- a/Cabal/Distribution/Simple/Utils/Json.hs +++ b/Cabal/Distribution/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/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 170f3bcf841..47175da7b1f 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -23,7 +23,7 @@ import Distribution.Simple.Command import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die', withTempDirectory ) + ( wrapText, die' ) import Distribution.Types.UnitId ( UnitId, mkUnitId ) import Distribution.Types.Version @@ -36,13 +36,11 @@ import Distribution.Pretty 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 @@ -52,12 +50,16 @@ import Distribution.Client.Types import Distribution.Client.JobControl ( newLock, Lock ) import Distribution.Simple.Configure - ( tryGetPersistBuildConfig ) + (getPersistBuildConfig, tryGetPersistBuildConfig ) -import System.Directory - ( getTemporaryDirectory ) -import System.FilePath - ( () ) +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)) showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -137,51 +139,26 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here --- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks 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 + 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 - 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 + let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) - 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 "]" + json = mkBuildInfo' compilerInfo components + res = renderJson json "" - unitIdToFilePath :: UnitId -> FilePath - unitIdToFilePath unitId = "build-info-" ++ prettyShow unitId ++ ".json" + case fileOutput of + Nothing -> putStrLn res + Just fp -> writeFile fp res -showInfo :: FilePath -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () -showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = +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 @@ -191,7 +168,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 _ -> "" @@ -216,29 +192,25 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = ++ "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 @@ -247,9 +219,9 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, -- or otherwise classifies the problem. -- --- For the @show-build-info@ command select all components except non-buildable and disabled --- tests\/benchmarks, fail if there are no such components --- +-- For the @show-build-info@ command select all components. Unlike the @build@ +-- command, we want to show info for tests and benchmarks even without the +-- @--enable-tests@\/@--enable-benchmarks@ flag set. selectPackageTargets :: TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k] selectPackageTargets targetSelector targets @@ -267,16 +239,7 @@ selectPackageTargets targetSelector targets = 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 + targetsBuildable = selectBuildableTargets targets -- | For a 'TargetComponent' 'TargetSelector', check if the component can be -- selected. 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/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/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 From 554f679afc838a7501e3f67c9f7c47fc69f1bf38 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 4 Jun 2020 13:05:42 +0100 Subject: [PATCH 16/24] Fix haddock parsing in TargetProblem --- cabal-install/Distribution/Client/TargetProblem.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/TargetProblem.hs b/cabal-install/Distribution/Client/TargetProblem.hs index 14004d50abd..eb059b1ecb0 100644 --- a/cabal-install/Distribution/Client/TargetProblem.hs +++ b/cabal-install/Distribution/Client/TargetProblem.hs @@ -45,8 +45,8 @@ data TargetProblem a | TargetProblemNoSuchPackage PackageId | TargetProblemNoSuchComponent PackageId ComponentName - -- | A custom target problem | CustomTargetProblem a + -- ^ A custom target problem deriving (Eq, Show, Functor) -- | Type alias for a 'TargetProblem' with no user-defined problems/errors. From 08a5e93d331ccc4fd2f56a26ac5a21b96cc7f86e Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 4 Jun 2020 14:01:06 +0100 Subject: [PATCH 17/24] Build dependencies in show-build-info --- .../Distribution/Client/CmdShowBuildInfo.hs | 16 ++++++++++++++-- .../PackageTests/ShowBuildInfo/B/B.cabal | 2 +- .../PackageTests/ShowBuildInfo/B/cabal.project | 1 + 3 files changed, 16 insertions(+), 3 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 47175da7b1f..6d00c649ce8 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -128,8 +128,20 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO 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 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/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 From 4c1978fbba08c7fdd96993b917f8639a4bb76f1e Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 4 Jun 2020 14:11:53 +0100 Subject: [PATCH 18/24] Update .prod/.zinz templates --- cabal-install/cabal-install.cabal.prod | 1 + cabal-install/cabal-install.cabal.zinza | 1 + 2 files changed, 2 insertions(+) diff --git a/cabal-install/cabal-install.cabal.prod b/cabal-install/cabal-install.cabal.prod index 5612816e4f8..1d03ae9b57c 100644 --- a/cabal-install/cabal-install.cabal.prod +++ b/cabal-install/cabal-install.cabal.prod @@ -174,6 +174,7 @@ executable cabal Distribution.Client.CmdListBin Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdSdist Distribution.Client.CmdTest Distribution.Client.CmdUpdate diff --git a/cabal-install/cabal-install.cabal.zinza b/cabal-install/cabal-install.cabal.zinza index a436fe6f6cd..2de02969552 100644 --- a/cabal-install/cabal-install.cabal.zinza +++ b/cabal-install/cabal-install.cabal.zinza @@ -110,6 +110,7 @@ Version: 3.3.0.0 Distribution.Client.CmdListBin Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdSdist Distribution.Client.CmdTest Distribution.Client.CmdUpdate From 6180494c2c48affda679678d035bd60ba5512288 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 4 Jun 2020 14:51:29 +0100 Subject: [PATCH 19/24] Silence Haddock output --- cabal-install/Distribution/Client/CmdShowBuildInfo.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 6d00c649ce8..a10fcf5ad1f 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -17,7 +17,7 @@ import Distribution.Client.TargetProblem import Distribution.Client.Setup ( GlobalFlags ) import Distribution.Simple.Setup - (configVerbosity, fromFlagOrDefault ) + (Flag(..), haddockVerbosity, configVerbosity, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity @@ -148,7 +148,9 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO where -- Default to silent verbosity otherwise it will pollute our json output verbosity = fromFlagOrDefault silent (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig globalFlags flags + -- 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 () From 6daaa52341fd57cb035bdbada6dc4dd262c06031 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Fri, 5 Jun 2020 18:59:16 +0100 Subject: [PATCH 20/24] Add AmbiguityResolver to decide how to resolve ambiguty Every other command defaults to what they used to do. show-build-info now just chooses the first choice, since it doesn't care about ambiguity. --- cabal-install/Distribution/Client/CmdBench.hs | 7 +-- cabal-install/Distribution/Client/CmdBuild.hs | 3 +- .../Distribution/Client/CmdErrorMessages.hs | 4 +- .../Distribution/Client/CmdHaddock.hs | 3 +- .../Distribution/Client/CmdInstall.hs | 4 +- cabal-install/Distribution/Client/CmdRepl.hs | 4 +- cabal-install/Distribution/Client/CmdRun.hs | 4 +- cabal-install/Distribution/Client/CmdSdist.hs | 4 +- .../Distribution/Client/CmdShowBuildInfo.hs | 2 +- cabal-install/Distribution/Client/CmdTest.hs | 6 ++- .../Distribution/Client/TargetSelector.hs | 48 +++++++++++++------ 11 files changed, 56 insertions(+), 33 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index 629df6fb172..5b6d10ddf6e 100644 --- a/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal-install/Distribution/Client/CmdBench.hs @@ -22,7 +22,7 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, renderTargetProblem, renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs, - targetSelectorFilter ) + targetSelectorFilter, AmbiguityResolver(..) ) import Distribution.Client.TargetProblem ( TargetProblem (..) ) import Distribution.Client.NixStyleOptions @@ -87,7 +87,8 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) (Just BenchKind) targetStrings + =<< readTargetSelectors (localPackages baseCtx) + (AmbiguityResolverKind BenchKind) targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do @@ -120,7 +121,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/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 2fe43f596d1..76ba3bb0faa 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -106,7 +106,8 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings + =<< readTargetSelectors (localPackages baseCtx) + AmbiguityResolverNone targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs index 32abb2395cb..033a8eb9588 100644 --- a/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/Distribution/Client/CmdErrorMessages.hs @@ -21,7 +21,7 @@ import Distribution.Client.TargetSelector import Distribution.Client.TargetProblem ( TargetProblem(..), TargetProblem' ) import Distribution.Client.TargetSelector - ( ComponentKind(..), ComponentKindFilter, TargetSelector(..), + ( ComponentKind(..), AmbiguityResolver(..), TargetSelector(..), componentKind, showTargetSelector ) import Distribution.Package @@ -170,7 +170,7 @@ targetSelectorRefersToPkgs (TargetPackageNamed _ mkfilter) = isNothing mkfilter targetSelectorRefersToPkgs TargetComponent{} = False targetSelectorRefersToPkgs TargetComponentUnknown{} = False -targetSelectorFilter :: TargetSelector -> Maybe ComponentKindFilter +targetSelectorFilter :: TargetSelector -> Maybe ComponentKind targetSelectorFilter (TargetPackage _ _ mkfilter) = mkfilter targetSelectorFilter (TargetPackageNamed _ mkfilter) = mkfilter targetSelectorFilter (TargetAllPackages mkfilter) = mkfilter diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index 50d8d745208..caa896aa041 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/Distribution/Client/CmdHaddock.hs @@ -76,7 +76,8 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings + =<< readTargetSelectors (localPackages baseCtx) + AmbiguityResolverNone targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 5e431d8f7aa..b0d92bb1ecd 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -241,7 +241,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages localBaseCtx) - Nothing targetStrings'' + AmbiguityResolverNone targetStrings'' (specs, selectors) <- getSpecsAndTargetSelectors @@ -430,7 +430,7 @@ getSpecsAndTargetSelectors -> [TargetSelector] -> DistDirLayout -> ProjectBaseContext - -> Maybe ComponentKindFilter + -> Maybe ComponentKind -> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector]) getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors localDistDirLayout localBaseCtx targetFilter = withInstallPlan reducedVerbosity localBaseCtx $ \elaboratedPlan _ -> do diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index ed9c90be8fd..36c502f7852 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -26,7 +26,7 @@ import qualified Distribution.Types.Lens as L import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.CmdErrorMessages - ( renderTargetSelector, showTargetSelector, + ( renderTargetSelector, showTargetSelector, AmbiguityResolver(..), renderTargetProblem, targetSelectorRefersToPkgs, renderComponentKind, renderListCommaAnd, renderListSemiAnd, @@ -344,7 +344,7 @@ withProject cliConfig verbosity targetStrings = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings + =<< readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind LibKind) targetStrings return (baseCtx, targetSelectors, return (), ProjectRepl) diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 3d98380f04c..7e7732b8c26 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -59,7 +59,7 @@ import Distribution.Client.ProjectPlanning import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan ) import Distribution.Client.TargetSelector - ( TargetSelectorProblem(..), TargetString(..) ) + ( TargetSelectorProblem(..), TargetString(..), AmbiguityResolver(..) ) import Distribution.Client.InstallPlan ( toList, foldPlanPackage ) import Distribution.Types.UnqualComponentName @@ -182,7 +182,7 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do else reportTargetSelectorProblems verbosity err (baseCtx', targetSelectors) <- - readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings) + readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind ExeKind) (take 1 targetStrings) >>= \case Left err@(TargetSelectorNoTargetsInProject:_) | (script:_) <- targetStrings -> scriptOrError script err diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index adbe04afd07..3cedb211cde 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -18,7 +18,7 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), defaultNixStyleFlags ) import Distribution.Client.TargetSelector - ( TargetSelector(..), ComponentKind + ( TargetSelector(..), ComponentKind, AmbiguityResolver(..) , readTargetSelectors, reportTargetSelectorProblems ) import Distribution.Client.Setup ( GlobalFlags(..) ) @@ -142,7 +142,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do let localPkgs = localPackages baseCtx targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors localPkgs Nothing targetStrings + =<< readTargetSelectors localPkgs AmbiguityResolverNone targetStrings -- elaborate path, create target directory mOutputPath' <- case mOutputPath of diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index a10fcf5ad1f..76c83ead864 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -114,7 +114,7 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO } targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings + =<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs index cc1f49ed398..e9f53f1e084 100644 --- a/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal-install/Distribution/Client/CmdTest.hs @@ -22,7 +22,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, targetSelectorFilter, plural, renderTargetProblem, - renderTargetProblemNoTargets, targetSelectorPluralPkgs ) + renderTargetProblemNoTargets, targetSelectorPluralPkgs, + AmbiguityResolver(..) ) import Distribution.Client.TargetProblem ( TargetProblem (..) ) import Distribution.Client.NixStyleOptions @@ -99,7 +100,8 @@ testAction flags@NixStyleFlags {..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) (Just TestKind) targetStrings + =<< readTargetSelectors (localPackages baseCtx) + (AmbiguityResolverKind TestKind) targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index df01de1f25f..945b2d54863 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -19,7 +19,7 @@ module Distribution.Client.TargetSelector ( TargetSelector(..), TargetImplicitCwd(..), ComponentKind(..), - ComponentKindFilter, + AmbiguityResolver(..), SubComponentTarget(..), QualLevel(..), componentKind, @@ -130,18 +130,18 @@ data TargetSelector = -- These are always packages that are local to the project. In the case -- that there is more than one, they all share the same directory location. -- - TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter) + TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKind) -- | A package specified by name. This may refer to @extra-packages@ from -- the @cabal.project@ file, or a dependency of a known project package or -- could refer to a package from a hackage archive. It needs further -- context to resolve to a specific package. -- - | TargetPackageNamed PackageName (Maybe ComponentKindFilter) + | TargetPackageNamed PackageName (Maybe ComponentKind) -- | All packages, or all components of a particular kind in all packages. -- - | TargetAllPackages (Maybe ComponentKindFilter) + | TargetAllPackages (Maybe ComponentKind) -- | A specific component in a package within the project. -- @@ -167,7 +167,16 @@ data TargetImplicitCwd = TargetImplicitCwd | TargetExplicitNamed data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind deriving (Eq, Ord, Enum, Show) -type ComponentKindFilter = ComponentKind +-- | Whenever there is an ambiguous TargetSelector from some user input, how +-- should it be resolved? +data AmbiguityResolver = + -- | Treat ambiguity as an error + AmbiguityResolverNone + -- | Choose the first target + | AmbiguityResolverFirst + -- | Choose the target component with the specific kind + | AmbiguityResolverKind ComponentKind + deriving (Eq, Ord, Show) -- | Either the component as a whole or detail about a file or module target -- within a component. @@ -199,19 +208,25 @@ instance Structured SubComponentTarget -- the available packages (and their locations). -- readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))] - -> Maybe ComponentKindFilter + -> AmbiguityResolver -- ^ This parameter is used when there are ambiguous selectors. - -- If it is 'Just', then we attempt to resolve ambiguitiy - -- by applying it, since otherwise there is no way to allow - -- contextually valid yet syntactically ambiguous selectors. + -- If it is 'AmbiguityResolverKind', then we attempt to resolve + -- ambiguitiy by applying it, since otherwise there is no + -- way to allow contextually valid yet syntactically ambiguous + -- selectors. -- (#4676, #5461) + -- If it is 'AmbiguityResolverFirst', then we resolve it by + -- choosing just the first target. This is used by + -- the show-build-info command. + -- Otherwise, if it is 'AmbiguityResolverNone', we make + -- ambiguity a 'TargetSelectorProblem'. -> [String] -> IO (Either [TargetSelectorProblem] [TargetSelector]) readTargetSelectors = readTargetSelectorsWith defaultDirActions readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m -> [PackageSpecifier (SourcePackage (PackageLocation a))] - -> Maybe ComponentKindFilter + -> AmbiguityResolver -> [String] -> m (Either [TargetSelectorProblem] [TargetSelector]) readTargetSelectorsWith dirActions@DirActions{} pkgs mfilter targetStrs = @@ -457,7 +472,7 @@ copyFileStatus src dst = -- resolveTargetSelectors :: KnownTargets -> [TargetStringFileStatus] - -> Maybe ComponentKindFilter + -> AmbiguityResolver -> ([TargetSelectorProblem], [TargetSelector]) -- default local dir target if there's no given target: @@ -478,7 +493,7 @@ resolveTargetSelectors knowntargets targetStrs mfilter = $ targetStrs resolveTargetSelector :: KnownTargets - -> Maybe ComponentKindFilter + -> AmbiguityResolver -> TargetStringFileStatus -> Either TargetSelectorProblem TargetSelector resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = @@ -497,14 +512,17 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = | otherwise -> Left (classifyMatchErrors errs) Ambiguous _ targets - | Just kfilter <- mfilter + | AmbiguityResolverKind kfilter <- mfilter , [target] <- applyKindFilter kfilter targets -> Right target Ambiguous exactMatch targets -> case disambiguateTargetSelectors matcher targetStrStatus exactMatch targets of - Right targets' -> Left (TargetSelectorAmbiguous targetStr targets') + Right targets' -> + case (targets', mfilter) of + ((_,t):_, AmbiguityResolverFirst) -> Right t + _ -> Left (TargetSelectorAmbiguous targetStr targets') Left ((m, ms):_) -> Left (MatchingInternalError targetStr m ms) Left [] -> internalError "resolveTargetSelector" where @@ -559,7 +577,7 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = = innerErr (Just (kind,thing)) m innerErr c m = (c,m) - applyKindFilter :: ComponentKindFilter -> [TargetSelector] -> [TargetSelector] + applyKindFilter :: ComponentKind -> [TargetSelector] -> [TargetSelector] applyKindFilter kfilter = filter go where go (TargetPackage _ _ (Just filter')) = kfilter == filter' From d52bdde91ee95839b224f630312c8ebb3bf1328f Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 8 Jun 2020 16:51:06 +0100 Subject: [PATCH 21/24] Add --pick-first-target flag --- cabal-install/Distribution/Client/CmdBench.hs | 4 +- cabal-install/Distribution/Client/CmdBuild.hs | 2 +- .../Distribution/Client/CmdErrorMessages.hs | 2 +- .../Distribution/Client/CmdHaddock.hs | 4 +- .../Distribution/Client/CmdInstall.hs | 4 +- .../Distribution/Client/CmdListBin.hs | 2 +- cabal-install/Distribution/Client/CmdRepl.hs | 11 +-- cabal-install/Distribution/Client/CmdRun.hs | 4 +- cabal-install/Distribution/Client/CmdSdist.hs | 6 +- .../Distribution/Client/CmdShowBuildInfo.hs | 4 +- cabal-install/Distribution/Client/CmdTest.hs | 7 +- cabal-install/Distribution/Client/Config.hs | 4 +- .../Client/ProjectConfig/Legacy.hs | 6 +- cabal-install/Distribution/Client/Setup.hs | 14 +++- .../Distribution/Client/TargetSelector.hs | 79 ++++++++++++++----- cabal-install/tests/IntegrationTests2.hs | 58 ++++++++++---- 16 files changed, 147 insertions(+), 64 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index 5b6d10ddf6e..a66ed7b86ab 100644 --- a/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal-install/Distribution/Client/CmdBench.hs @@ -22,7 +22,7 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, renderTargetProblem, renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs, - targetSelectorFilter, AmbiguityResolver(..) ) + targetSelectorFilter ) import Distribution.Client.TargetProblem ( TargetProblem (..) ) import Distribution.Client.NixStyleOptions @@ -88,7 +88,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) - (AmbiguityResolverKind BenchKind) targetStrings + (Just BenchKind) flags targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 76ba3bb0faa..ea086a80151 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -107,7 +107,7 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) - AmbiguityResolverNone targetStrings + Nothing flags targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs index 033a8eb9588..bbd2058a719 100644 --- a/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/Distribution/Client/CmdErrorMessages.hs @@ -21,7 +21,7 @@ import Distribution.Client.TargetSelector import Distribution.Client.TargetProblem ( TargetProblem(..), TargetProblem' ) import Distribution.Client.TargetSelector - ( ComponentKind(..), AmbiguityResolver(..), TargetSelector(..), + ( ComponentKind(..), TargetSelector(..), componentKind, showTargetSelector ) import Distribution.Package diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index caa896aa041..04a83dd0e88 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/Distribution/Client/CmdHaddock.hs @@ -76,8 +76,8 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) - AmbiguityResolverNone targetStrings + =<< readTargetSelectors (localPackages baseCtx) Nothing flags + targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index b0d92bb1ecd..37756908ab4 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -240,8 +240,8 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe else do targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages localBaseCtx) - AmbiguityResolverNone targetStrings'' + =<< readTargetSelectors (localPackages localBaseCtx) Nothing flags + targetStrings'' (specs, selectors) <- getSpecsAndTargetSelectors diff --git a/cabal-install/Distribution/Client/CmdListBin.hs b/cabal-install/Distribution/Client/CmdListBin.hs index fbdef44e70b..d4f611ccfb9 100644 --- a/cabal-install/Distribution/Client/CmdListBin.hs +++ b/cabal-install/Distribution/Client/CmdListBin.hs @@ -77,7 +77,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do -- elaborate target selectors targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors localPkgs Nothing [target] + =<< readTargetSelectors localPkgs Nothing flags [target] buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 36c502f7852..ec0ea8b9dcf 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -26,7 +26,7 @@ import qualified Distribution.Types.Lens as L import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.CmdErrorMessages - ( renderTargetSelector, showTargetSelector, AmbiguityResolver(..), + ( renderTargetSelector, showTargetSelector, renderTargetProblem, targetSelectorRefersToPkgs, renderComponentKind, renderListCommaAnd, renderListSemiAnd, @@ -204,7 +204,7 @@ replCommand = Client.installCommand { replAction :: NixStyleFlags (ReplFlags, EnvFlags) -> [String] -> GlobalFlags -> IO () replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetStrings globalFlags = do let - with = withProject cliConfig verbosity targetStrings + with = withProject flags cliConfig verbosity targetStrings without config = withoutProject (config <> cliConfig) verbosity targetStrings (baseCtx, targetSelectors, finalizer, replType) <- @@ -338,13 +338,14 @@ data ReplType = ProjectRepl -- 7.6, though. 🙁 deriving (Show, Eq) -withProject :: ProjectConfig -> Verbosity -> [String] +withProject :: NixStyleFlags a -> ProjectConfig -> Verbosity -> [String] -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) -withProject cliConfig verbosity targetStrings = do +withProject flags cliConfig verbosity targetStrings = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind LibKind) targetStrings + =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) + flags targetStrings return (baseCtx, targetSelectors, return (), ProjectRepl) diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 7e7732b8c26..66d361b0cdc 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -59,7 +59,7 @@ import Distribution.Client.ProjectPlanning import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan ) import Distribution.Client.TargetSelector - ( TargetSelectorProblem(..), TargetString(..), AmbiguityResolver(..) ) + ( TargetSelectorProblem(..), TargetString(..) ) import Distribution.Client.InstallPlan ( toList, foldPlanPackage ) import Distribution.Types.UnqualComponentName @@ -182,7 +182,7 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do else reportTargetSelectorProblems verbosity err (baseCtx', targetSelectors) <- - readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind ExeKind) (take 1 targetStrings) + readTargetSelectors (localPackages baseCtx) (Just ExeKind) flags (take 1 targetStrings) >>= \case Left err@(TargetSelectorNoTargetsInProject:_) | (script:_) <- targetStrings -> scriptOrError script err diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index 3cedb211cde..4efd7a03793 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/cabal-install/Distribution/Client/CmdSdist.hs @@ -18,8 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), defaultNixStyleFlags ) import Distribution.Client.TargetSelector - ( TargetSelector(..), ComponentKind, AmbiguityResolver(..) - , readTargetSelectors, reportTargetSelectorProblems ) + ( TargetSelector(..), ComponentKind + , readTargetSelectors', reportTargetSelectorProblems ) import Distribution.Client.Setup ( GlobalFlags(..) ) import Distribution.Solver.Types.SourcePackage @@ -142,7 +142,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do let localPkgs = localPackages baseCtx targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors localPkgs AmbiguityResolverNone targetStrings + =<< readTargetSelectors' localPkgs Nothing targetStrings -- elaborate path, create target directory mOutputPath' <- case mOutputPath of diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 76c83ead864..9a5a1505dfe 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -114,7 +114,7 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO } targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings + =<< readTargetSelectors (localPackages baseCtx') Nothing flags targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do @@ -155,6 +155,8 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do + + -- TODO: can we use --disable-per-component so that we only get one package? let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs index e9f53f1e084..6ebf2215aee 100644 --- a/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal-install/Distribution/Client/CmdTest.hs @@ -22,8 +22,7 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, targetSelectorFilter, plural, renderTargetProblem, - renderTargetProblemNoTargets, targetSelectorPluralPkgs, - AmbiguityResolver(..) ) + renderTargetProblemNoTargets, targetSelectorPluralPkgs ) import Distribution.Client.TargetProblem ( TargetProblem (..) ) import Distribution.Client.NixStyleOptions @@ -100,8 +99,8 @@ testAction flags@NixStyleFlags {..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) - (AmbiguityResolverKind TestKind) targetStrings + =<< readTargetSelectors (localPackages baseCtx) + (Just TestKind) flags targetStrings buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 139eed29425..b1b6d054cd9 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -428,7 +428,9 @@ instance Semigroup SavedConfig where configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder, configWriteGhcEnvironmentFilesPolicy - = combine configWriteGhcEnvironmentFilesPolicy + = combine configWriteGhcEnvironmentFilesPolicy, + configPickFirstTarget + = combine configPickFirstTarget } where combine = combine' savedConfigureExFlags diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 39a0342aa08..df1d2319c72 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -83,7 +83,7 @@ import qualified Distribution.Deprecated.ParseUtils as ParseUtils import Distribution.Deprecated.ParseUtils ( ParseResult(..), PError(..), syntaxError, PWarning(..) , commaNewLineListFieldParsec, newLineListField, parseTokenQ - , parseHaskellString, showToken + , parseHaskellString, showToken , simpleFieldParsec ) import Distribution.Client.ParseUtils @@ -603,7 +603,9 @@ convertToLegacySharedConfig configAllowOlder = projectConfigAllowOlder, configAllowNewer = projectConfigAllowNewer, configWriteGhcEnvironmentFilesPolicy - = projectConfigWriteGhcEnvironmentFilesPolicy + = projectConfigWriteGhcEnvironmentFilesPolicy, + configPickFirstTarget + = mempty } installFlags = InstallFlags { diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 0e7ed98dc9e..6f33029cb03 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -611,12 +611,15 @@ data ConfigExFlags = ConfigExFlags { configAllowNewer :: Maybe AllowNewer, configAllowOlder :: Maybe AllowOlder, configWriteGhcEnvironmentFilesPolicy - :: Flag WriteGhcEnvironmentFilesPolicy + :: Flag WriteGhcEnvironmentFilesPolicy, + configPickFirstTarget + :: Flag Bool } deriving (Eq, Show, Generic) defaultConfigExFlags :: ConfigExFlags -defaultConfigExFlags = mempty { configSolver = Flag defaultSolver } +defaultConfigExFlags = mempty { configSolver = Flag defaultSolver + , configPickFirstTarget = Flag False } configureExCommand :: CommandUI (ConfigFlags, ConfigExFlags) configureExCommand = configureCommand { @@ -684,6 +687,13 @@ configureExOptions _showOrParseArgs src = (reqArg "always|never|ghc8.4.4+" writeGhcEnvironmentFilesPolicyParser writeGhcEnvironmentFilesPolicyPrinter) + + , option [] ["pick-first-target"] + ("If there's an amibguity in the target selector, then resolve it by" + ++ " choosing the first") + configPickFirstTarget + (\v flags -> flags { configPickFirstTarget = v}) + trueArg ] diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index 945b2d54863..ceb906e29d8 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -19,13 +19,13 @@ module Distribution.Client.TargetSelector ( TargetSelector(..), TargetImplicitCwd(..), ComponentKind(..), - AmbiguityResolver(..), SubComponentTarget(..), QualLevel(..), componentKind, -- * Reading target selectors readTargetSelectors, + readTargetSelectors', TargetSelectorProblem(..), reportTargetSelectorProblems, showTargetSelector, @@ -66,6 +66,12 @@ import Distribution.Simple.LocalBuildInfo , pkgComponents, componentName, componentBuildInfo ) import Distribution.Types.ForeignLib +import Distribution.Client.NixStyleOptions +import Distribution.Client.Setup + ( ConfigExFlags(..) ) +import Distribution.Simple.Setup + ( fromFlagOrDefault ) + import Distribution.Simple.Utils ( die', lowercase, ordNub ) import Distribution.Client.Utils @@ -176,6 +182,7 @@ data AmbiguityResolver = | AmbiguityResolverFirst -- | Choose the target component with the specific kind | AmbiguityResolverKind ComponentKind + | AmbiguityResolverKindFirst ComponentKind deriving (Eq, Ord, Show) -- | Either the component as a whole or detail about a file or module target @@ -208,36 +215,54 @@ instance Structured SubComponentTarget -- the available packages (and their locations). -- readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))] - -> AmbiguityResolver + -> Maybe ComponentKind -- ^ This parameter is used when there are ambiguous selectors. - -- If it is 'AmbiguityResolverKind', then we attempt to resolve - -- ambiguitiy by applying it, since otherwise there is no - -- way to allow contextually valid yet syntactically ambiguous + -- If it is 'Just', then we attempt to resolve ambiguitiy + -- by applying it, since otherwise there is no way to + -- allow contextually valid yet syntactically ambiguous -- selectors. -- (#4676, #5461) - -- If it is 'AmbiguityResolverFirst', then we resolve it by - -- choosing just the first target. This is used by - -- the show-build-info command. - -- Otherwise, if it is 'AmbiguityResolverNone', we make - -- ambiguity a 'TargetSelectorProblem'. + -> NixStyleFlags b + -- ^ Used in case @--pick-first-target@ was passed. -> [String] -> IO (Either [TargetSelectorProblem] [TargetSelector]) -readTargetSelectors = readTargetSelectorsWith defaultDirActions +readTargetSelectors pkgs mfilter NixStyleFlags{configExFlags} + = readTargetSelectorsWith defaultDirActions pkgs mfilter + (fromFlagOrDefault False (configPickFirstTarget configExFlags)) + + +-- | Same as 'readTargetSelectors' but in case you don't have 'NixStyleFlags'. +readTargetSelectors' :: [PackageSpecifier (SourcePackage (PackageLocation a))] + -> Maybe ComponentKind + -> [String] + -> IO (Either [TargetSelectorProblem] [TargetSelector]) +readTargetSelectors' pkgs mfilter = + readTargetSelectorsWith defaultDirActions pkgs mfilter False readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m -> [PackageSpecifier (SourcePackage (PackageLocation a))] - -> AmbiguityResolver + -> Maybe ComponentKind + -- ^ Filter the target to resolve ambiguity? + -> Bool + -- ^ Pick the first target to resolve ambiguity? -> [String] -> m (Either [TargetSelectorProblem] [TargetSelector]) -readTargetSelectorsWith dirActions@DirActions{} pkgs mfilter targetStrs = +readTargetSelectorsWith dirActions@DirActions{} pkgs mfilter pickFirst targetStrs = case parseTargetStrings targetStrs of ([], usertargets) -> do usertargets' <- traverse (getTargetStringFileStatus dirActions) usertargets knowntargets <- getKnownTargets dirActions pkgs - case resolveTargetSelectors knowntargets usertargets' mfilter of + case resolveTargetSelectors knowntargets usertargets' resolver of ([], btargets) -> return (Right btargets) (problems, _) -> return (Left problems) (strs, _) -> return (Left (map TargetSelectorUnrecognised strs)) + where + resolver + | Just kind <- mfilter + , pickFirst = AmbiguityResolverKindFirst kind + | Just kind <- mfilter = AmbiguityResolverKind kind + | pickFirst = AmbiguityResolverFirst + | otherwise = AmbiguityResolverNone data DirActions m = DirActions { @@ -496,7 +521,7 @@ resolveTargetSelector :: KnownTargets -> AmbiguityResolver -> TargetStringFileStatus -> Either TargetSelectorProblem TargetSelector -resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = +resolveTargetSelector knowntargets@KnownTargets{..} resolver targetStrStatus = case findMatch (matcher targetStrStatus) of Unambiguous _ @@ -511,18 +536,32 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus = | projectIsEmpty -> Left TargetSelectorNoTargetsInProject | otherwise -> Left (classifyMatchErrors errs) + -- Try to resolve the ambiguity with a kind filter Ambiguous _ targets - | AmbiguityResolverKind kfilter <- mfilter + | AmbiguityResolverKind kfilter <- resolver , [target] <- applyKindFilter kfilter targets -> Right target + -- If we have a filter and want to pick from the first + Ambiguous _ targets + | AmbiguityResolverKindFirst kfilter <- resolver + , target:_ <- applyKindFilter kfilter targets -> Right target + + -- Same case as above, except there weren't any filter matches + Ambiguous _ targets + | AmbiguityResolverKindFirst _ <- resolver + , target:_ <- targets -> Right target + + -- Just pick the first of any + Ambiguous _ targets + | AmbiguityResolverFirst <- resolver + , target:_ <- targets -> Right target + + -- A truly, unresolvable ambiguity Ambiguous exactMatch targets -> case disambiguateTargetSelectors matcher targetStrStatus exactMatch targets of - Right targets' -> - case (targets', mfilter) of - ((_,t):_, AmbiguityResolverFirst) -> Right t - _ -> Left (TargetSelectorAmbiguous targetStr targets') + Right targets' -> Left (TargetSelectorAmbiguous targetStr targets') Left ((m, ms):_) -> Left (MatchingInternalError targetStr m ms) Left [] -> internalError "resolveTargetSelector" where diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 6a6d8706c35..6ec4d7712fb 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -157,21 +157,22 @@ testExceptionFindProjectRoot = do testTargetSelectors :: (String -> IO ()) -> Assertion testTargetSelectors reportSubCase = do (_, _, _, localPackages, _) <- configureProject testdir config - let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) + let readTargetSelectors'' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing + False reportSubCase "cwd" - do Right ts <- readTargetSelectors' [] + do Right ts <- readTargetSelectors'' [] ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing] reportSubCase "all" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' ["all", ":all"] ts @?= replicate 2 (TargetAllPackages Nothing) reportSubCase "filter" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "libs", ":cwd:libs" , "flibs", ":cwd:flibs" , "exes", ":cwd:exes" @@ -183,7 +184,7 @@ testTargetSelectors reportSubCase = do ] reportSubCase "all:filter" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "all:libs", ":all:libs" , "all:flibs", ":all:flibs" , "all:exes", ":all:exes" @@ -195,14 +196,14 @@ testTargetSelectors reportSubCase = do ] reportSubCase "pkg" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ ":pkg:p", ".", "./", "p.cabal" , "q", ":pkg:q", "q/", "./q/", "q/q.cabal"] ts @?= replicate 4 (mkTargetPackage "p-0.1") ++ replicate 5 (mkTargetPackage "q-0.1") reportSubCase "pkg:filter" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "p:libs", ".:libs", ":pkg:p:libs" , "p:flibs", ".:flibs", ":pkg:p:flibs" , "p:exes", ".:exes", ":pkg:p:exes" @@ -222,14 +223,14 @@ testTargetSelectors reportSubCase = do ] reportSubCase "component" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p" , "lib:q", "q:lib:q", ":pkg:q:lib:q" ] ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent) ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent) reportSubCase "module" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "P", "lib:p:P", "p:p:P", ":pkg:p:lib:p:module:P" , "QQ", "lib:q:QQ", "q:q:QQ", ":pkg:q:lib:q:module:QQ" , "pexe:PMain" -- p:P or q:QQ would be ambiguous here @@ -242,7 +243,7 @@ testTargetSelectors reportSubCase = do ] reportSubCase "file" - do Right ts <- readTargetSelectors' + do Right ts <- readTargetSelectors'' [ "./P.hs", "p:P.lhs", "lib:p:P.hsc", "p:p:P.hsc", ":pkg:p:lib:p:file:P.y" , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc", @@ -273,7 +274,7 @@ testTargetSelectorBadSyntax = do , "foo:", "foo::bar" , "foo: ", "foo: :bar" , "a:b:c:d:e:f", "a:b:c:d:e:f:g:h" ] - Left errs <- readTargetSelectors localPackages Nothing targets + Left errs <- readTargetSelectors' localPackages Nothing targets zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets) cleanProject testdir where @@ -378,6 +379,14 @@ testTargetSelectorAmbiguous reportSubCase = do [ mkpkg "foo" [ mkexe "bar" `withModules` ["Bar"] `withHsSrcDirs` ["src"] , mkexe "bar2" `withModules` ["Bar"] `withHsSrcDirs` ["src"] ] ] + reportSubCase "ambiguous: --pick-first-target resolves" + assertUnambiguousPickFirst "Bar.hs" + [ mkTargetFile "foo" (CExeName "bar") "Bar" + , mkTargetFile "foo" (CExeName "bar2") "Bar" + ] + [ mkpkg "foo" [ mkexe "bar" `withModules` ["Bar"] + , mkexe "bar2" `withModules` ["Bar"] ] + ] -- non-exact case packages and components are ambiguous reportSubCase "ambiguous: non-exact-case pkg names" @@ -413,6 +422,7 @@ testTargetSelectorAmbiguous reportSubCase = do fakeDirActions (map SpecificSourcePackage pkgs) Nothing + False [str] case res of Left [TargetSelectorAmbiguous _ tss'] -> @@ -429,12 +439,29 @@ testTargetSelectorAmbiguous reportSubCase = do fakeDirActions (map SpecificSourcePackage pkgs) Nothing + False [str] case res of Right [ts'] -> ts' @?= ts _ -> assertFailure $ "expected Right [Target...], " ++ "got " ++ show res + assertUnambiguousPickFirst :: String + -> [TargetSelector] + -> [SourcePackage (PackageLocation a)] + -> Assertion + assertUnambiguousPickFirst str ts pkgs = do + res <- readTargetSelectorsWith + fakeDirActions + (map SpecificSourcePackage pkgs) + Nothing + True + [str] + case res of + Right [ts'] -> (ts' `elem` ts) @? "unexpected target selector" + _ -> assertFailure $ "expected Right [Target...], " + ++ "got " ++ show res + fakeDirActions = TS.DirActions { TS.doesFileExist = \_p -> return True, TS.doesDirectoryExist = \_p -> return True, @@ -511,15 +538,16 @@ instance IsString PackageIdentifier where testTargetSelectorNoCurrentPackage :: Assertion testTargetSelectorNoCurrentPackage = do (_, _, _, localPackages, _) <- configureProject testdir config - let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir) + let readTargetSelectors'' = readTargetSelectorsWith (dirActions testdir) localPackages Nothing + False targets = [ "libs", ":cwd:libs" , "flibs", ":cwd:flibs" , "exes", ":cwd:exes" , "tests", ":cwd:tests" , "benchmarks", ":cwd:benchmarks"] - Left errs <- readTargetSelectors' targets + Left errs <- readTargetSelectors'' targets zipWithM_ (@?=) errs [ TargetSelectorNoCurrentPackage ts | target <- targets @@ -534,7 +562,7 @@ testTargetSelectorNoCurrentPackage = do testTargetSelectorNoTargets :: Assertion testTargetSelectorNoTargets = do (_, _, _, localPackages, _) <- configureProject testdir config - Left errs <- readTargetSelectors localPackages Nothing [] + Left errs <- readTargetSelectors' localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInCwd] cleanProject testdir where @@ -545,7 +573,7 @@ testTargetSelectorNoTargets = do testTargetSelectorProjectEmpty :: Assertion testTargetSelectorProjectEmpty = do (_, _, _, localPackages, _) <- configureProject testdir config - Left errs <- readTargetSelectors localPackages Nothing [] + Left errs <- readTargetSelectors' localPackages Nothing [] errs @?= [TargetSelectorNoTargetsInProject] cleanProject testdir where From 23b8870323403326171a2637f1a7c30670500387 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 8 Jun 2020 17:43:34 +0100 Subject: [PATCH 22/24] Don't output haddock stdout if verbosity is silent --- Cabal/Distribution/Simple/Haddock.hs | 4 ++- .../PackageTests/NewHaddock/Fails/cabal.out | 1 + cabal-testsuite/src/Test/Cabal/Monad.hs | 10 +++++- .../src/Test/Cabal/OutputNormalizer.hs | 32 +++++++++++++++++++ 4 files changed, 45 insertions(+), 2 deletions(-) diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index 119455c6385..07d898c6321 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -559,7 +559,9 @@ runHaddock verbosity tmpFileOpts comp platform haddockProg args renderArgs verbosity tmpFileOpts haddockVersion comp platform args $ \(flags,result)-> do - runProgram verbosity haddockProg flags + haddockOut <- getProgramOutput verbosity haddockProg flags + unless (verbosity <= silent) $ + putStr haddockOut notice verbosity $ "Documentation created: " ++ result diff --git a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out index cbfc470cbba..860963efde9 100644 --- a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out +++ b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out @@ -12,4 +12,5 @@ In order, the following will be built: - example-1.0 (lib) (first run) Preprocessing library for example-1.0.. Running Haddock on library for example-1.0.. +cabal: '' exited with an error: cabal: Failed to build documentation for example-1.0-inplace. diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index 19695aaa37b..77f4f6fa5dc 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -411,6 +411,10 @@ mkNormalizerEnv = do list_out <- liftIO $ readProcess (programPath ghc_pkg_program) ["list", "--global", "--simple-output"] "" tmpDir <- liftIO $ getTemporaryDirectory + haddock <- let prog = fromJust $ lookupKnownProgram "haddock" (testProgramDb env) + in fmap (fst . fromJust) $ liftIO $ + programFindLocation prog (testVerbosity env) + [ProgramSearchPathDefault] return NormalizerEnv { normalizerRoot = addTrailingPathSeparator (testSourceDir env), @@ -423,8 +427,12 @@ mkNormalizerEnv = do normalizerKnownPackages = mapMaybe simpleParse (words list_out), normalizerPlatform - = testPlatform env + = testPlatform env, + normalizerHaddock + = haddock } + where + 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 fd7457b3324..ce67115bd44 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -14,6 +14,7 @@ import Distribution.System import qualified Data.Foldable as F import Text.Regex +import Data.List normalizeOutput :: NormalizerEnv -> String -> String normalizeOutput nenv = @@ -54,11 +55,41 @@ normalizeOutput nenv = else id) -- hackage-security locks occur non-deterministically . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" "" + -- Substitute the haddock binary with + -- Do this before the substitution + . resub (posixRegexEscape (normalizerHaddock nenv)) "" + . removeErrors where packageIdRegex pid = resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?") (prettyShow (packageName pid) ++ "-") +{- Given +cabal: blah exited with an error: +Example.hs:6:11: error: + * Couldn't match expected type `Int' with actual type `Bool' + * In the expression: False + In an equation for `example': example = False +| +6 | example = False +| ^^^^^ +cabal: Failed to build documentation for example-1.0-inplace. + +this will remove the error in between the first line with "exited with an error" +and the closing "cabal:". Pretty nasty, but its needed to ignore errors from +external programs whose output might change. +-} +removeErrors :: String -> String +removeErrors s = unlines (go (lines s) False) + where + go [] _ = [] + go (x:xs) True + | "cabal:" `isPrefixOf` x = x:(go xs False) + | otherwise = go xs True + go (x:xs) False + | "exited with an error" `isInfixOf` x = x:(go xs True) + | otherwise = x:(go xs False) + data NormalizerEnv = NormalizerEnv { normalizerRoot :: FilePath , normalizerTmpDir :: FilePath @@ -66,6 +97,7 @@ data NormalizerEnv = NormalizerEnv , normalizerGhcVersion :: Version , normalizerKnownPackages :: [PackageId] , normalizerPlatform :: Platform + , normalizerHaddock :: FilePath } posixSpecialChars :: [Char] From 25aef9911f0ef766a874b20463eb5a1dfbd77d2a Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 8 Jun 2020 21:17:32 +0100 Subject: [PATCH 23/24] Generate autogen files These are needed by tooling to setup GHC sessions. --- .../Distribution/Client/CmdShowBuildInfo.hs | 23 +++++++++++++++---- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 9a5a1505dfe..52dd6e5d957 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -55,11 +55,18 @@ import Distribution.Simple.Configure 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 Distribution.Simple.BuildTarget + ( readTargetInfos ) +import Distribution.Types.LocalBuildInfo + ( neededTargetsInBuildOrder' ) +import Distribution.Compat.Graph + ( IsNode(nodeKey) ) +import Distribution.Simple.Setup + ( BuildFlags(..) ) +import Distribution.Types.TargetInfo + ( TargetInfo(..) ) +import Distribution.Simple.Build + ( componentInitialBuildSteps ) showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -225,6 +232,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 84aa56054c09395416e0c5b37a7c2bce8842f3a4 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 7 Jul 2020 19:49:31 +0100 Subject: [PATCH 24/24] 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. It also 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. 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/Distribution/Simple.hs | 33 ++-- Cabal/Distribution/Simple/Build.hs | 24 ++- Cabal/Distribution/Simple/Setup.hs | 17 +- Cabal/Distribution/Simple/ShowBuildInfo.hs | 50 +++-- Cabal/Distribution/Utils/Json.hs | 69 ++++--- .../Distribution/Client/CmdShowBuildInfo.hs | 182 +++++------------- .../Distribution/Client/ProjectBuilding.hs | 38 +++- .../Client/ProjectBuilding/Types.hs | 9 +- .../Distribution/Client/ProjectPlanning.hs | 22 +++ .../Client/ProjectPlanning/Types.hs | 1 + .../Distribution/Client/SetupWrapper.hs | 2 +- cabal-install/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 +- .../src/Test/Cabal/OutputNormalizer.hs | 4 +- 37 files changed, 328 insertions(+), 239 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/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 5543765a10d..156ce1180bf 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -108,6 +108,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. @@ -265,31 +267,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/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 671ab8564cd..c38e47d8fea 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -89,6 +89,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. @@ -133,15 +134,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/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 4f1e06e0b73..a03c0cf0f35 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -2217,15 +2217,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 @@ -2262,8 +2265,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/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index b831d8c9172..d6e9c73102f 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/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 () @@ -79,36 +83,37 @@ import Distribution.Pretty -- | 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 @@ -119,16 +124,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 @@ -147,6 +153,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. @@ -154,7 +163,7 @@ getCompilerArgs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo - -> [String] + -> [T.Text] getCompilerArgs bi lbi clbi = case compilerFlavor $ compiler lbi of GHC -> ghc @@ -163,6 +172,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/Distribution/Utils/Json.hs b/Cabal/Distribution/Utils/Json.hs index ba918b74880..15573c9c05a 100644 --- a/Cabal/Distribution/Utils/Json.hs +++ b/Cabal/Distribution/Utils/Json.hs @@ -1,50 +1,65 @@ --- | Extremely simple JSON helper. Don't do anything too fancy with this! +{-# 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 [(String, Json)] - | JsonString !String + | JsonObject [(Text, Json)] + | JsonRaw !Text + | JsonString !Text -renderJson :: Json -> ShowS +-- | A type to mirror 'ShowS' +type ShowT = Text -> Text + +renderJson :: Json -> ShowT 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 (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 "\"" "\"" $ 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 + 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 . showString' sep . go xs + go (x:xs) = x . showText' sep . go xs -(.=) :: String -> Json -> (String, Json) +(.=) :: Text -> Json -> (Text, Json) k .= v = (k, v) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 52dd6e5d957..489a3b7768b 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/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,7 +8,7 @@ module Distribution.Client.CmdShowBuildInfo ( ) where import Distribution.Client.Compat.Prelude - ( when, find, fromMaybe ) + (catMaybes, fromMaybe ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.TargetProblem @@ -21,52 +21,30 @@ import Distribution.Simple.Setup import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity - ( Verbosity, silent ) + (Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die' ) + (wrapText, die' ) import Distribution.Types.UnitId - ( UnitId, mkUnitId ) -import Distribution.Types.Version - ( mkVersion ) -import Distribution.Types.PackageDescription - ( buildType ) + ( mkUnitId ) import Distribution.Pretty ( prettyShow ) 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(..) ) -import Distribution.Types.TargetInfo - ( TargetInfo(..) ) -import Distribution.Simple.Build - ( componentInitialBuildSteps ) +import Control.Monad (forM_, unless) +import Data.Either +import qualified Data.Text as T +import qualified Data.Text.IO as T showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -113,7 +91,7 @@ defaultShowBuildInfoFlags = ShowBuildInfoFlags -- 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 unitIdStrs), ..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand let baseCtx' = baseCtx @@ -127,7 +105,8 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO 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 + + targets' <- either (reportShowBuildInfoTargetProblems verbosity) return $ resolveTargets selectPackageTargets selectComponentTarget @@ -135,114 +114,59 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO Nothing targetSelectors - let elaboratedPlan' = pruneInstallPlanToTargets - TargetActionBuild + let unitIds = map mkUnitId <$> unitIdStrs + + -- Check that all the unit ids exist + forM_ (fromMaybe [] unitIds) $ \ui -> + unless (Map.member ui targets') $ + die' verbosity ("No unit " ++ prettyShow ui) + + -- Filter out targets that aren't in the specified unit ids + let targets = Map.filterWithKey (\k _ -> maybe True (elem k) unitIds) targets' + elaboratedPlan' = pruneInstallPlanToTargets + 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 + -- 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 - -- TODO: can we use --disable-per-component so that we only get one package? - let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + let componentBuildInfos = + concatMap T.lines $ -- Component infos are returned each on a newline + catMaybes (buildResultBuildInfo <$> buildResults) - components <- concat <$> mapM (getComponentInfo verbosity baseCtx buildCtx - lock configured) targets + 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 - - return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild + Nothing -> T.putStrLn res + Just fp -> T.writeFile fp res - 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, diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 134e2249999..24b3299c134 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/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) @@ -456,9 +457,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 @@ -1052,9 +1054,10 @@ buildAndInstallUnpackedPackage verbosity noticeProgress ProgressCompleted return BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = mlogFile + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = mlogFile, + buildResultBuildInfo = Nothing } where @@ -1299,10 +1302,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 @@ -1340,6 +1356,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 @@ -1384,6 +1404,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/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/Distribution/Client/ProjectBuilding/Types.hs index f9ac571f3b6..65fc6149ba5 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding/Types.hs +++ b/cabal-install/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/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index f331b6eff18..351553f1cca 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -57,6 +57,8 @@ module Distribution.Client.ProjectPlanning ( setupHsRegisterFlags, setupHsHaddockFlags, setupHsHaddockArgs, + setupHsShowBuildInfoFlags, + setupHsShowBuildInfoArgs, packageHashInputs, @@ -1776,6 +1778,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBenchTargets = [] elabReplTarget = Nothing elabHaddockTargets = [] + elabBuildInfoTargets = [] elabBuildHaddocks = perPkgOptionFlag pkgid False packageConfigDocumentation @@ -2565,6 +2568,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 @@ -2642,6 +2646,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" @@ -2684,6 +2689,7 @@ pruneInstallPlanPass1 pkgs = , null (elabBenchTargets elab) , isNothing (elabReplTarget elab) , null (elabHaddockTargets elab) + , null (elabBuildInfoTargets elab) ] then Just (installedUnitId elab) else Nothing @@ -3594,6 +3600,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/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 1d0e1c5d0ab..bf379a42035 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -317,6 +317,7 @@ data ElaboratedConfiguredPackage elabBenchTargets :: [ComponentTarget], elabReplTarget :: Maybe ComponentTarget, elabHaddockTargets :: [ComponentTarget], + elabBuildInfoTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 464452978fd..22ccf021128 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/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/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 0ff2aa1c45a..43e49419c3b 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -104,8 +104,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 diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index ce67115bd44..0fd04817508 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -84,8 +84,8 @@ removeErrors s = unlines (go (lines s) False) where go [] _ = [] go (x:xs) True - | "cabal:" `isPrefixOf` x = x:(go xs False) - | otherwise = go xs True + | any (`isPrefixOf` x) ["cabal:", "cabal.exe:"] = x:(go xs False) + | otherwise = go xs True go (x:xs) False | "exited with an error" `isInfixOf` x = x:(go xs True) | otherwise = x:(go xs False)