From 5a53c1925eccb904b518ba816d08a4133808400e Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 12 Oct 2022 16:45:48 +0100 Subject: [PATCH] Add support for loading multiple components into one repl session There are several parts to this patch which are logically distinct but work together to support the overal goal of starting a GHCi session with multiple packages loaded at once. 1. When a user writes "cabal repl " then if the user is using a compiler > ghc-9.4.* then we will attempt to start a multi-session which loads the selected targets into one multi-package session of GHC. 1a. The closure property states that in order to load components `p` and `q` into the same session that if `p` depends on `z` and `z` depends on `q` then `z` must also be loaded into the session. 1b. Only inplace packages are able to be loaded into a multi session (if a component `z` exists then it is already made into an inplace package by cabal). Therefore cabal has already engineered that there is source code locally available for all packages which we will want to load into a session. 2. It is necessary to modify `./Setup configure` to allow users to configure a package *without* having previously built the dependency. Instead, we promise to the configure phase that we will have built it by the time we build the package. This allows us to configure all the packages we intend to load into the repl without building any dependenices which we will load in the same session, because the promise is satisifed due to loading the package and it's dependency into one multi-session which ensures the dependency is built before it is needed. A user of ./Setup configure specifies a promised dependency by prepending a "+" to a normal dependency specification. For example: ``` '--dependency=+cabal-install-solver=cabal-install-solver-3.9.0.0-inplace' ``` 2a. The `./Setup repl` command is modified to allow a user to defer starting the repl and instead instruct the command to write the necessary build flags to a file. The option is called `--repl-multi-file `. `cabal-install` then invokes this command for each component which will populate the session and starts a multi-session with all the arguments together. 3. The solver is unmodified, the solver is given the repl targets and creates a build plan as before. After the solver is completed then in `setRootTargets` and `pruneInstallPlan` we modify the install plan to enforce the closure property and mark which dependencies need to be promised. * Mark the current components as `BuildInPlaceOnly InMemory`, which indicates to the compiler that it is to be built in a GHC multi-session. * Augment the component repl targets to indicate that components required by the closure property (in addition to normal targets) will be loaded into the repl. * Modify the dependency edges in `compLibDependencies` to indicate which dependencies are the promised ones (which is precisely components which are `BuildInPlaceOnly InMemory` build styles). This is the field which is eventually used to populate the `--dependency` argument to `./Setup configure`. Pass this-unit-id for executable components as well as libraries When starting multi-repl sessions we can have multiple executables so it's important to distinguish between the different units. undo wip wip - pass all unit-id error messages C files and Setup.hs filtering pruning Missing file Keep temp files in cabal multirepl Undo changes in cabal.project, make tests compile Use cabal.project.local for allow-newer stuff. --- .../src/Distribution/Types/ExposedModule.hs | 1 + .../Distribution/Utils/Structured.hs | 2 +- Cabal/src/Distribution/Backpack/Configure.hs | 28 +- .../Backpack/ConfiguredComponent.hs | 26 +- .../Distribution/Backpack/LinkedComponent.hs | 34 +- .../Backpack/PreExistingComponent.hs | 5 + Cabal/src/Distribution/Compat/ResponseFile.hs | 18 +- Cabal/src/Distribution/Simple/Configure.hs | 57 +++- Cabal/src/Distribution/Simple/GHC.hs | 63 +++- Cabal/src/Distribution/Simple/GHC/ImplInfo.hs | 3 + Cabal/src/Distribution/Simple/GHC/Internal.hs | 39 ++- Cabal/src/Distribution/Simple/GHCJS.hs | 4 +- Cabal/src/Distribution/Simple/Setup.hs | 21 +- Cabal/src/Distribution/Types/AnnotatedId.hs | 6 +- .../Distribution/Types/ComponentInclude.hs | 2 +- .../src/Distribution/Types/GivenComponent.hs | 17 +- .../src/Distribution/Types/LocalBuildInfo.hs | 3 + .../Solver/Types/ComponentDeps.hs | 5 + cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdListBin.hs | 6 +- .../src/Distribution/Client/CmdRepl.hs | 294 ++++++++++++------ .../src/Distribution/Client/Config.hs | 16 +- .../src/Distribution/Client/Configure.hs | 5 +- .../src/Distribution/Client/Install.hs | 6 +- .../src/Distribution/Client/InstallPlan.hs | 39 ++- .../src/Distribution/Client/ParseUtils.hs | 2 +- .../Distribution/Client/ProjectBuilding.hs | 28 +- .../Client/ProjectConfig/Legacy.hs | 21 +- .../Client/ProjectConfig/Types.hs | 4 +- .../Client/ProjectOrchestration.hs | 5 +- .../Distribution/Client/ProjectPlanOutput.hs | 21 +- .../Distribution/Client/ProjectPlanning.hs | 201 +++++++++--- .../Client/ProjectPlanning/Types.hs | 89 ++++-- .../src/Distribution/Client/ReplFlags.hs | 89 ++++++ .../src/Distribution/Client/Setup.hs | 8 +- cabal-install/tests/IntegrationTests2.hs | 28 +- .../Distribution/Client/ProjectConfig.hs | 2 + .../CmdBuild/ScriptBuildRepl/cabal.out | 3 +- .../NewBuild/CmdRepl/Script/cabal.out | 2 +- .../NewBuild/CmdRepl/ScriptRerun/cabal.out | 4 +- .../ReplNoLoad/cabal.exec-no-load.out | 2 +- .../ReplNoLoad/cabal.exec-normal.out | 2 +- .../ReplNoLoad/cabal.lib-no-load.out | 2 +- .../ReplNoLoad/cabal.lib-normal.out | 2 +- ...l.multiple-repl-options-multiple-flags.out | 3 +- .../cabal.multiple-repl-options.out | 3 +- ...e-repl-options-multiple-flags-negative.out | 3 +- ...bal.single-repl-options-multiple-flags.out | 3 +- .../ReplOptions/cabal.single-repl-options.out | 3 +- .../ShowBuildInfo/Complex/single.out | 8 +- .../ShowBuildInfo/Complex/single.test.hs | 69 ++-- 51 files changed, 946 insertions(+), 362 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/ReplFlags.hs diff --git a/Cabal-syntax/src/Distribution/Types/ExposedModule.hs b/Cabal-syntax/src/Distribution/Types/ExposedModule.hs index 22f8d7b9803..aa779c8cade 100644 --- a/Cabal-syntax/src/Distribution/Types/ExposedModule.hs +++ b/Cabal-syntax/src/Distribution/Types/ExposedModule.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ScopedTypeVariables #-} module Distribution.Types.ExposedModule where import Distribution.Compat.Prelude diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 7d68bb251de..7d4ae6db2c3 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,7 +29,7 @@ tests = testGroup "Distribution.Utils.Structured" , testCase "GenericPackageDescription" $ md5Check (Proxy :: Proxy GenericPackageDescription) 0xa3e9433662ecf0c7a3c26f6d75a53ba1 , testCase "LocalBuildInfo" $ - md5Check (Proxy :: Proxy LocalBuildInfo) 0x91ffcd61bbd83525e8edba877435a031 + md5Check (Proxy :: Proxy LocalBuildInfo) 0x8b9d831610716b11342d0a6242b144b3 #endif ] diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs index e2a75946d37..d3da53fc563 100644 --- a/Cabal/src/Distribution/Backpack/Configure.hs +++ b/Cabal/src/Distribution/Backpack/Configure.hs @@ -46,6 +46,7 @@ import Distribution.Verbosity import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph (Graph, IsNode(..)) import Distribution.Utils.LogProgress +import Distribution.Backpack.ModuleShape import Data.Either ( lefts ) @@ -66,7 +67,7 @@ configureComponentLocalBuildInfos -> Flag String -- configIPID -> Flag ComponentId -- configCID -> PackageDescription - -> [PreExistingComponent] + -> ([PreExistingComponent], [FakePreExistingComponent]) -> FlagAssignment -- configConfigurationsFlags -> [(ModuleName, Module)] -- configInstantiateWith -> InstalledPackageIndex @@ -74,7 +75,7 @@ configureComponentLocalBuildInfos -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex) configureComponentLocalBuildInfos verbosity use_external_internal_deps enabled deterministic ipid_flag cid_flag pkg_descr - prePkgDeps flagAssignment instantiate_with installedPackageSet comp = do + (prePkgDeps, promisedPkgDeps) flagAssignment instantiate_with installedPackageSet comp = do -- NB: In single component mode, this returns a *single* component. -- In this graph, the graph is NOT closed. graph0 <- case mkComponentsGraph enabled pkg_descr of @@ -92,6 +93,10 @@ configureComponentLocalBuildInfos ann_cname = pc_compname pkg })) | pkg <- prePkgDeps] + `Map.union` + Map.fromListWith Map.union + [ (pkg, Map.singleton (ann_cname aid) aid) + | FakePreExistingComponent pkg aid <- promisedPkgDeps] graph1 <- toConfiguredComponents use_external_internal_deps flagAssignment deterministic ipid_flag cid_flag pkg_descr @@ -102,13 +107,17 @@ configureComponentLocalBuildInfos let shape_pkg_map = Map.fromList [ (pc_cid pkg, (pc_open_uid pkg, pc_shape pkg)) | pkg <- prePkgDeps] + `Map.union` + Map.fromList + [ (ann_id aid, (DefiniteUnitId (unsafeMkDefUnitId $ mkUnitId (unComponentId (ann_id aid) )), emptyModuleShape)) + | FakePreExistingComponent _ aid <- promisedPkgDeps] uid_lookup def_uid | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid = FullUnitId (Installed.installedComponentId pkg) (Map.fromList (Installed.instantiatedWith pkg)) | otherwise = error ("uid_lookup: " ++ prettyShow uid) where uid = unDefUnitId def_uid - graph2 <- toLinkedComponents verbosity uid_lookup + graph2 <- toLinkedComponents verbosity (not (null promisedPkgDeps)) uid_lookup (package pkg_descr) shape_pkg_map graph1 infoProgress $ @@ -129,7 +138,7 @@ configureComponentLocalBuildInfos infoProgress $ hang (text "Ready component graph:") 4 (vcat (map dispReadyComponent graph4)) - toComponentLocalBuildInfos comp installedPackageSet pkg_descr prePkgDeps graph4 + toComponentLocalBuildInfos comp installedPackageSet promisedPkgDeps pkg_descr prePkgDeps graph4 ------------------------------------------------------------------------------ -- ComponentLocalBuildInfo @@ -138,13 +147,14 @@ configureComponentLocalBuildInfos toComponentLocalBuildInfos :: Compiler -> InstalledPackageIndex -- FULL set + -> [FakePreExistingComponent] -> PackageDescription -> [PreExistingComponent] -- external package deps -> [ReadyComponent] -> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex) -- only relevant packages toComponentLocalBuildInfos - comp installedPackageSet pkg_descr externalPkgDeps graph = do + comp installedPackageSet promisedPkgDeps pkg_descr externalPkgDeps graph = do -- Check and make sure that every instantiated component exists. -- We have to do this now, because prior to linking/instantiating -- we don't actually know what the full set of 'UnitId's we need @@ -178,9 +188,15 @@ toComponentLocalBuildInfos -- packageDependsIndex = PackageIndex.fromList (lefts local_graph) fullIndex = Graph.fromDistinctList local_graph + case Graph.broken fullIndex of [] -> return () - broken -> + -- If there are promised dependencies, we don't know what the dependencies + -- of these are and that can easily lead to a broken graph. So assume that + -- any promised package is not broken (ie all its dependencies, transitively, + -- will be there). That's a promise. + broken | not (null promisedPkgDeps) -> return () + | otherwise -> -- TODO: ppr this dieProgress . text $ "The following packages are broken because other" diff --git a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs index 69178e048ce..47f7a195ee2 100644 --- a/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/src/Distribution/Backpack/ConfiguredComponent.hs @@ -49,6 +49,7 @@ import qualified Data.Map as Map import Distribution.Pretty import Text.PrettyPrint (Doc, hang, text, vcat, hsep, quotes, ($$)) import qualified Text.PrettyPrint as PP +import Distribution.Compat.Stack -- | A configured component, we know exactly what its 'ComponentId' is, -- and the 'ComponentId's of the things it depends on. @@ -177,22 +178,23 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do if newPackageDepsBehaviour pkg_descr then fmap concat $ forM (targetBuildDepends bi) $ \(Dependency name _ sublibs) -> do - pkg <- case Map.lookup name lib_dep_map of + case Map.lookup name lib_dep_map of Nothing -> dieProgress $ text "Dependency on unbuildable" <+> text "package" <+> pretty name - Just p -> return p - -- Return all library components - forM (NonEmptySet.toList sublibs) $ \lib -> - let comp = CLibName lib in - case Map.lookup comp pkg of - Nothing -> - dieProgress $ - text "Dependency on unbuildable" <+> - text (showLibraryName lib) <+> - text "from" <+> pretty name - Just v -> return v + $$ text (prettyCallStack callStack) + Just pkg -> do + -- Return all library components + forM (NonEmptySet.toList sublibs) $ \lib -> + let comp = CLibName lib in + case Map.lookup comp pkg of + Nothing -> + dieProgress $ + text "Dependency on unbuildable" <+> + text (showLibraryName lib) <+> + text "from" <+> pretty name + Just v -> return v else return old_style_lib_deps mkConfiguredComponent pkg_descr this_cid diff --git a/Cabal/src/Distribution/Backpack/LinkedComponent.hs b/Cabal/src/Distribution/Backpack/LinkedComponent.hs index 797fef251ac..7badd1a37d7 100644 --- a/Cabal/src/Distribution/Backpack/LinkedComponent.hs +++ b/Cabal/src/Distribution/Backpack/LinkedComponent.hs @@ -114,12 +114,13 @@ instance Package LinkedComponent where toLinkedComponent :: Verbosity + -> Bool -> FullDb -> PackageId -> LinkedComponentMap -> ConfiguredComponent -> LogProgress LinkedComponent -toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { +toLinkedComponent verbosity any_promised db this_pid pkg_map ConfiguredComponent { cc_ann_id = aid@AnnotatedId { ann_id = this_cid }, cc_component = component, cc_exe_deps = exe_deps, @@ -276,9 +277,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { case filter (\x' -> unWithSource x /= unWithSource x') xs of [] -> return () _ -> Left $ ambiguousReexportMsg reex x xs - return (to, unWithSource x) + return (to, Just (unWithSource x)) _ -> - Left (brokenReexportMsg reex) + -- Can't resolve it right now.. carry on with the assumption it will be resolved + -- dynamically later by an in-memory package which hasn't been installed yet. + if any_promised + then return (to, Nothing) + -- But if nothing is promised, eagerly report an error, as we already know everything. + else Left (brokenReexportMsg reex) -- TODO: maybe check this earlier; it's syntactically obvious. let build_reexports m (k, v) @@ -289,8 +295,20 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { provs <- foldM build_reexports Map.empty $ -- TODO: doublecheck we have checked for -- src_provs duplicates already! - [ (mod_name, OpenModule this_uid mod_name) | mod_name <- src_provs ] ++ - reexports_list + -- These are normal module exports. + [ (mod_name, (OpenModule this_uid mod_name)) | mod_name <- src_provs ] + ++ + -- These are reexports, which we managed to resolve to something in an external package. + [(mn_new, om) | (mn_new, Just om) <- reexports_list ] + ++ + -- These ones.. we didn't resolve but also we might not have to resolve them because they could come from a promised unit, which we don't know + -- anything about yet. GHC will resolve these itself when it is dealing with the multi-session. These ones will not be built, registered and put + -- into a package database, we only need them to make it as far as generating GHC options where the info will be used to pass the reexported-module option + -- to GHC. + + -- We also know that in the case there are promised units that we will not be doing anything to do with backpack like unification etc.. + [ (mod_name, (OpenModule (DefiniteUnitId (unsafeMkDefUnitId (mkUnitId "fake"))) mod_name)) | (mod_name, Nothing) <- reexports_list ] + -- [(mn_new, OpenModule mn_new) | (mn_new, Nothing) <- reexports_list ] let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape)) @@ -337,12 +355,14 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent { -- every ComponentId gets converted into a UnitId by way of SimpleUnitId. toLinkedComponents :: Verbosity + -> Bool -- ^ Whether there are any "promised" package dependencies which we won't + -- find already installed. -> FullDb -> PackageId -> LinkedComponentMap -> [ConfiguredComponent] -> LogProgress [LinkedComponent] -toLinkedComponents verbosity db this_pid lc_map0 comps +toLinkedComponents verbosity any_promised db this_pid lc_map0 comps = fmap snd (mapAccumM go lc_map0 comps) where go :: Map ComponentId (OpenUnitId, ModuleShape) @@ -350,7 +370,7 @@ toLinkedComponents verbosity db this_pid lc_map0 comps -> LogProgress (Map ComponentId (OpenUnitId, ModuleShape), LinkedComponent) go lc_map cc = do lc <- addProgressCtx (text "In the stanza" <+> text (componentNameStanza (cc_name cc))) $ - toLinkedComponent verbosity db this_pid lc_map cc + toLinkedComponent verbosity any_promised db this_pid lc_map cc return (extendLinkedComponentMap lc lc_map, lc) type LinkedComponentMap = Map ComponentId (OpenUnitId, ModuleShape) diff --git a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs index 2fcfdf1cc83..23674388c54 100644 --- a/Cabal/src/Distribution/Backpack/PreExistingComponent.hs +++ b/Cabal/src/Distribution/Backpack/PreExistingComponent.hs @@ -1,6 +1,7 @@ -- | See module Distribution.Backpack.PreExistingComponent ( PreExistingComponent(..), + FakePreExistingComponent(..), ipiToPreExistingComponent, ) where @@ -20,6 +21,9 @@ import Distribution.Package import qualified Data.Map as Map import qualified Distribution.InstalledPackageInfo as Installed import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import Distribution.Types.AnnotatedId + +data FakePreExistingComponent = FakePreExistingComponent PackageName (AnnotatedId ComponentId) -- | Stripped down version of 'LinkedComponent' for things -- we don't need to know how to build. @@ -56,6 +60,7 @@ ipiToPreExistingComponent ipi = pc_shape = shapeInstalledPackage ipi } + instance HasMungedPackageId PreExistingComponent where mungedId = pc_munged_id diff --git a/Cabal/src/Distribution/Compat/ResponseFile.hs b/Cabal/src/Distribution/Compat/ResponseFile.hs index db0a92994c8..6e14b5bf766 100644 --- a/Cabal/src/Distribution/Compat/ResponseFile.hs +++ b/Cabal/src/Distribution/Compat/ResponseFile.hs @@ -3,7 +3,7 @@ -- Compatibility layer for GHC.ResponseFile -- Implementation from base 4.12.0 is used. -- http://hackage.haskell.org/package/base-4.12.0.0/src/LICENSE -module Distribution.Compat.ResponseFile (expandResponse) where +module Distribution.Compat.ResponseFile (expandResponse, escapeArgs) where import Distribution.Compat.Prelude import Prelude () @@ -13,7 +13,7 @@ import System.IO (hPutStrLn, stderr) import System.IO.Error #if MIN_VERSION_base(4,12,0) -import GHC.ResponseFile (unescapeArgs) +import GHC.ResponseFile (unescapeArgs, escapeArgs) #else unescapeArgs :: String -> [String] @@ -47,6 +47,20 @@ unescape args = reverse . map reverse $ go args NoneQ False [] [] | '"' == c = go cs DblQ False a as | otherwise = go cs NoneQ False (c:a) as +escapeArgs :: [String] -> String +escapeArgs = unlines . map escapeArg + +escapeArg :: String -> String +escapeArg = reverse . foldl' escape [] + +escape :: String -> Char -> String +escape cs c + | isSpace c + || '\\' == c + || '\'' == c + || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result + | otherwise = c:cs + #endif expandResponse :: [String] -> IO [String] diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index ac7bd852f0d..a3cfd948fa6 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | @@ -56,7 +57,6 @@ module Distribution.Simple.Configure import Prelude () import Distribution.Compat.Prelude - import Distribution.Compiler import Distribution.Types.IncludeRenaming import Distribution.Utils.NubList @@ -132,6 +132,7 @@ import Distribution.Compat.Environment ( lookupEnv ) import qualified Data.Maybe as M import qualified Data.Set as Set import qualified Distribution.Compat.NonEmptySet as NES +import Distribution.Types.AnnotatedId type UseExternalInternalDeps = Bool @@ -439,6 +440,8 @@ configure (pkg_descr0, pbi) cfg = do (configDependencies cfg) installedPackageSet + let promisedDepsSet = (mkPromisedDepsSet (configDependencies cfg)) + -- pkg_descr: The resolved package description, that does not contain any -- conditionals, because we have an assignment for -- every flag, either picking them ourselves using a @@ -465,6 +468,7 @@ configure (pkg_descr0, pbi) cfg = do (packageName pkg_descr0) installedPackageSet internalPackageSet + promisedDepsSet requiredDepsMap) comp compPlatform @@ -500,11 +504,12 @@ configure (pkg_descr0, pbi) cfg = do -- For one it's deterministic; for two, we need to associate -- them with renamings which would require a far more complicated -- input scheme than what we have today.) - externalPkgDeps :: [PreExistingComponent] + externalPkgDeps :: ([PreExistingComponent], [FakePreExistingComponent]) <- configureDependencies verbosity use_external_internal_deps internalPackageSet + promisedDepsSet installedPackageSet requiredDepsMap pkg_descr @@ -760,6 +765,7 @@ configure (pkg_descr0, pbi) cfg = do componentGraph = Graph.fromDistinctList buildComponents, componentNameMap = buildComponentsMap, installedPkgs = packageDependsIndex, + promisedPkgs = promisedDepsSet, pkgDescrFile = Nothing, localPkgDescr = pkg_descr', withPrograms = programDb'', @@ -843,6 +849,9 @@ configure (pkg_descr0, pbi) cfg = do where verbosity = fromFlag (configVerbosity cfg) +mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId +mkPromisedDepsSet comps = Map.fromList [ ((pn, CLibName ln), cid) | GivenComponent pn ln cid IsInternal <- comps ] + mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb mkProgramDb cfg initialProgramDb = programDb where @@ -914,6 +923,7 @@ dependencySatisfiable -> PackageName -> InstalledPackageIndex -- ^ installed set -> Set LibraryName -- ^ library components + -> Map (PackageName, ComponentName) ComponentId -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required dependencies -> (Dependency -> Bool) @@ -921,7 +931,7 @@ dependencySatisfiable use_external_internal_deps exact_config allow_private_deps - pn installedPackageSet packageLibraries requiredDepsMap + pn installedPackageSet packageLibraries promised_deps requiredDepsMap (Dependency depName vr sublibs) | exact_config -- When we're given '--exact-configuration', we assume that all @@ -987,7 +997,12 @@ dependencySatisfiable -- cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs || pkgName (IPI.sourcePackageId ipi) == pn) maybeIPI + -- Don't check if it's visible, we promise to build it before we need it. + || promised where maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap + -- Promised is just the same as internal here + promised = isJust $ Map.lookup (depName, CLibName lib) promised_deps + -- | Finalize a generic package description. The workhorse is -- 'finalizePD' but there's a bit of other nattering @@ -1089,20 +1104,21 @@ configureDependencies :: Verbosity -> UseExternalInternalDeps -> Set LibraryName + -> Map (PackageName, ComponentName) ComponentId -> InstalledPackageIndex -- ^ installed packages -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required deps -> PackageDescription -> ComponentRequestedSpec - -> IO [PreExistingComponent] + -> IO ([PreExistingComponent], [FakePreExistingComponent]) configureDependencies verbosity use_external_internal_deps - packageLibraries installedPackageSet requiredDepsMap pkg_descr enableSpec = do + packageLibraries promised_deps installedPackageSet requiredDepsMap pkg_descr enableSpec = do let failedDeps :: [FailedDependency] allPkgDeps :: [ResolvedDependency] (failedDeps, allPkgDeps) = partitionEithers $ concat [ fmap (\s -> (dep, s)) <$> status | dep <- enabledBuildDepends pkg_descr enableSpec , let status = selectDependency (package pkg_descr) - packageLibraries installedPackageSet + packageLibraries promised_deps installedPackageSet requiredDepsMap use_external_internal_deps dep ] internalPkgDeps = [ pkgid @@ -1113,6 +1129,9 @@ configureDependencies verbosity use_external_internal_deps externalPkgDeps = [ pec | (_, ExternalDependency pec) <- allPkgDeps ] + fakeExternalPkgDeps = [ fpec + | (_, FakeExternalDependency fpec) <- allPkgDeps ] + when (not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr)) $ die' verbosity $ "The field 'build-depends: " @@ -1124,7 +1143,7 @@ configureDependencies verbosity use_external_internal_deps reportFailedDependencies verbosity failedDeps reportSelectedDependencies verbosity allPkgDeps - return externalPkgDeps + return (externalPkgDeps, fakeExternalPkgDeps) -- | Select and apply coverage settings for the build based on the -- 'ConfigFlags' and 'Compiler'. @@ -1250,6 +1269,7 @@ data DependencyResolution -- internal dependency which we are getting from the package -- database. = ExternalDependency PreExistingComponent + | FakeExternalDependency FakePreExistingComponent -- | An internal dependency ('PackageId' should be a library name) -- which we are going to have to build. (The -- 'PackageId' here is a hack to get a modest amount of @@ -1263,6 +1283,7 @@ data FailedDependency = DependencyNotExists PackageName -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageId -- ^ Package id of current package -> Set LibraryName -- ^ package libraries + -> Map (PackageName, ComponentName) ComponentId -> InstalledPackageIndex -- ^ Installed packages -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ Packages for which we have been given specific deps to @@ -1271,7 +1292,7 @@ selectDependency :: PackageId -- ^ Package id of current package -- single component? -> Dependency -> [Either FailedDependency DependencyResolution] -selectDependency pkgid internalIndex installedIndex requiredDepsMap +selectDependency pkgid internalIndex promisedIndex installedIndex requiredDepsMap use_external_internal_deps (Dependency dep_pkgname vr libs) = -- If the dependency specification matches anything in the internal package @@ -1302,11 +1323,14 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap | Set.member lib internalIndex = Right $ InternalDependency $ PackageIdentifier dep_pkgname $ packageVersion pkgid + | otherwise = Left $ DependencyMissingInternal dep_pkgname lib -- We have to look it up externally do_external_external :: LibraryName -> Either FailedDependency DependencyResolution + do_external_external lib | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex = + return $ FakeExternalDependency (FakePreExistingComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid )) do_external_external lib = do ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of -- If we know the exact pkg to use, then use it. @@ -1318,6 +1342,8 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap return $ ExternalDependency $ ipiToPreExistingComponent ipi do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution + do_external_internal lib | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex = + return $ FakeExternalDependency (FakePreExistingComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid )) do_external_internal lib = do ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of -- If we know the exact pkg to use, then use it. @@ -1340,7 +1366,8 @@ reportSelectedDependencies verbosity deps = | (dep, resolution) <- deps , let pkgid = case resolution of ExternalDependency pkg' -> packageId pkg' - InternalDependency pkgid' -> pkgid' ] + InternalDependency pkgid' -> pkgid' + FakeExternalDependency {} -> currentCompilerId ] reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO () reportFailedDependencies _ [] = return () @@ -1479,21 +1506,21 @@ combinedConstraints constraints dependencies installedPackages = do allConstraints :: [PackageVersionConstraint] allConstraints = constraints ++ [ thisPackageVersionConstraint (packageId pkg) - | (_, _, _, Just pkg) <- dependenciesPkgInfo ] + | (_, _, _, Just pkg, _) <- dependenciesPkgInfo ] idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo idConstraintMap = Map.fromList -- NB: do NOT use the packageName from -- dependenciesPkgInfo! [ ((pn, cname), pkg) - | (pn, cname, _, Just pkg) <- dependenciesPkgInfo ] + | (pn, cname, _, Just pkg, _) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId, - Maybe InstalledPackageInfo)] + Maybe InstalledPackageInfo, IsInternal)] dependenciesPkgInfo = - [ (pkgname, CLibName lname, cid, mpkg) - | GivenComponent pkgname lname cid <- dependencies + [ (pkgname, CLibName lname, cid, mpkg, int) + | GivenComponent pkgname lname cid int <- dependencies , let mpkg = PackageIndex.lookupComponentId installedPackages cid ] @@ -1503,7 +1530,7 @@ combinedConstraints constraints dependencies installedPackages = do -- an error. badComponentIds = [ (pkgname, cname, cid) - | (pkgname, cname, cid, Nothing) <- dependenciesPkgInfo ] + | (pkgname, cname, cid, Nothing, IsExternal) <- dependenciesPkgInfo ] dispDependencies deps = hsep [ text "--dependency=" diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index d5d9241a8ed..b8b85dbc167 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -117,7 +117,7 @@ import System.Directory ( doesFileExist, doesDirectoryExist , getAppUserDataDirectory, createDirectoryIfMissing , canonicalizePath, removeFile, renameFile, getDirectoryContents - , makeRelativeToCurrentDirectory ) + , makeRelativeToCurrentDirectory, getCurrentDirectory ) import System.FilePath ( (), (<.>), takeExtension , takeDirectory, replaceExtension ,isRelative ) @@ -125,6 +125,10 @@ import qualified System.Info #ifndef mingw32_HOST_OS import System.Posix (createSymbolicLink) #endif /* mingw32_HOST_OS */ +import qualified Data.ByteString.Lazy.Char8 as BS +import Distribution.Compat.ResponseFile (escapeArgs) +import qualified Distribution.InstalledPackageInfo as IPI +import Distribution.Compat.Binary (encode) -- ----------------------------------------------------------------------------- -- Configuring @@ -518,7 +522,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do when (forceStatic || withStaticLib lbi) whenGHCiLib = when (withGHCiLib lbi) forRepl = maybe False (const True) mReplFlags - whenReplLib = when forRepl + whenReplLib = forM_ mReplFlags replFlags = fromMaybe mempty mReplFlags comp = compiler lbi ghcVersion = compilerVersion comp @@ -630,10 +634,12 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do } `mappend` linkerOpts `mappend` mempty { - ghcOptMode = toFlag GhcModeInteractive, + ghcOptMode = isInteractive, ghcOptOptimisation = toFlag GhcNoOptimisation } + isInteractive = toFlag GhcModeInteractive + vanillaSharedOpts = vanillaOpts `mappend` mempty { ghcOptDynLinkMode = toFlag GhcStaticAndDynamic, ghcOptDynHiSuffix = toFlag "dyn_hi", @@ -813,9 +819,9 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -- TODO: problem here is we need the .c files built first, so we can load them -- with ghci, but .c files can depend on .h files generated by ghc by ffi -- exports. - whenReplLib $ do + whenReplLib $ \rflags -> do when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules" - runGhcProg replOpts + runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts libBi clbi (pkgName (PD.package pkg_descr)) -- link: when has_code . unless forRepl $ do @@ -920,7 +926,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, @@ -954,7 +960,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ cleanedExtraLibDirs } @@ -993,6 +999,45 @@ startInterpreter verbosity progdb comp platform packageDBs = do (ghcProg, _) <- requireProgram verbosity ghcProgram progdb runGHC verbosity ghcProg comp platform replOpts + +runReplOrWriteFlags + :: Verbosity + -> ConfiguredProgram + -> Compiler + -> Platform + -> ReplOptions + -> GhcOptions + -> BuildInfo + -> ComponentLocalBuildInfo + -> PackageName + -> IO () +runReplOrWriteFlags verbosity ghcProg comp platform rflags replOpts bi clbi pkg_name = + case replOptionsFlagOutput rflags of + NoFlag -> runGHC verbosity ghcProg comp platform replOpts + Flag out_dir -> do + src_dir <- getCurrentDirectory + let uid = componentUnitId clbi + this_unit = prettyShow uid + reexported_modules = [mn | LibComponentLocalBuildInfo {} <- [clbi], IPI.ExposedModule mn (Just {}) <- componentExposedModules clbi] + hidden_modules = otherModules bi + extra_opts = concat $ + [ ["-this-package-name", prettyShow pkg_name] + , ["-working-dir" , src_dir] + ] ++ + [ ["-reexported-module", prettyShow m] | m <- reexported_modules + ] ++ + [ ["-hidden-module", prettyShow m] | m <- hidden_modules + ] + -- Create "paths" subdirectory if it doesn't exist. This is where we write + -- information about how the PATH was augmented. + createDirectoryIfMissing False (out_dir "paths") + -- Write out the PATH information into `paths` subdirectory. + writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) + -- Write out options for this component into a file ready for loading into + -- the multi-repl + writeFileAtomic (out_dir this_unit) $ BS.pack $ escapeArgs + $ (extra_opts ++) $ renderGhcOptions comp platform (replOpts { ghcOptMode = NoFlag }) + -- ----------------------------------------------------------------------------- -- Building an executable or foreign library @@ -1552,8 +1597,8 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do -- with ghci, but .c files can depend on .h files generated by ghc by ffi -- exports. case bm of - GReplExe _ _ -> runGhcProg replOpts - GReplFLib _ _ -> runGhcProg replOpts + GReplExe _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) + GReplFLib _ _ -> runReplOrWriteFlags verbosity ghcProg comp platform replFlags replOpts bnfo clbi (pkgName (PD.package pkg_descr)) GBuildExe _ -> do let linkOpts = commonOpts `mappend` linkerOpts diff --git a/Cabal/src/Distribution/Simple/GHC/ImplInfo.hs b/Cabal/src/Distribution/Simple/GHC/ImplInfo.hs index ea95aac50e6..4e6229cdb17 100644 --- a/Cabal/src/Distribution/Simple/GHC/ImplInfo.hs +++ b/Cabal/src/Distribution/Simple/GHC/ImplInfo.hs @@ -46,6 +46,7 @@ data GhcImplInfo = GhcImplInfo , supportsDebugLevels :: Bool -- ^ supports numeric @-g@ levels , supportsPkgEnvFiles :: Bool -- ^ picks up @.ghc.environment@ files , flagWarnMissingHomeModules :: Bool -- ^ -Wmissing-home-modules is supported + , unitIdForExes :: Bool } getImplInfo :: Compiler -> GhcImplInfo @@ -74,6 +75,7 @@ ghcVersionImplInfo ver = GhcImplInfo , supportsDebugLevels = v >= [8,0] , supportsPkgEnvFiles = v >= [8,0,1,20160901] -- broken in 8.0.1, fixed in 8.0.2 , flagWarnMissingHomeModules = v >= [8,2] + , unitIdForExes = v >= [9,2] } where v = versionNumbers ver @@ -94,6 +96,7 @@ ghcjsVersionImplInfo _ghcjsver ghcver = GhcImplInfo , supportsDebugLevels = ghcv >= [8,0] , supportsPkgEnvFiles = ghcv >= [8,0,2] --TODO: check this works in ghcjs , flagWarnMissingHomeModules = ghcv >= [8,2] + , unitIdForExes = ghcv >= [9,2] } where ghcv = versionNumbers ghcver diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index 507831f3cab..99584c00391 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -77,12 +77,14 @@ import Distribution.Utils.Path import Language.Haskell.Extension import qualified Data.Map as Map +import qualified Data.Set as Set import qualified Data.ByteString.Lazy.Char8 as BS import System.Directory ( getDirectoryContents, getTemporaryDirectory ) import System.Environment ( getEnv ) import System.FilePath ( (), (<.>), takeExtension , takeDirectory, takeFileName) import System.IO ( hClose, hPutStrLn ) +import Distribution.Types.ComponentId (ComponentId) targetPlatform :: [(String, String)] -> Maybe Platform targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo @@ -292,7 +294,7 @@ componentCcGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptCcOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -331,7 +333,7 @@ componentCxxGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptCxxOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -370,7 +372,7 @@ componentAsmGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptAsmOptions = (case withOptimization lbi of NoOptimisation -> [] _ -> ["-O2"]) ++ @@ -405,7 +407,7 @@ componentJsGhcOptions verbosity _implInfo lbi bi clbi odir filename = ++ [buildDir lbi dir | dir <- includeDirs bi], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptObjDir = toFlag odir } @@ -422,7 +424,17 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptThisUnitId = case clbi of LibComponentLocalBuildInfo { componentCompatPackageKey = pk } -> toFlag pk - _ -> mempty, + _ | not (unitIdForExes implInfo) -> mempty + ExeComponentLocalBuildInfo { componentUnitId = uid } + -> toFlag (unUnitId uid) + TestComponentLocalBuildInfo { componentUnitId = uid } + -> toFlag (unUnitId uid) + BenchComponentLocalBuildInfo { componentUnitId = uid } + -> toFlag (unUnitId uid) + FLibComponentLocalBuildInfo { componentUnitId = uid } + -> toFlag (unUnitId uid) + + , ghcOptThisComponentId = case clbi of LibComponentLocalBuildInfo { componentComponentId = cid , componentInstantiatedWith = insts } -> @@ -438,7 +450,7 @@ componentGhcOptions verbosity implInfo lbi bi clbi odir = ghcOptHideAllPackages = toFlag True, ghcOptWarnMissingHomeModules = toFlag $ flagWarnMissingHomeModules implInfo, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages mempty clbi, ghcOptSplitSections = toFlag (splitSections lbi), ghcOptSplitObjs = toFlag (splitObjs lbi), ghcOptSourcePathClear = toFlag True, @@ -507,7 +519,7 @@ componentCmmGhcOptions verbosity _implInfo lbi bi clbi odir filename = [autogenComponentModulesDir lbi clbi cppHeaderName], ghcOptHideAllPackages= toFlag True, ghcOptPackageDBs = withPackageDB lbi, - ghcOptPackages = toNubListR $ mkGhcOptPackages clbi, + ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi, ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toFlag (withDebugInfo lbi), ghcOptExtra = cmmOptions bi, @@ -560,9 +572,18 @@ getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs return [ pref ModuleName.toFilePath x <.> wanted_obj_ext | x <- allLibModules lib clbi ] -mkGhcOptPackages :: ComponentLocalBuildInfo +-- | Create the require packaged arguments, but filtering out package arguments which +-- aren't yet built, but promised. This filtering is used when compiling C/Cxx/Asm files, +-- and is a hack to avoid passing bogus `-package` arguments to GHC. The assumption being that +-- in 99% of cases we will include the right `-package` so that the C file finds the right headers. +mkGhcOptPackages :: Map (PackageName, ComponentName) ComponentId + -> ComponentLocalBuildInfo -> [(OpenUnitId, ModuleRenaming)] -mkGhcOptPackages = componentIncludes +mkGhcOptPackages promised_pkgs clbi = [ i | i@(uid, _) <- componentIncludes clbi + , abstractUnitId uid `Set.notMember` promised_cids ] + where + -- Promised deps are going to be simple UnitIds + promised_cids = Set.fromList (map newSimpleUnitId (Map.elems promised_pkgs)) substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo substTopDir topDir ipo diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index c8721746a6a..b1951a5fae0 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -663,7 +663,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi, ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi, @@ -695,7 +695,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do -> insts _ -> [], ghcOptPackages = toNubListR $ - Internal.mkGhcOptPackages clbi , + Internal.mkGhcOptPackages mempty clbi , ghcOptLinkLibs = extraLibs libBi, ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi } diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 36f6aa22f15..fd698bd2fa1 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -260,7 +260,7 @@ data ConfigFlags = ConfigFlags { configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for -- dependencies. configDependencies :: [GivenComponent], - -- ^The packages depended on. + -- ^The packages depended on and whether they need to already exist or not. configInstantiateWith :: [(ModuleName, Module)], -- ^ The requested Backpack instantiation. If empty, either this -- package does not use Backpack, or we just want to typecheck @@ -685,10 +685,11 @@ configureOptions showOrParseArgs = ,option "" ["dependency"] "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" configDependencies (\v flags -> flags { configDependencies = v}) - (reqArg "NAME[:COMPONENT_NAME]=CID" + (reqArg "[+]NAME[:COMPONENT_NAME]=CID" (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent)) - (map (\(GivenComponent pn cn cid) -> - prettyShow pn + (map (\(GivenComponent pn cn cid int) -> + (case int of { IsInternal -> "+"; IsExternal -> ""}) + ++ prettyShow pn ++ case cn of LMainLibName -> "" LSubLibName n -> ":" ++ prettyShow n ++ "=" ++ prettyShow cid))) @@ -782,6 +783,7 @@ showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] parsecGivenComponent :: ParsecParser GivenComponent parsecGivenComponent = do + is_internal <- P.optional (P.char '+') pn <- parsec ln <- P.option LMainLibName $ do _ <- P.char ':' @@ -791,7 +793,7 @@ parsecGivenComponent = do else LSubLibName ucn _ <- P.char '=' cid <- parsec - return $ GivenComponent pn ln cid + return $ GivenComponent pn ln cid (case is_internal of Just {} -> IsInternal; _ -> IsExternal) installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] installDirsOptions = @@ -1961,7 +1963,8 @@ instance Semigroup BuildFlags where data ReplOptions = ReplOptions { replOptionsFlags :: [String], - replOptionsNoLoad :: Flag Bool + replOptionsNoLoad :: Flag Bool, + replOptionsFlagOutput :: Flag FilePath } deriving (Show, Generic, Typeable) @@ -1970,7 +1973,7 @@ instance Structured ReplOptions instance Monoid ReplOptions where - mempty = ReplOptions mempty (Flag False) + mempty = ReplOptions mempty (Flag False) NoFlag mappend = (<>) instance Semigroup ReplOptions where @@ -2084,6 +2087,10 @@ replOptions _ = "Use the option(s) for the repl" replOptionsFlags (\p flags -> flags { replOptionsFlags = p }) (reqArg "FLAG" (succeedReadE words) id) + , option [] ["repl-multi-file"] + "Write repl options to this file rather than starting repl" + replOptionsFlagOutput (\p flags -> flags { replOptionsFlagOutput = p }) + (reqArg "FILEPATH" (succeedReadE Flag) flagToList) ] -- ------------------------------------------------------------ diff --git a/Cabal/src/Distribution/Types/AnnotatedId.hs b/Cabal/src/Distribution/Types/AnnotatedId.hs index 49a3c0f4039..6719e414814 100644 --- a/Cabal/src/Distribution/Types/AnnotatedId.hs +++ b/Cabal/src/Distribution/Types/AnnotatedId.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveFunctor #-} module Distribution.Types.AnnotatedId ( AnnotatedId(..) ) where @@ -19,7 +20,7 @@ data AnnotatedId id = AnnotatedId { ann_cname :: ComponentName, ann_id :: id } - deriving (Show) + deriving (Show, Functor) instance Eq id => Eq (AnnotatedId id) where x == y = ann_id x == ann_id y @@ -29,6 +30,3 @@ instance Ord id => Ord (AnnotatedId id) where instance Package (AnnotatedId id) where packageId = ann_pid - -instance Functor AnnotatedId where - fmap f (AnnotatedId pid cn x) = AnnotatedId pid cn (f x) diff --git a/Cabal/src/Distribution/Types/ComponentInclude.hs b/Cabal/src/Distribution/Types/ComponentInclude.hs index f60f696808f..97d49625529 100644 --- a/Cabal/src/Distribution/Types/ComponentInclude.hs +++ b/Cabal/src/Distribution/Types/ComponentInclude.hs @@ -19,7 +19,7 @@ data ComponentInclude id rn = ComponentInclude { -- | Did this come from an entry in @mixins@, or -- was implicitly generated by @build-depends@? ci_implicit :: Bool - } + } deriving Show ci_id :: ComponentInclude id rn -> id ci_id = ann_id . ci_ann_id diff --git a/Cabal/src/Distribution/Types/GivenComponent.hs b/Cabal/src/Distribution/Types/GivenComponent.hs index 3908ec07cc9..9e68e2f2c24 100644 --- a/Cabal/src/Distribution/Types/GivenComponent.hs +++ b/Cabal/src/Distribution/Types/GivenComponent.hs @@ -1,7 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE InstanceSigs #-} module Distribution.Types.GivenComponent ( - GivenComponent(..) + GivenComponent(..), + IsInternal(..) ) where import Distribution.Compat.Prelude @@ -21,8 +25,17 @@ data GivenComponent = { givenComponentPackage :: PackageName , givenComponentName :: LibraryName -- --dependency is for libraries -- only, not for any component - , givenComponentId :: ComponentId } + , givenComponentId :: ComponentId + , givenComponentInternal :: IsInternal } deriving (Generic, Read, Show, Eq, Typeable) +data IsInternal = + IsInternal + | IsExternal + deriving (Read, Eq, Show, Ord, Generic) + instance Binary GivenComponent instance Structured GivenComponent + +instance Binary IsInternal where +instance Structured IsInternal where diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index bc9f6bc45d3..3d3bd36a08a 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -109,6 +109,9 @@ data LocalBuildInfo = LocalBuildInfo { componentNameMap :: Map ComponentName [ComponentLocalBuildInfo], -- ^ A map from component name to all matching -- components. These coincide with 'componentGraph' + promisedPkgs :: Map (PackageName, ComponentName) ComponentId, + -- ^ The packages we were promised, but aren't already installed. + -- MP: Perhaps this just needs to be a Set UnitId at this stage. installedPkgs :: InstalledPackageIndex, -- ^ All the info about the installed packages that the -- current package depends on (directly or indirectly). diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ComponentDeps.hs b/cabal-install-solver/src/Distribution/Solver/Types/ComponentDeps.hs index 7726c3eba1c..8926521673b 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ComponentDeps.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ComponentDeps.hs @@ -24,6 +24,7 @@ module Distribution.Solver.Types.ComponentDeps ( , insert , zip , filterDeps + , mapDeps , fromLibraryDeps , fromSetupDeps , fromInstalled @@ -149,6 +150,10 @@ zip (ComponentDeps d1) (ComponentDeps d2) = filterDeps :: (Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a filterDeps p = ComponentDeps . Map.filterWithKey p . unComponentDeps +-- | Keep only selected components (and their associated deps info). +mapDeps :: (Component -> a -> b) -> ComponentDeps a -> ComponentDeps b +mapDeps p = ComponentDeps . Map.mapWithKey p . unComponentDeps + -- | ComponentDeps containing library dependencies only fromLibraryDeps :: a -> ComponentDeps a fromLibraryDeps = singleton ComponentLib diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 747d353276b..240b36d7852 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -158,6 +158,7 @@ library Distribution.Client.ProjectPlanning.Types Distribution.Client.RebuildMonad Distribution.Client.Reconfigure + Distribution.Client.ReplFlags Distribution.Client.Run Distribution.Client.Sandbox Distribution.Client.Sandbox.PackageEnvironment diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs index 27674300849..5813eb6b461 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -158,7 +158,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do -> ElaboratedConfiguredPackage -> [FilePath] elaboratedPackage distDirLayout elaboratedSharedConfig selectedComponent elab = case elabPkgOrComp elab of - ElabPackage pkg -> + ElabPackage pkg -> --TODO: MP [ bin | (c, _) <- CD.toList $ CD.zip (pkgLibDependencies pkg) (pkgExeDependencies pkg) @@ -185,12 +185,12 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do -- here and in PlanOutput, -- use binDirectoryFor? bin_file' s = - if elabBuildStyle elab == BuildInplaceOnly + if isInplaceBuildStyle (elabBuildStyle elab) then dist_dir "build" prettyShow s prettyShow s <.> exeExtension plat else InstallDirs.bindir (elabInstallDirs elab) prettyShow s <.> exeExtension plat flib_file' s = - if elabBuildStyle elab == BuildInplaceOnly + if isInplaceBuildStyle (elabBuildStyle elab) then dist_dir "build" prettyShow s ("lib" ++ prettyShow s) <.> dllExtension plat else InstallDirs.bindir (elabInstallDirs elab) ("lib" ++ prettyShow s) <.> dllExtension plat diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index be129b042f4..73d5122b286 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} -- | cabal-install CLI command: repl -- @@ -10,11 +11,13 @@ module Distribution.Client.CmdRepl ( -- * The @repl@ CLI and action replCommand, replAction, + ReplFlags(..), -- * Internals exposed for testing matchesMultipleProblem, selectPackageTargets, - selectComponentTarget + selectComponentTarget, + MultiReplDecision (..), ) where import Prelude () @@ -42,7 +45,7 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning ( ElaboratedSharedConfig(..), ElaboratedInstallPlan ) import Distribution.Client.ProjectPlanning.Types - ( elabOrderExeDependencies ) + ( elabOrderExeDependencies, showElaboratedInstallPlan ) import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), withContextAndSelectors, TargetContext(..) , updateContextAndWriteProjectFile, updateContextAndWriteProjectFile' @@ -53,21 +56,16 @@ import qualified Distribution.Client.Setup as Client import Distribution.Client.Types ( PackageSpecifier(..), UnresolvedSourcePackage ) import Distribution.Simple.Setup - ( fromFlagOrDefault, ReplOptions(..), replOptions - , Flag(..), toFlag, falseArg ) + ( ReplOptions(..) ) import Distribution.Simple.Command - ( CommandUI(..), liftOptionL, usageAlternatives, option - , ShowOrParseArgs, OptionField, reqArg ) + ( CommandUI(..), usageAlternatives + ) import Distribution.Compiler ( CompilerFlavor(GHC) ) import Distribution.Simple.Compiler ( Compiler, compilerCompatVersion ) import Distribution.Package ( Package(..), packageName, UnitId, installedUnitId ) -import Distribution.Parsec - ( parsecCommaList ) -import Distribution.ReadE - ( ReadE, parsecToReadE ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Types.BuildInfo @@ -89,7 +87,7 @@ import Distribution.Utils.Generic import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Simple.Utils - ( wrapText, die', debugNoWrap ) + ( wrapText, die', debugNoWrap, withTempDirectoryEx, TempFileOptions (..) ) import Language.Haskell.Extension ( Language(..) ) @@ -98,40 +96,22 @@ import Data.List import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory - ( doesFileExist, getCurrentDirectory ) + ( doesFileExist, getCurrentDirectory, listDirectory, makeAbsolute ) import System.FilePath - ( () ) - -data EnvFlags = EnvFlags - { envPackages :: [Dependency] - , envIncludeTransitive :: Flag Bool - } - -defaultEnvFlags :: EnvFlags -defaultEnvFlags = EnvFlags - { envPackages = [] - , envIncludeTransitive = toFlag True - } - -envOptions :: ShowOrParseArgs -> [OptionField EnvFlags] -envOptions _ = - [ option ['b'] ["build-depends"] - "Include additional packages in the environment presented to GHCi." - envPackages (\p flags -> flags { envPackages = p ++ envPackages flags }) - (reqArg "DEPENDENCIES" dependenciesReadE (fmap prettyShow :: [Dependency] -> [String])) - , option [] ["no-transitive-deps"] - "Don't automatically include transitive dependencies of requested packages." - envIncludeTransitive (\p flags -> flags { envIncludeTransitive = p }) - falseArg - ] - where - dependenciesReadE :: ReadE [Dependency] - dependenciesReadE = - parsecToReadE - ("couldn't parse dependencies: " ++) - (parsecCommaList parsec) - -replCommand :: CommandUI (NixStyleFlags (ReplOptions, EnvFlags)) + ( (), splitSearchPath, searchPathSeparator ) +import Distribution.Simple.Program.Run +import Distribution.Simple.Program.Builtin +import Distribution.Simple.Program.Db +import Control.Monad +import Distribution.Compat.Binary +import qualified Data.ByteString.Lazy as BS +import Distribution.Simple.Program.Types +import Distribution.Client.ReplFlags +import Distribution.Simple.Flag +import Distribution.Client.ProjectConfig + + +replCommand :: CommandUI (NixStyleFlags ReplFlags) replCommand = Client.installCommand { commandName = "v2-repl", commandSynopsis = "Open an interactive session for the given component.", @@ -168,12 +148,29 @@ replCommand = Client.installCommand { ++ " add a version (constrained between 4.15 and 4.18) of the library 'lens' " ++ "to the default component (or no component if there is no project present)\n", - commandDefaultFlags = defaultNixStyleFlags (mempty, defaultEnvFlags), - commandOptions = nixStyleOptions $ \showOrParseArgs -> - map (liftOptionL _1) (replOptions showOrParseArgs) ++ - map (liftOptionL _2) (envOptions showOrParseArgs) + commandDefaultFlags = defaultNixStyleFlags defaultReplFlags, + commandOptions = nixStyleOptions topReplOptions + } +data MultiReplDecision = MultiReplDecision + { compilerVersion:: Maybe Version + , enabledByFlag :: Bool + } deriving (Eq, Show) + +useMultiRepl :: MultiReplDecision -> Bool +useMultiRepl MultiReplDecision{compilerVersion, enabledByFlag} + = compilerVersion >= Just minMultipleHomeUnitsVersion && enabledByFlag + +multiReplDecision :: ProjectConfigShared -> Compiler -> ReplFlags -> MultiReplDecision +multiReplDecision ctx compiler flags = + MultiReplDecision + -- Check if the compiler is new enough, need at least 9.4 to start a multi session + (compilerCompatVersion GHC compiler) + -- Then check the user actually asked for it, either via the project file, the global config or + -- a repl specific option. + (fromFlagOrDefault False (projectConfigMultiRepl ctx <> replUseMulti flags)) + -- | The @repl@ command is very much like @build@. It brings the install plan -- up to date, selects that part of the plan needed by the given or implicit -- repl target and then executes the plan. @@ -185,8 +182,8 @@ replCommand = Client.installCommand { -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- -replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO () -replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetStrings globalFlags +replAction :: NixStyleFlags ReplFlags -> [String] -> GlobalFlags -> IO () +replAction flags@NixStyleFlags { extraFlags = r@ReplFlags{..} , ..} targetStrings globalFlags = withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags ReplCommand $ \targetCtx ctx targetSelectors -> do when (buildSettingOnlyDeps (buildSettings ctx)) $ die' verbosity $ "The repl command does not support '--only-dependencies'. " @@ -194,6 +191,7 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt ++ "use 'repl'." let projectRoot = distProjectRootDirectory $ distDirLayout ctx + distDir = distDirectory $ distDirLayout ctx baseCtx <- case targetCtx of ProjectContext -> return ctx @@ -222,22 +220,22 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt updateContextAndWriteProjectFile ctx scriptPath scriptExecutable - (originalComponent, baseCtx') <- if null (envPackages envFlags) + (originalComponent, baseCtx') <- if null (envPackages replEnvFlags) then return (Nothing, baseCtx) else -- Unfortunately, the best way to do this is to let the normal solver -- help us resolve the targets, but that isn't ideal for performance, -- especially in the no-project case. - withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do + withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan sharedConfig -> do -- targets should be non-empty map, but there's no NonEmptyMap yet. - targets <- validatedTargets elaboratedPlan targetSelectors + targets <- validatedTargets (projectConfigShared (projectConfig ctx)) (pkgConfigCompiler sharedConfig) elaboratedPlan targetSelectors let (unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId oci = OriginalComponentInfo unitId originalDeps pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId - baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx + baseCtx' = addDepsToProjectTarget (envPackages replEnvFlags) pkgId baseCtx return (Just oci, baseCtx') @@ -249,26 +247,26 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt -- In addition, to avoid a *third* trip through the solver, we are -- replicating the second half of 'runProjectPreBuildPhase' by hand -- here. - (buildCtx, compiler, replOpts') <- withInstallPlan verbosity baseCtx' $ + (buildCtx, compiler, replOpts', targets) <- withInstallPlan verbosity baseCtx' $ \elaboratedPlan elaboratedShared' -> do let ProjectBaseContext{..} = baseCtx' -- Recalculate with updated project. - targets <- validatedTargets elaboratedPlan targetSelectors + targets <- validatedTargets (projectConfigShared projectConfig) (pkgConfigCompiler elaboratedShared') elaboratedPlan targetSelectors let elaboratedPlan' = pruneInstallPlanToTargets TargetActionRepl targets elaboratedPlan - includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags) + includeTransitive = fromFlagOrDefault True (envIncludeTransitive replEnvFlags) pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared' elaboratedPlan' let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages pkgsBuildStatus elaboratedPlan' - debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan'') + debugNoWrap verbosity (showElaboratedInstallPlan elaboratedPlan'') let buildCtx = ProjectBuildContext @@ -281,30 +279,75 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared' - replFlags = case originalComponent of + repl_flags = case originalComponent of Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci Nothing -> [] - return (buildCtx, compiler, replOpts & lReplOptionsFlags %~ (++ replFlags)) +-- traceShowM ("**************", replFlags) + return (buildCtx, compiler, configureReplOptions & lReplOptionsFlags %~ (++ repl_flags), targets) + +-- traceShowM ("replOpts **************", replOpts, targetCtx) + if (Set.size (distinctTargetComponents targets) > 1) + -- TODO: make keeping temp files configurable + then withTempDirectoryEx verbosity (TempFileOptions True) distDir "multi-out-" $ \dir' -> do + -- traceShowM ("^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^", dir', distDir) + dir <- makeAbsolute dir' + replOpts'' <- case targetCtx of + ProjectContext -> return $ replOpts' { replOptionsFlagOutput = Flag dir} + _ -> usingGhciScript compiler projectRoot replOpts' + + let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' + printPlan verbosity baseCtx' buildCtx' +-- traceShowM ("replOpts **************", replOpts'', targetCtx) + + buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx' + runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes + unit_files <- listDirectory dir + let all_unit_opts = [["-unit", "@" ++ dir unit] | unit <- unit_files, unit /= "paths"] + path_files <- listDirectory (dir "paths") + ghcProgs <- mapM (\f -> decode @ConfiguredProgram <$> BS.readFile (dir "paths" f)) path_files + let all_paths = concatMap programOverrideEnv ghcProgs +-- print (all (== (head all_paths)) all_paths) + let sp = intercalate [searchPathSeparator] (map fst (sortBy (comparing @Int snd) $ Map.toList (combine_search_paths all_paths))) + -- HACK: Just combine together all env overrides, placing the most common things last + + (ghcProg, _) <- requireProgram verbosity ghcProgram (pkgConfigCompilerProgs (elaboratedShared buildCtx')) + let ghcProg' = ghcProg { programOverrideEnv = [("PATH", Just sp)]} + runProgramInvocation verbosity $ programInvocation ghcProg' $ concat $ + ["--interactive" + , "-j", show (buildSettingNumJobs (buildSettings ctx)) + ] + :all_unit_opts + pure () + else do + replOpts'' <- case targetCtx of + ProjectContext -> return replOpts' + _ -> usingGhciScript compiler projectRoot replOpts' + + let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' + printPlan verbosity baseCtx' buildCtx' +-- traceShowM ("replOpts **************", replOpts'', targetCtx) + + buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx' + runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes + where - replOpts'' <- case targetCtx of - ProjectContext -> return replOpts' - _ -> usingGhciScript compiler projectRoot replOpts' + combine_search_paths paths = + foldl' go Map.empty paths + where + go m ("PATH", Just s) = foldl' (\m' f-> Map.insertWith (+) f 1 m') m (splitSearchPath s) + go m _ = m - let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' - printPlan verbosity baseCtx' buildCtx' - buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx' - runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes - where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - validatedTargets elaboratedPlan targetSelectors = do + validatedTargets ctx compiler elaboratedPlan targetSelectors = do + let multi_repl_enabled = multiReplDecision ctx compiler r -- Interpret the targets on the command line as repl targets -- (as opposed to say build or haddock targets). targets <- either (reportTargetProblems verbosity) return $ resolveTargets - selectPackageTargets + (selectPackageTargets multi_repl_enabled) selectComponentTarget elaboratedPlan Nothing @@ -313,12 +356,16 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt -- Reject multiple targets, or at least targets in different -- components. It is ok to have two module/file targets in the -- same component, but not two that live in different components. - when (Set.size (distinctTargetComponents targets) > 1) $ + when (Set.size (distinctTargetComponents targets) > 1 && not (useMultiRepl multi_repl_enabled)) $ reportTargetProblems verbosity - [multipleTargetsProblem targets] + [multipleTargetsProblem multi_repl_enabled targets] return targets +-- | First version of GHC which supports multile home packages +minMultipleHomeUnitsVersion :: Version +minMultipleHomeUnitsVersion = mkVersion [9, 4] + data OriginalComponentInfo = OriginalComponentInfo { ociUnitId :: UnitId , ociOriginalDeps :: [UnitId] @@ -378,6 +425,7 @@ usingGhciScript compiler projectRoot replOpts return $ replOpts & lReplOptionsFlags %~ (("-ghci-script" ++ ghciScriptPath) :) | otherwise = return replOpts + -- | First version of GHC where GHCi supported the flag we need. -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html minGhciScriptVersion :: Version @@ -398,9 +446,42 @@ minGhciScriptVersion = mkVersion [7, 6] -- Fail if there are no buildable lib\/exe components, or if there are -- multiple libs or exes. -- -selectPackageTargets :: TargetSelector +selectPackageTargets :: MultiReplDecision + -> TargetSelector -> [AvailableTarget k] -> Either ReplTargetProblem [k] -selectPackageTargets targetSelector targets +selectPackageTargets multiple_targets_allowed + -- If explicit enabled, then select the targets like we would for multi-repl but + -- might still fail later because of compiler version. + = if enabledByFlag multiple_targets_allowed + then selectPackageTargetsMulti + else selectPackageTargetsSingle multiple_targets_allowed + +selectPackageTargetsMulti :: TargetSelector + -> [AvailableTarget k] -> Either ReplTargetProblem [k] +selectPackageTargetsMulti targetSelector targets + | not (null targetsBuildable) + = Right targetsBuildable + -- If there are no targets at all then we report that + | otherwise + = Left (TargetProblemNoTargets targetSelector) + where + (targetsBuildable, + _) = selectBuildableTargetsWith' + (isRequested 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) + isRequested (TargetAllPackages Nothing) TargetNotRequestedByDefault = False + isRequested (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False + isRequested _ _ = True + +-- | Target selection behaviour which only select a single target. +-- This is used when the compiler version doesn't support multi-repl or the user +-- didn't request it. +selectPackageTargetsSingle :: MultiReplDecision -> TargetSelector + -> [AvailableTarget k] -> Either ReplTargetProblem [k] +selectPackageTargetsSingle decision targetSelector targets -- If there is exactly one buildable library then we select that | [target] <- targetsLibsBuildable @@ -408,7 +489,7 @@ selectPackageTargets targetSelector targets -- but fail if there are multiple buildable libraries. | not (null targetsLibsBuildable) - = Left (matchesMultipleProblem targetSelector targetsLibsBuildable') + = Left (matchesMultipleProblem decision targetSelector targetsLibsBuildable') -- If there is exactly one buildable executable then we select that | [target] <- targetsExesBuildable @@ -416,7 +497,7 @@ selectPackageTargets targetSelector targets -- but fail if there are multiple buildable executables. | not (null targetsExesBuildable) - = Left (matchesMultipleProblem targetSelector targetsExesBuildable') + = Left (matchesMultipleProblem decision targetSelector targetsExesBuildable') -- If there is exactly one other target then we select that | [target] <- targetsBuildable @@ -424,7 +505,7 @@ selectPackageTargets targetSelector targets -- but fail if there are multiple such targets | not (null targetsBuildable) - = Left (matchesMultipleProblem targetSelector targetsBuildable') + = Left (matchesMultipleProblem decision targetSelector targetsBuildable') -- If there are targets but none are buildable then we report those | not (null targets) @@ -466,10 +547,10 @@ selectComponentTarget = selectComponentTargetBasic data ReplProblem - = TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()] + = TargetProblemMatchesMultiple MultiReplDecision TargetSelector [AvailableTarget ()] -- | Multiple 'TargetSelector's match multiple targets - | TargetProblemMultipleTargets TargetsMap + | TargetProblemMultipleTargets MultiReplDecision TargetsMap deriving (Eq, Show) -- | The various error conditions that can occur when matching a @@ -478,16 +559,18 @@ data ReplProblem type ReplTargetProblem = TargetProblem ReplProblem matchesMultipleProblem - :: TargetSelector + :: MultiReplDecision + -> TargetSelector -> [AvailableTarget ()] -> ReplTargetProblem -matchesMultipleProblem targetSelector targetsExesBuildable = - CustomTargetProblem $ TargetProblemMatchesMultiple targetSelector targetsExesBuildable +matchesMultipleProblem decision targetSelector targetsExesBuildable = + CustomTargetProblem $ TargetProblemMatchesMultiple decision targetSelector targetsExesBuildable multipleTargetsProblem - :: TargetsMap + :: MultiReplDecision + -> TargetsMap -> ReplTargetProblem -multipleTargetsProblem = CustomTargetProblem . TargetProblemMultipleTargets +multipleTargetsProblem decision = CustomTargetProblem . TargetProblemMultipleTargets decision reportTargetProblems :: Verbosity -> [TargetProblem ReplProblem] -> IO a reportTargetProblems verbosity = @@ -497,7 +580,7 @@ renderReplTargetProblem :: TargetProblem ReplProblem -> String renderReplTargetProblem = renderTargetProblem "open a repl for" renderReplProblem renderReplProblem :: ReplProblem -> String -renderReplProblem (TargetProblemMatchesMultiple targetSelector targets) = +renderReplProblem (TargetProblemMatchesMultiple decision targetSelector targets) = "Cannot open a repl for multiple components at once. The target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ " which " @@ -512,24 +595,49 @@ renderReplProblem (TargetProblemMatchesMultiple targetSelector targets) = ] | (ckind, ts) <- sortGroupOn availableTargetComponentKind targets ] - ++ ".\n\n" ++ explanationSingleComponentLimitation + ++ ".\n\n" ++ explainMultiReplDecision decision where availableTargetComponentKind = componentKind . availableTargetComponentName -renderReplProblem (TargetProblemMultipleTargets selectorMap) = +renderReplProblem (TargetProblemMultipleTargets multi_decision selectorMap) = "Cannot open a repl for multiple components at once. The targets " ++ renderListCommaAnd [ "'" ++ showTargetSelector ts ++ "'" | ts <- uniqueTargetSelectors selectorMap ] ++ " refer to different components." - ++ ".\n\n" ++ explanationSingleComponentLimitation - -explanationSingleComponentLimitation :: String -explanationSingleComponentLimitation = - "The reason for this limitation is that current versions of ghci do not " + ++ ".\n\n" ++ explainMultiReplDecision multi_decision + +explainMultiReplDecision :: MultiReplDecision -> [Char] +explainMultiReplDecision MultiReplDecision{compilerVersion, enabledByFlag} = + case (compilerVersion >= Just minMultipleHomeUnitsVersion, enabledByFlag) of + -- Compiler not new enough, and not requested anyway. + (False, False) -> explanationSingleComponentLimitation compilerVersion + -- Compiler too old, but was requested + (False, True) -> "Multiple component session requested but compiler version is too old.\n" ++ explanationSingleComponentLimitation compilerVersion + -- Compiler new enough, but not requested + (True, False) -> explanationNeedToEnableFlag + _ -> error "explainMultiReplDecision" + +explanationNeedToEnableFlag :: String +explanationNeedToEnableFlag = + "Your compiler supports a multiple component repl but support is not enabled.\n" ++ + "The experimental multi repl can be enabled by\n" ++ + " * Globally: Setting multi-repl: True in your .cabal/config\n" ++ + " * Project Wide: Setting multi-repl: True in your cabal.project file\n" ++ + " * Per Invocation: By passsing --enable-multi-repl when starting the repl" + + +explanationSingleComponentLimitation :: Maybe Version -> String +explanationSingleComponentLimitation version = + "The reason for this limitation is that your version " ++ versionString ++ "of ghci does not " ++ "support loading multiple components as source. Load just one component " - ++ "and when you make changes to a dependent component then quit and reload." + ++ "and when you make changes to a dependent component then quit and reload.\n" + ++ prettyShow minMultipleHomeUnitsVersion ++ " is needed to support multiple component sessions." + where + versionString = case version of + Nothing -> "" + Just ver -> "(" ++ prettyShow ver ++ ") " -- Lenses lElaboratedShared :: Lens' ProjectBuildContext ElaboratedSharedConfig diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 023d6a6fdbc..013c43a7354 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -144,6 +144,7 @@ import Distribution.Compat.Environment ( getEnvironment ) import qualified Data.Map as M import qualified Data.ByteString as BS +import Distribution.Client.ReplFlags -- -- * Configuration saved in the config file @@ -164,6 +165,7 @@ data SavedConfig = SavedConfig , savedTestFlags :: TestFlags , savedBenchmarkFlags :: BenchmarkFlags , savedProjectFlags :: ProjectFlags + , savedReplMulti :: Flag Bool } deriving Generic instance Monoid SavedConfig where @@ -185,7 +187,8 @@ instance Semigroup SavedConfig where savedHaddockFlags = combinedSavedHaddockFlags, savedTestFlags = combinedSavedTestFlags, savedBenchmarkFlags = combinedSavedBenchmarkFlags, - savedProjectFlags = combinedSavedProjectFlags + savedProjectFlags = combinedSavedProjectFlags, + savedReplMulti = combinedSavedReplMulti } where -- This is ugly, but necessary. If we're mappending two config files, we @@ -524,6 +527,8 @@ instance Semigroup SavedConfig where combine = combine' savedBenchmarkFlags lastNonEmpty = lastNonEmpty' savedBenchmarkFlags + combinedSavedReplMulti = combine' savedReplMulti id + combinedSavedProjectFlags = ProjectFlags { flagProjectFileName = combine flagProjectFileName , flagIgnoreProject = combine flagIgnoreProject @@ -1056,6 +1061,10 @@ configFieldDescriptions src = -- share the options or make then distinct. In any case -- they should probably be per-server. + ++ toSavedConfig liftReplFlag + [multiReplOption] + [] [] + ++ [ viewAsFieldDescr $ optionDistPref (configDistPref . savedConfigureFlags) @@ -1070,6 +1079,7 @@ configFieldDescriptions src = ParseArgs ] + where toSavedConfig lift options exclusions replacements = [ lift (fromMaybe field replacement) @@ -1167,6 +1177,10 @@ liftReportFlag :: FieldDescr ReportFlags -> FieldDescr SavedConfig liftReportFlag = liftField savedReportFlags (\flags conf -> conf { savedReportFlags = flags }) +liftReplFlag :: FieldDescr (Flag Bool) -> FieldDescr SavedConfig +liftReplFlag = liftField + savedReplMulti (\flags conf -> conf { savedReplMulti = flags }) + parseConfig :: ConstraintSource -> SavedConfig -> BS.ByteString diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index 554785ff847..9347791a857 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -51,6 +51,7 @@ import Distribution.Solver.Types.PackageIndex import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, readPkgConfigDb) import Distribution.Solver.Types.SourcePackage +import Distribution.Types.GivenComponent import Distribution.Simple.Compiler ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack ) @@ -65,8 +66,6 @@ import Distribution.Simple.PackageIndex as PackageIndex ( InstalledPackageIndex, lookupPackageName ) import Distribution.Package ( Package(..), packageName, PackageId ) -import Distribution.Types.GivenComponent - ( GivenComponent(..) ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint(..), thisPackageVersionConstraint ) import qualified Distribution.PackageDescription as PkgDesc @@ -407,7 +406,7 @@ configurePackage verbosity platform comp scriptOptions configFlags configConstraints = [ thisPackageVersionConstraint srcid | ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) _uid <- CD.nonSetupDeps deps ], - configDependencies = [ GivenComponent (packageName srcid) cname uid + configDependencies = [ GivenComponent (packageName srcid) cname uid IsExternal | ConfiguredId srcid (Just (PkgDesc.CLibName cname)) uid <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index a53c7ded1aa..f4f22e69032 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -128,8 +128,6 @@ import Distribution.Package ( PackageIdentifier(..), PackageId, packageName, packageVersion , Package(..), HasMungedPackageId(..), HasUnitId(..) , UnitId ) -import Distribution.Types.GivenComponent - ( GivenComponent(..) ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint(..), thisPackageVersionConstraint ) import Distribution.Types.MungedPackageId @@ -157,6 +155,8 @@ import Distribution.Simple.BuildPaths ( exeExtension ) import qualified Data.ByteString as BS +import Distribution.Types.GivenComponent + --TODO: -- * assign flags to packages individually -- * complain about flags that do not apply to any package given as target @@ -1189,7 +1189,7 @@ installReadyPackage platform cinfo configFlags PackageDescription.LMainLibName)) _ipid <- CD.nonSetupDeps deps ], - configDependencies = [ GivenComponent (packageName srcid) cname dep_ipid + configDependencies = [ GivenComponent (packageName srcid) cname dep_ipid IsExternal | ConfiguredId srcid (Just (PackageDescription.CLibName cname)) dep_ipid <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. diff --git a/cabal-install/src/Distribution/Client/InstallPlan.hs b/cabal-install/src/Distribution/Client/InstallPlan.hs index 9b8fa6cba0c..f943e41d241 100644 --- a/cabal-install/src/Distribution/Client/InstallPlan.hs +++ b/cabal-install/src/Distribution/Client/InstallPlan.hs @@ -59,7 +59,10 @@ module Distribution.Client.InstallPlan ( -- * Display showPlanGraph, + ShowPlanNode(..), showInstallPlan, + showInstallPlan_gen, + showPlanPackageTag, -- * Graph-like operations dependencyClosure, @@ -278,21 +281,31 @@ instance (IsNode ipkg, Key ipkg ~ UnitId, IsNode srcpkg, Key srcpkg ~ UnitId, indepGoals <- get return $! mkInstallPlan "(instance Binary)" graph indepGoals -showPlanGraph :: (Package ipkg, Package srcpkg, - IsUnit ipkg, IsUnit srcpkg) - => Graph (GenericPlanPackage ipkg srcpkg) -> String + +data ShowPlanNode = ShowPlanNode { showPlanHerald :: Doc + , showPlanNeighbours :: [Doc] + } + +showPlanGraph :: [ShowPlanNode] -> String showPlanGraph graph = renderStyle defaultStyle $ - vcat (map dispPlanPackage (Foldable.toList graph)) - where dispPlanPackage p = - hang (hsep [ text (showPlanPackageTag p) - , pretty (packageId p) - , parens (pretty (nodeKey p))]) 2 - (vcat (map pretty (nodeNeighbors p))) - -showInstallPlan :: (Package ipkg, Package srcpkg, - IsUnit ipkg, IsUnit srcpkg) + vcat (map dispPlanPackage graph) + where dispPlanPackage (ShowPlanNode herald neighbours) = + hang herald 2 (vcat neighbours) + +-- | Generic way to show a 'GenericInstallPlan' which elicits quite a lot of information +showInstallPlan_gen :: forall ipkg srcpkg . + (GenericPlanPackage ipkg srcpkg -> ShowPlanNode) -> GenericInstallPlan ipkg srcpkg -> String +showInstallPlan_gen toShow = showPlanGraph . fmap toShow . Foldable.toList . planGraph + +showInstallPlan :: forall ipkg srcpkg . (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String -showInstallPlan = showPlanGraph . planGraph +showInstallPlan = showInstallPlan_gen toShow + where + toShow :: GenericPlanPackage ipkg srcpkg -> ShowPlanNode + toShow p = ShowPlanNode (hsep [ text (showPlanPackageTag p) + , pretty (packageId p) + , parens (pretty (nodeKey p))]) + (map pretty (nodeNeighbors p)) showPlanPackageTag :: GenericPlanPackage ipkg srcpkg -> String showPlanPackageTag (PreExisting _) = "PreExisting" diff --git a/cabal-install/src/Distribution/Client/ParseUtils.hs b/cabal-install/src/Distribution/Client/ParseUtils.hs index 0b8e45c5641..4694ee7e03d 100644 --- a/cabal-install/src/Distribution/Client/ParseUtils.hs +++ b/cabal-install/src/Distribution/Client/ParseUtils.hs @@ -239,7 +239,7 @@ parseFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs = Just (FieldDescr _ _ set) -> set line value a Nothing -> do warning $ "Unrecognized field '" ++ name - ++ "' on line " ++ show line + ++ "' on line " ++ show line ++ show (Map.keys fieldMap) return a setField a (Section line name param fields) = diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index fca3bef09e8..fcb0614e90a 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -223,7 +223,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} shared = dryRunTarballPkg pkg depsBuildStatus tarball = case elabBuildStyle pkg of BuildAndInstall -> return (BuildStatusUnpack tarball) - BuildInplaceOnly -> do + BuildInplaceOnly {} -> do -- TODO: [nice to have] use a proper file monitor rather -- than this dir exists test exists <- doesDirectoryExist srcdir @@ -392,7 +392,7 @@ packageFileMonitorKeyValues elab = elabBuildTargets = [], elabTestTargets = [], elabBenchTargets = [], - elabReplTarget = Nothing, + elabReplTarget = [], elabHaddockTargets = [], elabBuildHaddocks = False, @@ -609,11 +609,14 @@ rebuildTargets verbosity (BuildFailure Nothing . DependentFailed . packageId) installPlan $ \pkg -> --TODO: review exception handling - handle (\(e :: BuildFailure) -> return (Left e)) $ fmap Right $ + handle (\(e :: BuildFailure) -> return (Left e)) $ fmap Right $ do let uid = installedUnitId pkg - pkgBuildStatus = Map.findWithDefault (error "rebuildTargets") uid pkgsBuildStatus in + pkgBuildStatus = Map.findWithDefault (error "rebuildTargets") uid pkgsBuildStatus +-- traceShowM ("### build plan") +-- traceM $ showInstallPlan installPlan +-- traceShowM ("### pkg", pkg) rebuildTarget verbosity distDirLayout @@ -720,7 +723,7 @@ rebuildTarget verbosity case elabBuildStyle pkg of BuildAndInstall -> buildAndInstall - BuildInplaceOnly -> buildInplace buildStatus + BuildInplaceOnly {} -> buildInplace buildStatus where buildStatus = BuildStatusConfigure MonitorFirstRun @@ -730,7 +733,7 @@ rebuildTarget verbosity -- rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult rebuildPhase buildStatus srcdir = - assert (elabBuildStyle pkg == BuildInplaceOnly) $ + assert (isInplaceBuildStyle $ elabBuildStyle pkg) buildInplace buildStatus srcdir builddir where @@ -864,7 +867,7 @@ withTarballLocalDirectory verbosity distDirLayout@DistDirLayout{..} -- In this case we make sure the tarball has been unpacked to the -- appropriate location under the shared dist dir, and then build it -- inplace there - BuildInplaceOnly -> do + BuildInplaceOnly {} -> do let srcrootdir = distUnpackedSrcRootDirectory srcdir = distUnpackedSrcDirectory pkgid builddir = distBuildDirectory dparams @@ -1204,7 +1207,7 @@ hasValidHaddockTargets ElaboratedConfiguredPackage{..} where components :: [ComponentTarget] components = elabBuildTargets ++ elabTestTargets ++ elabBenchTargets - ++ maybeToList elabReplTarget ++ elabHaddockTargets + ++ elabReplTarget ++ elabHaddockTargets componentHasHaddocks :: ComponentTarget -> Bool componentHasHaddocks (ComponentTarget name _) = @@ -1338,9 +1341,10 @@ buildInplaceUnpackedPackage verbosity -- Repl phase -- - whenRepl $ + whenRepl $ do + --traceM ("repl: **** " ++ show (elabReplTarget pkg, replFlags undefined, replArgs undefined)) annotateFailureNoLog ReplFailed $ - setupInteractive replCommand replFlags replArgs + setupInteractive replCommand replFlags replArgs -- Haddock phase whenHaddock $ @@ -1400,8 +1404,8 @@ buildInplaceUnpackedPackage verbosity | otherwise = action whenRepl action - | isNothing (elabReplTarget pkg) = return () - | otherwise = action + | null (elabReplTarget pkg) = return () + | otherwise = action whenHaddock action | hasValidHaddockTargets pkg = action diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 7ed747fa98e..d2d659e179d 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -119,6 +119,7 @@ import Distribution.Fields.ConfVar (parseConditionConfVarFromClause) import Distribution.Client.HttpUtils import System.FilePath ((), isPathSeparator, makeValid, isAbsolute, takeDirectory) import System.Directory (createDirectoryIfMissing) +import Distribution.Client.ReplFlags ( multiReplOption ) @@ -293,7 +294,8 @@ data LegacySharedConfig = LegacySharedConfig { legacyConfigureExFlags :: ConfigExFlags, legacyInstallFlags :: InstallFlags, legacyClientInstallFlags:: ClientInstallFlags, - legacyProjectFlags :: ProjectFlags + legacyProjectFlags :: ProjectFlags, + legacyMultiRepl :: Flag Bool } deriving (Show, Generic) instance Monoid LegacySharedConfig where @@ -327,7 +329,7 @@ commandLineFlagsToProjectConfig globalFlags NixStyleFlags {..} clientInstallFlag haddockFlags testFlags benchmarkFlags, projectConfigShared = convertLegacyAllPackageFlags globalFlags configFlags - configExFlags installFlags projectFlags, + configExFlags installFlags projectFlags NoFlag, projectConfigLocalPackages = localConfig, projectConfigAllPackages = allConfig } @@ -389,7 +391,8 @@ convertLegacyGlobalConfig savedHaddockFlags = haddockFlags, savedTestFlags = testFlags, savedBenchmarkFlags = benchmarkFlags, - savedProjectFlags = projectFlags + savedProjectFlags = projectFlags, + savedReplMulti = replMulti } = mempty { projectConfigBuildOnly = configBuildOnly, @@ -412,7 +415,7 @@ convertLegacyGlobalConfig haddockFlags' testFlags' benchmarkFlags' configShared = convertLegacyAllPackageFlags globalFlags configFlags - configExFlags' installFlags' projectFlags' + configExFlags' installFlags' projectFlags' replMulti configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configFlags installFlags' clientInstallFlags' @@ -432,7 +435,7 @@ convertLegacyProjectConfig legacyPackagesNamed, legacySharedConfig = LegacySharedConfig globalFlags configShFlags configExFlags installSharedFlags - clientInstallFlags projectFlags, + clientInstallFlags projectFlags multiRepl, legacyAllConfig, legacyLocalConfig = LegacyPackageConfig configFlags installPerPkgFlags haddockFlags testFlags benchmarkFlags, @@ -460,7 +463,7 @@ convertLegacyProjectConfig testFlags benchmarkFlags configPackagesShared= convertLegacyAllPackageFlags globalFlags (configFlags <> configShFlags) - configExFlags installSharedFlags projectFlags + configExFlags installSharedFlags projectFlags multiRepl configBuildOnly = convertLegacyBuildOnlyFlags globalFlags configShFlags installSharedFlags clientInstallFlags @@ -483,8 +486,9 @@ convertLegacyAllPackageFlags -> ConfigExFlags -> InstallFlags -> ProjectFlags + -> Flag Bool -> ProjectConfigShared -convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags = +convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags projectFlags projectConfigMultiRepl = ProjectConfigShared{..} where GlobalFlags { @@ -724,6 +728,7 @@ convertToLegacySharedConfig , legacyInstallFlags = installFlags , legacyClientInstallFlags = projectConfigClientInstallFlags , legacyProjectFlags = projectFlags + , legacyMultiRepl = projectConfigMultiRepl } where globalFlags = GlobalFlags { @@ -1211,6 +1216,8 @@ legacySharedConfigFieldDescrs constraintSrc = concat . commandOptionsToFields $ projectFlagsOptions ParseArgs + , [ liftField legacyMultiRepl (\flags conf -> conf { legacyMultiRepl = flags }) (commandOptionToField multiReplOption) ] + ] diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index be3aae9bd5c..b8c35dd8c0d 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -204,7 +204,9 @@ data ProjectConfigShared projectConfigIndependentGoals :: Flag IndependentGoals, projectConfigPreferOldest :: Flag PreferOldest, - projectConfigProgPathExtra :: NubList FilePath + projectConfigProgPathExtra :: NubList FilePath, + + projectConfigMultiRepl :: Flag Bool -- More things that only make sense for manual mode, not --local mode -- too much control! diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index da67b8a3ef4..0282f58456a 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -904,6 +904,9 @@ printPlan verbosity , if verbosity >= deafening then prettyShow (installedUnitId elab) else prettyShow (packageId elab) + , case elabBuildStyle elab of + BuildInplaceOnly InMemory -> "(MEM)" + _ -> "" , case elabPkgOrComp elab of ElabPackage pkg -> showTargets elab ++ ifVerbose (showStanzas (pkgStanzasEnabled pkg)) ElabComponent comp -> @@ -1049,7 +1052,7 @@ writeBuildReports settings buildContext plan buildOutcomes = do TestsNotTried -> BuildReports.NotTried TestsOk -> BuildReports.Ok - in Just $ (BuildReports.BuildReport (packageId pkg) os arch (compilerId comp) cabalInstallID (elabFlagAssignment pkg) (map packageId $ elabLibDependencies pkg) installOutcome docsOutcome testsOutcome, getRepo . elabPkgSourceLocation $ pkg) -- TODO handle failure log files? + in Just $ (BuildReports.BuildReport (packageId pkg) os arch (compilerId comp) cabalInstallID (elabFlagAssignment pkg) (map (packageId . fst) $ elabLibDependencies pkg) installOutcome docsOutcome testsOutcome, getRepo . elabPkgSourceLocation $ pkg) -- TODO handle failure log files? fromPlanPackage _ _ = Nothing buildReports = mapMaybe (\x -> fromPlanPackage x (InstallPlan.lookupBuildOutcome x buildOutcomes)) $ InstallPlan.toList plan diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs index fde7ea8b97a..16c42dad431 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs @@ -152,7 +152,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = [ "pkg-src-sha256" J..= J.String (showHashValue hash) | Just hash <- [elabPkgSourceHash elab] ] ++ (case elabBuildStyle elab of - BuildInplaceOnly -> + BuildInplaceOnly {} -> ["dist-dir" J..= J.String dist_dir] ++ [buildInfoFileLocation] BuildAndInstall -> -- TODO: install dirs? @@ -162,7 +162,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = ElabPackage pkg -> let components = J.object $ [ comp2str c J..= (J.object $ - [ "depends" J..= map (jdisplay . confInstId) ldeps + [ "depends" J..= map (jdisplay . confInstId) (map fst ldeps) , "exe-depends" J..= map (jdisplay . confInstId) edeps ] ++ bin_file c) @@ -172,7 +172,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = (pkgExeDependencies pkg) ] in ["components" J..= components] ElabComponent comp -> - ["depends" J..= map (jdisplay . confInstId) (elabLibDependencies elab) + ["depends" J..= map (jdisplay . confInstId) (map fst $ elabLibDependencies elab) ,"exe-depends" J..= map jdisplay (elabExeDependencies elab) ,"component-name" J..= J.String (comp2str (compSolverName comp)) ] ++ @@ -256,7 +256,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = bin_file' s = ["bin-file" J..= J.String bin] where - bin = if elabBuildStyle elab == BuildInplaceOnly + bin = if isInplaceBuildStyle (elabBuildStyle elab) then dist_dir "build" prettyShow s prettyShow s <.> exeExtension plat else InstallDirs.bindir (elabInstallDirs elab) prettyShow s <.> exeExtension plat @@ -264,7 +264,7 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = flib_file' s = ["bin-file" J..= J.String bin] where - bin = if elabBuildStyle elab == BuildInplaceOnly + bin = if isInplaceBuildStyle (elabBuildStyle elab) then dist_dir "build" prettyShow s ("lib" ++ prettyShow s) <.> dllExtension plat else InstallDirs.bindir (elabInstallDirs elab) ("lib" ++ prettyShow s) <.> dllExtension plat @@ -274,7 +274,8 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = style2str :: Bool -> BuildStyle -> String style2str _ BuildAndInstall = "global" style2str True _ = "local" - style2str False BuildInplaceOnly = "inplace" + style2str False (BuildInplaceOnly OnDisk) = "inplace" + style2str False (BuildInplaceOnly InMemory) = "memory" jdisplay :: Pretty a => a -> J.Value jdisplay = J.String . prettyShow @@ -601,7 +602,7 @@ postBuildProjectStatus plan previousPackagesUpToDate ] elabLibDeps :: ElaboratedConfiguredPackage -> [UnitId] - elabLibDeps = map (newSimpleUnitId . confInstId) . elabLibDependencies + elabLibDeps = map (newSimpleUnitId . confInstId) . map fst . elabLibDependencies -- Was a build was attempted for this package? -- If it doesn't have both a build status and outcome then the answer is no. @@ -640,8 +641,8 @@ postBuildProjectStatus plan previousPackagesUpToDate case pkg of InstallPlan.PreExisting _ -> False InstallPlan.Installed _ -> False - InstallPlan.Configured srcpkg -> elabBuildStyle srcpkg - == BuildInplaceOnly + InstallPlan.Configured srcpkg -> isInplaceBuildStyle (elabBuildStyle srcpkg) + packagesAlreadyInStore :: Set UnitId packagesAlreadyInStore = selectPlanPackageIdSet $ \pkg -> @@ -947,7 +948,7 @@ selectGhcEnvironmentFilePackageDbs elaboratedInstallPlan = inplacePackages = [ srcpkg | srcpkg <- sourcePackages - , elabBuildStyle srcpkg == BuildInplaceOnly ] + , isInplaceBuildStyle (elabBuildStyle srcpkg) ] sourcePackages :: [ElaboratedConfiguredPackage] sourcePackages = diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 4ec141037b7..9798561f387 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -124,8 +124,9 @@ import Distribution.Types.ComponentName import Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) ) import Distribution.Types.LibraryName -import Distribution.Types.GivenComponent - (GivenComponent(..)) +import Distribution.Types.GivenComponent + ( GivenComponent(GivenComponent), + IsInternal(IsExternal, IsInternal) ) import Distribution.Types.PackageVersionConstraint import Distribution.Types.PkgconfigDependency import Distribution.Types.UnqualComponentName @@ -177,6 +178,7 @@ import Control.Exception (assert) import Data.List (groupBy, deleteBy) import qualified Data.List.NonEmpty as NE import System.FilePath +import GHC.Stack ------------------------------------------------------------------------------ -- * Elaborated install plan @@ -245,7 +247,7 @@ sanityCheckElaboratedConfiguredPackage sharedConfig -- 'installedPackageId' we assigned is consistent with -- the 'hashedInstalledPackageId' we would compute from -- the elaborated configured package - . assert (elabBuildStyle == BuildInplaceOnly || + . assert ((isInplaceBuildStyle elabBuildStyle) || elabComponentId == hashedInstalledPackageId (packageHashInputs sharedConfig elab)) @@ -256,7 +258,7 @@ sanityCheckElaboratedConfiguredPackage sharedConfig -- either a package is built inplace, or we are not attempting to -- build any test suites or benchmarks (we never build these -- for remote packages!) - . assert (elabBuildStyle == BuildInplaceOnly || + . assert (isInplaceBuildStyle elabBuildStyle || optStanzaSetNull elabStanzasAvailable) sanityCheckElaboratedComponent @@ -268,7 +270,7 @@ sanityCheckElaboratedComponent ElaboratedConfiguredPackage{..} ElaboratedComponent{..} = -- Should not be building bench or test if not inplace. - assert (elabBuildStyle == BuildInplaceOnly || + assert (isInplaceBuildStyle elabBuildStyle || case compComponentName of Nothing -> True Just (CLibName _) -> True @@ -709,7 +711,7 @@ rebuildInstallPlan verbosity installDirs elaboratedShared elaboratedPlan - liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan) + liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan instantiatedPlan) return (instantiatedPlan, elaboratedShared) where withRepoCtx = projectConfigWithSolverRepoContext verbosity @@ -751,7 +753,7 @@ rebuildInstallPlan verbosity let improvedPlan = improveInstallPlanWithInstalledPackages storePkgIdSet elaboratedPlan - liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan) + liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan improvedPlan) -- TODO: [nice to have] having checked which packages from the store -- we're using, it may be sensible to sanity check those packages -- by loading up the compiler package db and checking everything @@ -1529,7 +1531,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB compComponentName = Nothing dep_pkgs = elaborateLibSolverId mapDep =<< CD.setupDeps deps0 compLibDependencies - = map configuredId dep_pkgs + -- MP: No idea what this function does + = map (\cid -> (configuredId cid, False)) dep_pkgs compLinkedLibDependencies = notImpl "compLinkedLibDependencies" compOrderLibDependencies = notImpl "compOrderLibDependencies" -- Not supported: @@ -1564,11 +1567,13 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB (Map.unionWith Map.union external_exe_cc_map cc_map) comp - + let do_ cid = + let cid' = (annotatedIdToConfiguredId . ci_ann_id $ cid) + in (cid', False) -- filled in later) -- 2. Read out the dependencies from the ConfiguredComponent cc0 let compLibDependencies = -- Nub because includes can show up multiple times - ordNub (map (annotatedIdToConfiguredId . ci_ann_id) + ordNub (map (\cid -> do_ cid ) (cc_includes cc0)) compExeDependencies = map annotatedIdToConfiguredId @@ -1587,7 +1592,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabPkgOrComp = ElabComponent $ elab_comp } cid = case elabBuildStyle elab0 of - BuildInplaceOnly -> + BuildInplaceOnly {} -> mkComponentId $ prettyShow pkgid ++ "-inplace" ++ (case Cabal.componentNameString cname of @@ -1606,7 +1611,9 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB case Map.lookup (unDefUnitId def_uid) preexistingInstantiatedPkgs of Just full -> full Nothing -> error ("lookup_uid: " ++ prettyShow def_uid) - lc <- toLinkedComponent verbosity lookup_uid (elabPkgSourceId elab0) + -- MP: Think False here is correct? It dictates whether we have any promised + -- packages on the go or not. + lc <- toLinkedComponent verbosity False lookup_uid (elabPkgSourceId elab0) (Map.union external_lc_map lc_map) cc infoProgress $ dispLinkedComponent lc -- NB: elab is setup to be the correct form for an @@ -1787,7 +1794,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB filterExt' = filter (isExt . fst) pkgLibDependencies - = buildComponentDeps (filterExt . compLibDependencies) + = buildComponentDeps (filterExt' . compLibDependencies) pkgExeDependencies = buildComponentDeps (filterExt . compExeDependencies) pkgExeDependencyPaths @@ -1883,7 +1890,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBuildTargets = [] elabTestTargets = [] elabBenchTargets = [] - elabReplTarget = Nothing + elabReplTarget = [] elabHaddockTargets = [] elabBuildHaddocks = @@ -1892,8 +1899,12 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabPkgSourceLocation = srcloc elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes elabLocalToProject = isLocalToProject pkg + -- MP: HERE, this is an overapproximation currently (all local packages are intenral) but we need + -- to check the requested targets. + -- This is overwritten later in CmdRepl + --elabIsInternalPackage = IsExternal elabBuildStyle = if shouldBuildInplaceOnly pkg - then BuildInplaceOnly else BuildAndInstall + then BuildInplaceOnly OnDisk else BuildAndInstall elabPackageDbs = projectConfigPackageDBs sharedPackageConfig elabBuildPackageDBStack = buildAndRegisterDbs elabRegisterPackageDBStack = buildAndRegisterDbs @@ -2244,7 +2255,7 @@ binDirectories layout config package = case elabBuildStyle package of -- to put any executables in it, that will just clog up the PATH _ | noExecutables -> [] BuildAndInstall -> [installedBinDirectory package] - BuildInplaceOnly -> map (root) $ case elabPkgOrComp package of + BuildInplaceOnly {} -> map (root) $ case elabPkgOrComp package of ElabComponent comp -> case compSolverName comp of CD.ComponentExe n -> [prettyShow n] _ -> [] @@ -2469,9 +2480,9 @@ instantiateInstallPlan storeDirLayout defaultInstallDirs elaboratedShared plan = | otherwise = error ("indefiniteComponent: " ++ prettyShow cid) fixupBuildStyle BuildAndInstall elab = elab - fixupBuildStyle _ (elab@ElaboratedConfiguredPackage { elabBuildStyle = BuildInplaceOnly }) = elab - fixupBuildStyle BuildInplaceOnly elab = elab { - elabBuildStyle = BuildInplaceOnly, + fixupBuildStyle _ (elab@ElaboratedConfiguredPackage { elabBuildStyle = BuildInplaceOnly {} }) = elab + fixupBuildStyle t@(BuildInplaceOnly {}) elab = elab { + elabBuildStyle = t, elabBuildPackageDBStack = elabInplaceBuildPackageDBStack elab, elabRegisterPackageDBStack = elabInplaceRegisterPackageDBStack elab, elabSetupPackageDBStack = elabInplaceSetupPackageDBStack elab @@ -2757,7 +2768,7 @@ nubComponentTargets = pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool pkgHasEphemeralBuildTargets elab = - isJust (elabReplTarget elab) + (not . null) (elabReplTarget elab) || (not . null) (elabTestTargets elab) || (not . null) (elabBenchTargets elab) || (not . null) (elabHaddockTargets elab) @@ -2861,13 +2872,12 @@ setRootTargets targetAction perPkgTargetsMap = (Just tgts, TargetActionBuild) -> elab { elabBuildTargets = tgts } (Just tgts, TargetActionTest) -> elab { elabTestTargets = tgts } (Just tgts, TargetActionBench) -> elab { elabBenchTargets = tgts } - (Just [tgt], TargetActionRepl) -> elab { elabReplTarget = Just tgt - , elabBuildHaddocks = False } + (Just tgts, TargetActionRepl) -> elab { elabReplTarget = tgts + , elabBuildHaddocks = False + , elabBuildStyle = BuildInplaceOnly InMemory } (Just tgts, TargetActionHaddock) -> foldr setElabHaddockTargets (elab { elabHaddockTargets = tgts , elabBuildHaddocks = True }) tgts - (Just _, TargetActionRepl) -> - error "pruneInstallPlanToTargets: multiple repl targets" setElabHaddockTargets tgt elab | isTestComponentTarget tgt = elab { elabHaddockTestSuites = True } @@ -2877,6 +2887,9 @@ setRootTargets targetAction perPkgTargetsMap = | isSubLibComponentTarget tgt = elab { elabHaddockInternal = True } | otherwise = elab +minVersionReplFlagFile :: Version +minVersionReplFlagFile = mkVersion [3,9] + -- | Assuming we have previously set the root build targets (i.e. the user -- targets but not rev deps yet), the first pruning pass does two things: -- @@ -2888,26 +2901,105 @@ setRootTargets targetAction perPkgTargetsMap = -- pruneInstallPlanPass1 :: [ElaboratedPlanPackage] -> [ElaboratedPlanPackage] -pruneInstallPlanPass1 pkgs = - map (mapConfiguredPackage fromPrunedPackage) - (fromMaybe [] $ Graph.closure graph roots) +pruneInstallPlanPass1 pkgs + -- if there are repl target, we need to do a bit more work + | anyReplTarget = final_final_graph + + -- otherwise we'll do less + | otherwise = pruned_packages where + pkgs' :: [InstallPlan.GenericPlanPackage IPI.InstalledPackageInfo PrunedPackage] pkgs' = map (mapConfiguredPackage prune) pkgs - graph = Graph.fromDistinctList pkgs' - roots = mapMaybe find_root pkgs' + prune :: ElaboratedConfiguredPackage -> PrunedPackage prune elab = PrunedPackage elab' (pruneOptionalDependencies elab') where elab' = setDocumentation $ addOptionalStanzas elab + graph = Graph.fromDistinctList pkgs' + + roots :: [UnitId] + roots = mapMaybe find_root pkgs' + + -- Make a closed graph by calculating the closure from the roots + pruned_packages :: [ElaboratedPlanPackage] + pruned_packages = map (mapConfiguredPackage fromPrunedPackage) (fromMaybe [] $ Graph.closure graph roots) + + closed_graph :: Graph.Graph ElaboratedPlanPackage + closed_graph = Graph.fromDistinctList pruned_packages + + -- whether any package has repl targets enabled. + anyReplTarget :: Bool + anyReplTarget = any is_repl_gpp pkgs' where + is_repl_gpp (InstallPlan.Configured pkg) = is_repl_pp pkg + is_repl_gpp _ = False + + is_repl_pp (PrunedPackage elab _) = not (null (elabReplTarget elab)) + + -- Anything which is inplace and left after pruning could be a repl target, then just need to check the + -- reverse closure after calculating roots to capture dependencies which are on the path between roots. + -- In order to start a multi-repl session with all the desired targets we need to load all these components into + -- the repl at once to satisfy the closure property. + all_desired_repl_targets = [cp | InstallPlan.Configured cp <- fromMaybe [] $ Graph.revClosure closed_graph roots] + + add_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage + add_repl_target ecp | ecp `elem` all_desired_repl_targets = ecp { elabReplTarget = maybeToList (ComponentTarget <$> (elabComponentName ecp) <*> pure WholeComponent) + , elabBuildStyle = BuildInplaceOnly InMemory } + | otherwise = ecp + + -- Add the repl target information to the ElaboratedPlanPackages + graph_with_repl_targets + | anyReplTarget = map (mapConfiguredPackage add_repl_target) (Graph.toList closed_graph) + | otherwise = Graph.toList closed_graph + + -- But check that all the InMemory targets have a new enough version of Cabal, + -- otherwise we will confuse Setup.hs by passing new arguments which it doesn't understand + -- later down the line. We try to remove just these edges, if it doesn't break the overall structure + -- then we just report to the user that their target will not be loaded for this reason. + + (bad -- Nodes which we wanted to build InMemory but lack new enough version of Cabal + , _good -- Nodes we want to build in memory. + ) = partitionEithers (map go graph_with_repl_targets) + where + go :: ElaboratedPlanPackage -> Either UnitId ElaboratedPlanPackage + go (InstallPlan.Configured cp) + | BuildInplaceOnly InMemory <- elabBuildStyle cp + , elabSetupScriptCliVersion cp < minVersionReplFlagFile = Left (elabUnitId cp) + go (InstallPlan.Configured c) = Right (InstallPlan.Configured c) + go c = Right c + + -- Now take the upwards closure from the bad nodes, and find the other `BuildInplaceOnly InMemory` packages that clobbers, + -- disables those and issue a warning to the user. Because we aren't going to be able to load those into memory as well + -- because the thing it depends on is not going to be in memory. + + disabled_repl_targets = + [ c | InstallPlan.Configured c <- fromMaybe [] $ Graph.revClosure (Graph.fromDistinctList graph_with_repl_targets) bad + , BuildInplaceOnly InMemory <- [elabBuildStyle c] ] + + remove_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage + remove_repl_target ecp | ecp `elem` disabled_repl_targets = ecp { elabReplTarget = [] + , elabBuildStyle = BuildInplaceOnly OnDisk } + | otherwise = ecp + + final_graph_with_repl_targets = {- traceShow (map elabUnitId disabled_repl_targets) $ -} map (mapConfiguredPackage remove_repl_target) graph_with_repl_targets + + -- Now find what the new roots are after we have disabled things which we can't build (and the things above that) + new_roots :: [UnitId] + new_roots = {- traceShowId -} (mapMaybe find_root (map (mapConfiguredPackage prune) final_graph_with_repl_targets)) + + -- Then take the final closure from these new roots to remove these things + -- TODO: Can probably just remove them directly in remove_repl_target. + final_final_graph = fromMaybe [] $ Graph.closure (Graph.fromDistinctList final_graph_with_repl_targets) new_roots + + is_root :: PrunedPackage -> Maybe UnitId is_root (PrunedPackage elab _) = if not $ and [ null (elabConfigureTargets elab) , null (elabBuildTargets elab) , null (elabTestTargets elab) , null (elabBenchTargets elab) - , isNothing (elabReplTarget elab) + , null (elabReplTarget elab) , null (elabHaddockTargets elab) ] then Just (installedUnitId elab) @@ -3005,7 +3097,7 @@ pruneInstallPlanPass1 pkgs = | ComponentTarget cname _ <- elabBuildTargets pkg ++ elabTestTargets pkg ++ elabBenchTargets pkg - ++ maybeToList (elabReplTarget pkg) + ++ elabReplTarget pkg ++ elabHaddockTargets pkg , stanza <- maybeToList $ componentOptionalStanza $ @@ -3077,6 +3169,7 @@ pruneInstallPlanPass2 pkgs = map (mapConfiguredPackage setStanzasDepsAndTargets) pkgs where setStanzasDepsAndTargets elab = + elab { elabBuildTargets = ordNub $ elabBuildTargets elab @@ -3090,18 +3183,25 @@ pruneInstallPlanPass2 pkgs = keepNeeded (CD.ComponentTest _) _ = TestStanzas `optStanzaSetMember` stanzas keepNeeded (CD.ComponentBench _) _ = BenchStanzas `optStanzaSetMember` stanzas keepNeeded _ _ = True + in ElabPackage $ pkg { pkgStanzasEnabled = stanzas, - pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg), + pkgLibDependencies = CD.mapDeps (\_ -> map addInternal) $ CD.filterDeps keepNeeded (pkgLibDependencies pkg), pkgExeDependencies = CD.filterDeps keepNeeded (pkgExeDependencies pkg), pkgExeDependencyPaths = CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg) } - r@(ElabComponent _) -> r + (ElabComponent comp) -> + ElabComponent $ comp { compLibDependencies = map addInternal (compLibDependencies comp) } } where + addInternal (cid, _) = (cid, (cid `Set.member` inMemoryTargets)) + libTargetsRequiredForRevDeps = - [ ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent + [ c | installedUnitId elab `Set.member` hasReverseLibDeps + , let c = ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent + -- Don't enable building for anything which s + , elabBuildStyle elab /= BuildInplaceOnly InMemory ] exeTargetsRequiredForRevDeps = -- TODO: allow requesting executable with different name @@ -3117,6 +3217,13 @@ pruneInstallPlanPass2 pkgs = availablePkgs :: Set UnitId availablePkgs = Set.fromList (map installedUnitId pkgs) + inMemoryTargets :: Set ConfiguredId + inMemoryTargets = do + Set.fromList [ configuredId pkg + | InstallPlan.Configured pkg <- pkgs + , BuildInplaceOnly InMemory <- [elabBuildStyle pkg] ] + + hasReverseLibDeps :: Set UnitId hasReverseLibDeps = Set.fromList [ depid @@ -3417,7 +3524,7 @@ setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..}) usePackageDB = elabSetupPackageDBStack, usePackageIndex = Nothing, useDependencies = [ (uid, srcid) - | ConfiguredId srcid (Just (CLibName LMainLibName)) uid + | (ConfiguredId srcid (Just (CLibName LMainLibName)) uid, _) <- elabSetupDependencies elab ], useDependenciesExclusive = True, useVersionMacros = elabSetupScriptStyle == SetupCustomExplicitDeps, @@ -3493,7 +3600,7 @@ computeInstallDirs :: StoreDirLayout -> ElaboratedConfiguredPackage -> InstallDirs.InstallDirs FilePath computeInstallDirs storeDirLayout defaultInstallDirs elaboratedShared elab - | elabBuildStyle elab == BuildInplaceOnly + | isInplaceBuildStyle (elabBuildStyle elab) -- use the ordinary default install dirs = (InstallDirs.absoluteInstallDirs (elabPkgSourceId elab) @@ -3617,11 +3724,13 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) -- NB: This does NOT use InstallPlan.depends, which includes executable -- dependencies which should NOT be fed in here (also you don't have -- enough info anyway) + -- MP: This is the important place configDependencies = [ GivenComponent (packageName srcid) ln cid - | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab + (if is_internal then IsInternal else IsExternal) + | (ConfiguredId srcid mb_cn cid, is_internal) <- elabLibDependencies elab , let ln = case mb_cn of Just (CLibName lname) -> lname Just _ -> error "non-library dependency" @@ -3631,7 +3740,7 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) case elabPkgOrComp of ElabPackage _ -> [ thisPackageVersionConstraint srcid - | ConfiguredId srcid _ _uid <- elabLibDependencies elab ] + | (ConfiguredId srcid _ _uid, _) <- elabLibDependencies elab ] ElabComponent _ -> [] @@ -3749,8 +3858,8 @@ setupHsReplFlags _ sharedConfig verbosity builddir = setupHsReplArgs :: ElaboratedConfiguredPackage -> [String] setupHsReplArgs elab = - maybe [] (\t -> [showComponentTarget (packageId elab) t]) (elabReplTarget elab) - --TODO: should be able to give multiple modules in one component + map (\t -> showComponentTarget (packageId elab) t) (elabReplTarget elab) + --TODO: should be able to give multiple modules in one component wz1000 setupHsCopyFlags :: ElaboratedConfiguredPackage @@ -3781,8 +3890,8 @@ setupHsRegisterFlags ElaboratedConfiguredPackage{..} _ regGenScript = mempty, -- never use regGenPkgConf = toFlag (Just pkgConfFile), regInPlace = case elabBuildStyle of - BuildInplaceOnly -> toFlag True - _ -> toFlag False, + BuildInplaceOnly {} -> toFlag True + BuildAndInstall -> toFlag False, regPrintId = mempty, -- never use regDistPref = toFlag builddir, regArgs = [], @@ -3885,7 +3994,7 @@ setupHsTestFlags _ _ verbosity builddir = -- TODO: [required eventually] for safety of concurrent installs, we must make sure we register but -- not replace installed packages with ghc-pkg. -packageHashInputs :: ElaboratedSharedConfig +packageHashInputs :: HasCallStack => ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> PackageHashInputs packageHashInputs @@ -3906,11 +4015,11 @@ packageHashInputs ElabPackage (ElaboratedPackage{..}) -> Set.fromList $ [ confInstId dep - | dep <- CD.select relevantDeps pkgLibDependencies ] ++ + | (dep, _) <- CD.select relevantDeps pkgLibDependencies ] ++ [ confInstId dep | dep <- CD.select relevantDeps pkgExeDependencies ] ElabComponent comp -> - Set.fromList (map confInstId (compLibDependencies comp + Set.fromList (map confInstId ((map fst $ compLibDependencies comp) ++ compExeDependencies comp)), pkgHashOtherConfig = packageHashConfigInputs pkgshared elab } @@ -4023,7 +4132,7 @@ binDirectoryFor -> FilePath binDirectoryFor layout config package exe = case elabBuildStyle package of BuildAndInstall -> installedBinDirectory package - BuildInplaceOnly -> inplaceBinRoot layout config package exe + BuildInplaceOnly {} -> inplaceBinRoot layout config package exe -- package has been built and installed. installedBinDirectory :: ElaboratedConfiguredPackage -> FilePath diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs index bda338897e4..3fd12888e71 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} @@ -14,6 +16,7 @@ module Distribution.Client.ProjectPlanning.Types ( ElaboratedInstallPlan, normaliseConfiguredPackage, ElaboratedConfiguredPackage(..), + showElaboratedInstallPlan, elabDistDirParams, elabExeDependencyPaths, @@ -39,6 +42,8 @@ module Distribution.Client.ProjectPlanning.Types ( ElaboratedSharedConfig(..), ElaboratedReadyPackage, BuildStyle(..), + MemoryOrDisk(..), + isInplaceBuildStyle, CabalFileText, -- * Build targets @@ -109,6 +114,7 @@ import qualified Data.Map as Map import qualified Data.ByteString.Lazy as LBS import qualified Data.Monoid as Mon import System.FilePath (()) +import Text.PrettyPrint hiding ((<>)) -- | The combination of an elaborated install plan plus a @@ -136,6 +142,30 @@ elabPlanPackageName verbosity (Configured elab) elabPlanPackageName verbosity (Installed elab) = elabConfiguredName verbosity elab +showElaboratedInstallPlan :: ElaboratedInstallPlan -> String +showElaboratedInstallPlan = InstallPlan.showInstallPlan_gen showNode + where + showNode pkg = InstallPlan.ShowPlanNode { InstallPlan.showPlanHerald = herald + , InstallPlan.showPlanNeighbours = deps } + where + herald = (hsep [ text (InstallPlan.showPlanPackageTag pkg) + , InstallPlan.foldPlanPackage (const mempty) in_mem pkg + , pretty (packageId pkg) + , parens (pretty (nodeKey pkg))]) + + in_mem elab = case elabBuildStyle elab of + BuildInplaceOnly InMemory -> parens (text "In Memory") + _ -> mempty + + deps = InstallPlan.foldPlanPackage installed_deps local_deps pkg + + installed_deps = map pretty . nodeNeighbors + + local_deps cfg = [ (if internal then text "+" else mempty) <> pretty (confInstId uid) | (uid, internal) <- elabLibDependencies cfg ] + + + + --TODO: [code cleanup] decide if we really need this, there's not much in it, and in principle -- even platform and compiler could be different if we're building things -- like a server + client with ghc + ghcjs @@ -202,6 +232,8 @@ data ElaboratedConfiguredPackage -- in) elabLocalToProject :: Bool, + -- elabIsInternalPackage :: IsInternal, + -- | Are we going to build and install this package to the store, or are -- we going to build it and register it locally. elabBuildStyle :: BuildStyle, @@ -326,7 +358,7 @@ data ElaboratedConfiguredPackage elabBuildTargets :: [ComponentTarget], elabTestTargets :: [ComponentTarget], elabBenchTargets :: [ComponentTarget], - elabReplTarget :: Maybe ComponentTarget, + elabReplTarget :: [ComponentTarget], elabHaddockTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, @@ -441,7 +473,7 @@ dataDirEnvVarForPackage :: DistDirLayout dataDirEnvVarForPackage distDirLayout pkg = case elabBuildStyle pkg of BuildAndInstall -> Nothing - BuildInplaceOnly -> Just + BuildInplaceOnly {} -> Just ( pkgPathEnvVar (elabPkgDescription pkg) "datadir" , Just $ srcPath (elabPkgSourceLocation pkg) dataDir (elabPkgDescription pkg)) @@ -540,13 +572,13 @@ elabOrderLibDependencies :: ElaboratedConfiguredPackage -> [UnitId] elabOrderLibDependencies elab = case elabPkgOrComp elab of ElabPackage pkg -> map (newSimpleUnitId . confInstId) $ - ordNub $ CD.flatDeps (pkgLibDependencies pkg) + ordNub $ CD.flatDeps (map fst <$> pkgLibDependencies pkg) ElabComponent comp -> compOrderLibDependencies comp -- | The library dependencies (i.e., the libraries we depend on, NOT -- the dependencies of the library), NOT including setup dependencies. -- These are passed to the @Setup@ script via @--dependency@. -elabLibDependencies :: ElaboratedConfiguredPackage -> [ConfiguredId] +elabLibDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)] elabLibDependencies elab = case elabPkgOrComp elab of ElabPackage pkg -> ordNub (CD.nonSetupDeps (pkgLibDependencies pkg)) @@ -580,7 +612,7 @@ elabExeDependencyPaths elab = -- | The setup dependencies (the library dependencies of the setup executable; -- note that it is not legal for setup scripts to have executable -- dependencies at the moment.) -elabSetupDependencies :: ElaboratedConfiguredPackage -> [ConfiguredId] +elabSetupDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)] elabSetupDependencies elab = case elabPkgOrComp elab of ElabPackage pkg -> CD.setupDeps (pkgLibDependencies pkg) @@ -624,7 +656,7 @@ elabInplaceDependencyBuildCacheFiles layout sconf plan root_elab = go =<< InstallPlan.directDeps plan (nodeKey root_elab) where go = InstallPlan.foldPlanPackage (const []) $ \elab -> do - guard (elabBuildStyle elab == BuildInplaceOnly) + guard (isInplaceBuildStyle (elabBuildStyle elab)) return $ distPackageCacheFile layout (elabDistDirParams sconf elab) "build" -- | Some extra metadata associated with an @@ -643,7 +675,7 @@ data ElaboratedComponent compComponentName :: Maybe ComponentName, -- | The *external* library dependencies of this component. We -- pass this to the configure script. - compLibDependencies :: [ConfiguredId], + compLibDependencies :: [(ConfiguredId, Bool)], -- | In a component prior to instantiation, this list specifies -- the 'OpenUnitId's which, after instantiation, are the -- actual dependencies of this package. Note that this does @@ -691,7 +723,7 @@ data ElaboratedPackage -- | The exact dependencies (on other plan packages) -- - pkgLibDependencies :: ComponentDeps [ConfiguredId], + pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)], -- | Components which depend (transitively) on an internally -- defined library. These are used by 'elabRequiresRegistration', @@ -726,9 +758,9 @@ instance Structured ElaboratedPackage -- | See 'elabOrderDependencies'. This gives the unflattened version, -- which can be useful in some circumstances. -pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId] +pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [(UnitId)] pkgOrderDependencies pkg = - fmap (map (newSimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend` + fmap (map (newSimpleUnitId . confInstId)) (map fst <$> pkgLibDependencies pkg) `Mon.mappend` fmap (map (newSimpleUnitId . confInstId)) (pkgExeDependencies pkg) -- | This is used in the install plan to indicate how the package will be @@ -750,18 +782,39 @@ data BuildStyle = -- Typically 'BuildAndInstall' packages will only depend on other -- 'BuildAndInstall' style packages and not on 'BuildInplaceOnly' ones. -- - | BuildInplaceOnly + | BuildInplaceOnly MemoryOrDisk + -- | Built in-memory only using GHC multi-repl, they are not built or installed + -- anywhere on disk. BuildInMemory packages can't be depended on by BuildAndInstall nor BuildInplaceOnly packages + -- (because they don't exist on disk) but can depend on other BuildStyles. + + -- At the moment BuildInMemory is only used by the 'repl' command. +-- | BuildInMemory deriving (Eq, Show, Generic) -instance Binary BuildStyle -instance Structured BuildStyle +data MemoryOrDisk = InMemory | OnDisk deriving (Eq, Show, Generic) + +isInplaceBuildStyle :: BuildStyle -> Bool +isInplaceBuildStyle (BuildInplaceOnly {}) = True +isInplaceBuildStyle BuildAndInstall = False + +instance Binary MemoryOrDisk +instance Structured MemoryOrDisk + +instance Semigroup MemoryOrDisk where + InMemory <> x = x + OnDisk <> _ = OnDisk instance Semigroup BuildStyle where - BuildInplaceOnly <> _ = BuildInplaceOnly - _ <> BuildInplaceOnly = BuildInplaceOnly - _ <> _ = BuildAndInstall + (BuildInplaceOnly a) <> (BuildInplaceOnly b) = BuildInplaceOnly (a <> b) + (BuildInplaceOnly a) <> _ = BuildInplaceOnly a + BuildAndInstall <> _ = BuildAndInstall + instance Monoid BuildStyle where - mempty = BuildAndInstall - mappend = (<>) + mempty = BuildAndInstall + mappend = (<>) + + +instance Binary BuildStyle +instance Structured BuildStyle type CabalFileText = LBS.ByteString diff --git a/cabal-install/src/Distribution/Client/ReplFlags.hs b/cabal-install/src/Distribution/Client/ReplFlags.hs new file mode 100644 index 00000000000..6bfa45c9cbf --- /dev/null +++ b/cabal-install/src/Distribution/Client/ReplFlags.hs @@ -0,0 +1,89 @@ +module Distribution.Client.ReplFlags (EnvFlags(..), ReplFlags(..), topReplOptions, multiReplOption, defaultReplFlags) where + +import Prelude () +import Distribution.Client.Compat.Prelude + + +import Distribution.Client.Setup + ( liftOptions ) +import Distribution.Simple.Setup + ( ReplOptions(..), replOptions + , Flag(..), toFlag, falseArg, boolOpt ) +import Distribution.Simple.Command + ( option + , ShowOrParseArgs, OptionField, reqArg, liftOption ) +import Distribution.Parsec + ( parsecCommaList ) +import Distribution.ReadE + ( ReadE, parsecToReadE ) +import Distribution.Types.Dependency + ( Dependency(..) ) + +data EnvFlags = EnvFlags + { envPackages :: [Dependency] + , envIncludeTransitive :: Flag Bool + } + +instance Semigroup EnvFlags where + (EnvFlags a1 a2) <> (EnvFlags b1 b2) = EnvFlags (a1 <> b1) (a2 <> b2) + +instance Monoid EnvFlags where + mempty = defaultEnvFlags + +defaultEnvFlags :: EnvFlags +defaultEnvFlags = EnvFlags + { envPackages = [] + , envIncludeTransitive = toFlag True + } + +data ReplFlags = ReplFlags { + configureReplOptions :: ReplOptions + , replEnvFlags :: EnvFlags + , replUseMulti :: Flag Bool + } + +instance Semigroup ReplFlags where + (ReplFlags a1 a2 a3) <> (ReplFlags b1 b2 b3) = ReplFlags (a1 <> b1) (a2 <> b2) (a3 <> b3) + +instance Monoid ReplFlags where + mempty = defaultReplFlags + +defaultReplFlags :: ReplFlags +defaultReplFlags = ReplFlags { configureReplOptions = mempty + , replEnvFlags = defaultEnvFlags + , replUseMulti = NoFlag } + +topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags] +topReplOptions showOrParseArgs = + liftOptions configureReplOptions set1 (replOptions showOrParseArgs) ++ + liftOptions replEnvFlags set2 (envOptions showOrParseArgs) ++ + [liftOption replUseMulti set3 multiReplOption] + where + set1 a x = x { configureReplOptions = a } + set2 a x = x { replEnvFlags = a } + set3 a x = x { replUseMulti = a } + +multiReplOption :: OptionField (Flag Bool) +multiReplOption = + option [] ["multi-repl"] + "multi-component repl sessions" + id (\v _ -> v) + (boolOpt [] []) + +envOptions :: ShowOrParseArgs -> [OptionField EnvFlags] +envOptions _ = + [ option ['b'] ["build-depends"] + "Include additional packages in the environment presented to GHCi." + envPackages (\p flags -> flags { envPackages = p ++ envPackages flags }) + (reqArg "DEPENDENCIES" dependenciesReadE (fmap prettyShow :: [Dependency] -> [String])) + , option [] ["no-transitive-deps"] + "Don't automatically include transitive dependencies of requested packages." + envIncludeTransitive (\p flags -> flags { envIncludeTransitive = p }) + falseArg + ] + where + dependenciesReadE :: ReadE [Dependency] + dependenciesReadE = + parsecToReadE + ("couldn't parse dependencies: " ++) + (parsecCommaList parsec) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 6db91d9cf98..a961db2d63c 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -509,13 +509,13 @@ filterConfigureFlags flags cabalLibVersion -- (public sublibraries), so we convert it to the legacy -- --dependency=pkg_or_internal_component=cid configDependencies = - let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid) = + let convertToLegacyInternalDep (GivenComponent _ (LSubLibName cn) cid int) = Just $ GivenComponent (unqualComponentNameToPackageName cn) LMainLibName - cid - convertToLegacyInternalDep (GivenComponent pn LMainLibName cid) = - Just $ GivenComponent pn LMainLibName cid + cid int + convertToLegacyInternalDep (GivenComponent pn LMainLibName cid int) = + Just $ GivenComponent pn LMainLibName cid int in catMaybes $ convertToLegacyInternalDep <$> configDependencies flags -- Cabal < 2.5 doesn't know about '--allow-depending-on-private-libs'. , configAllowDependingOnPrivateLibs = NoFlag diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 6b81643fe0b..a8590841dc1 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -760,9 +760,9 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "multiple-libs" assertProjectTargetProblems "targets/multiple-libs" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget - [ ( flip CmdRepl.matchesMultipleProblem + [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False)) [ AvailableTarget "p-0.1" (CLibName LMainLibName) (TargetBuildable () TargetRequestedByDefault) True , AvailableTarget "q-0.1" (CLibName LMainLibName) @@ -774,9 +774,9 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "multiple-exes" assertProjectTargetProblems "targets/multiple-exes" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget - [ ( flip CmdRepl.matchesMultipleProblem + [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False)) [ AvailableTarget "p-0.1" (CExeName "p2") (TargetBuildable () TargetRequestedByDefault) True , AvailableTarget "p-0.1" (CExeName "p1") @@ -788,9 +788,9 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "multiple-tests" assertProjectTargetProblems "targets/multiple-tests" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget - [ ( flip CmdRepl.matchesMultipleProblem + [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False)) [ AvailableTarget "p-0.1" (CTestName "p2") (TargetBuildable () TargetNotRequestedByDefault) True , AvailableTarget "p-0.1" (CTestName "p1") @@ -803,7 +803,7 @@ testTargetProblemsRepl config reportSubCase = do do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config assertProjectDistinctTargets elaboratedPlan - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ mkTargetComponent "p-0.1" (CExeName "p1") , mkTargetComponent "p-0.1" (CExeName "p2") @@ -815,7 +815,7 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "libs-disabled" assertProjectTargetProblems "targets/libs-disabled" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ ( flip TargetProblemNoneEnabled [ AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ] @@ -825,7 +825,7 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "exes-disabled" assertProjectTargetProblems "targets/exes-disabled" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ ( flip TargetProblemNoneEnabled [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True @@ -836,7 +836,7 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "test-only" assertProjectTargetProblems "targets/test-only" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ ( flip TargetProblemNoneEnabled [ AvailableTarget "p-0.1" (CTestName "pexe") @@ -848,7 +848,7 @@ testTargetProblemsRepl config reportSubCase = do reportSubCase "empty-pkg" assertProjectTargetProblems "targets/empty-pkg" config - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" ) ] @@ -858,7 +858,7 @@ testTargetProblemsRepl config reportSubCase = do -- by default we only get the lib assertProjectDistinctTargets elaboratedPlan - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ] [ ("p-0.1-inplace", (CLibName LMainLibName)) ] @@ -866,13 +866,13 @@ testTargetProblemsRepl config reportSubCase = do -- components even though we did not explicitly enable tests/benchmarks assertProjectDistinctTargets elaboratedPlan - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ] [ ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") ] assertProjectDistinctTargets elaboratedPlan - CmdRepl.selectPackageTargets + (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False)) CmdRepl.selectComponentTarget [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) ] [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") ] diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 94f4190880e..218cddce080 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -483,6 +483,7 @@ instance Arbitrary ProjectConfigShared where projectConfigIndependentGoals <- arbitrary projectConfigPreferOldest <- arbitrary projectConfigProgPathExtra <- toNubList <$> listOf arbitraryShortToken + projectConfigMultiRepl <- arbitrary return ProjectConfigShared {..} where arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)] @@ -525,6 +526,7 @@ instance Arbitrary ProjectConfigShared where <*> shrinker projectConfigIndependentGoals <*> shrinker projectConfigPreferOldest <*> shrinker projectConfigProgPathExtra + <*> shrinker projectConfigMultiRepl where preShrink_Constraints = map fst postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource)) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out index 71653f09844..57dfee2d09a 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out @@ -8,4 +8,5 @@ Building executable 'cabal-script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (ephemeral targets) + - fake-package-0 (MEM) (exe:cabal-script-script.hs) (configuration changed) +Configuring executable 'cabal-script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out index cba93d1cfd8..ed7a963b641 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out @@ -2,5 +2,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) + - fake-package-0 (MEM) (exe:cabal-script-script.hs) (first run) Configuring executable 'cabal-script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out index 135f9694e0e..59f851cb257 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out @@ -2,9 +2,9 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) + - fake-package-0 (MEM) (exe:cabal-script-script.hs) (first run) Configuring executable 'cabal-script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) + - fake-package-0 (MEM) (exe:cabal-script-script.hs) (first run) diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out index be864329e71..fbe02ab8e7c 100644 --- a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out +++ b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-no-load.out @@ -3,6 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-no-load-0.1 (lib) (first run) + - cabal-repl-no-load-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-no-load-0.1.. Preprocessing library for cabal-repl-no-load-0.1.. diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out index 4c4a284cb88..8069f81cf90 100644 --- a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out +++ b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.exec-normal.out @@ -3,6 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-no-load-0.1 (exe:exec) (first run) + - cabal-repl-no-load-0.1 (MEM) (exe:exec) (first run) Configuring executable 'exec' for cabal-repl-no-load-0.1.. Preprocessing executable 'exec' for cabal-repl-no-load-0.1.. diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out index be864329e71..fbe02ab8e7c 100644 --- a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out +++ b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-no-load.out @@ -3,6 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-no-load-0.1 (lib) (first run) + - cabal-repl-no-load-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-no-load-0.1.. Preprocessing library for cabal-repl-no-load-0.1.. diff --git a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out index be864329e71..fbe02ab8e7c 100644 --- a/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out +++ b/cabal-testsuite/PackageTests/ReplNoLoad/cabal.lib-normal.out @@ -3,6 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-no-load-0.1 (lib) (first run) + - cabal-repl-no-load-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-no-load-0.1.. Preprocessing library for cabal-repl-no-load-0.1.. diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options-multiple-flags.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options-multiple-flags.out index d62961e60e5..a9019ee30ae 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options-multiple-flags.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options-multiple-flags.out @@ -3,7 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-options-0.1 (lib) (first run) + - cabal-repl-options-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-options-0.1.. Preprocessing library for cabal-repl-options-0.1.. - diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options.out index d62961e60e5..a9019ee30ae 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.multiple-repl-options.out @@ -3,7 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-options-0.1 (lib) (first run) + - cabal-repl-options-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-options-0.1.. Preprocessing library for cabal-repl-options-0.1.. - diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out index dbe6d700d72..372c2689ec8 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out @@ -3,8 +3,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-options-0.1 (lib) (first run) + - cabal-repl-options-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-options-0.1.. Preprocessing library for cabal-repl-options-0.1.. Error: cabal: repl failed for cabal-repl-options-0.1-inplace. - diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags.out index d62961e60e5..a9019ee30ae 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags.out @@ -3,7 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-options-0.1 (lib) (first run) + - cabal-repl-options-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-options-0.1.. Preprocessing library for cabal-repl-options-0.1.. - diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options.out index d62961e60e5..a9019ee30ae 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options.out @@ -3,7 +3,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - cabal-repl-options-0.1 (lib) (first run) + - cabal-repl-options-0.1 (MEM) (lib) (first run) Configuring library for cabal-repl-options-0.1.. Preprocessing library for cabal-repl-options-0.1.. - diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out index 67e8a8553f7..fd183bc7915 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out @@ -15,7 +15,7 @@ Warning: 'hs-source-dirs: doesnt-exist' specifies a directory which does not exi Preprocessing executable 'Complex' for Complex-0.1.0.0.. Building executable 'Complex' for Complex-0.1.0.0.. # show-build-info Complex exe:Complex -{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-Complex","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} # cabal build Up to date # show-build-info Complex lib @@ -34,7 +34,7 @@ Warning: 'hs-source-dirs: doesnt-exist' specifies a directory which does not exi Preprocessing benchmark 'complex-benchmarks' for Complex-0.1.0.0.. Building benchmark 'complex-benchmarks' for Complex-0.1.0.0.. # show-build-info Complex bench:complex-benchmarks -{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-complex-benchmarks","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} # cabal build Build profile: -w ghc- -O1 In order, the following will be built: @@ -49,7 +49,7 @@ Warning: 'hs-source-dirs: doesnt-exist' specifies a directory which does not exi Preprocessing test suite 'func-test' for Complex-0.1.0.0.. Building test suite 'func-test' for Complex-0.1.0.0.. # show-build-info Complex test:func-test -{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-func-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} # cabal build Build profile: -w ghc- -O1 In order, the following will be built: @@ -64,4 +64,4 @@ Warning: 'hs-source-dirs: doesnt-exist' specifies a directory which does not exi Preprocessing test suite 'unit-test' for Complex-0.1.0.0.. Building test suite 'unit-test' for Complex-0.1.0.0.. # show-build-info Complex test:unit-test -{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} +{"cabal-lib-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace-unit-test","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}]} diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs index 5b083d69c16..b4bdc16f0cd 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs @@ -2,40 +2,43 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo -main = cabalTest $ withRepo "repo" $ do - runShowBuildInfo ["exe:Complex"] >> withPlan (do - recordBuildInfo "Complex" (exe "Complex") - assertComponent "Complex" (exe "Complex") defCompAssertion - { modules = ["Other", "Paths_Complex"] - , sourceFiles = ["Main.lhs"] - , sourceDirs = ["app"] - }) +main = cabalTest $ do + -- the With GHC-9.2+ output contains -this-unit-id + skipUnlessGhcVersion ">= 9.2" + withRepo "repo" $ do + runShowBuildInfo ["exe:Complex"] >> withPlan (do + recordBuildInfo "Complex" (exe "Complex") + assertComponent "Complex" (exe "Complex") defCompAssertion + { modules = ["Other", "Paths_Complex"] + , sourceFiles = ["Main.lhs"] + , sourceDirs = ["app"] + }) - runShowBuildInfo ["lib:Complex"] >> withPlan (do - recordBuildInfo "Complex" mainLib - assertComponent "Complex" mainLib defCompAssertion - { modules = ["A", "B", "C", "D", "Paths_Complex"] - , sourceDirs = ["src", "doesnt-exist"] - }) + runShowBuildInfo ["lib:Complex"] >> withPlan (do + recordBuildInfo "Complex" mainLib + assertComponent "Complex" mainLib defCompAssertion + { modules = ["A", "B", "C", "D", "Paths_Complex"] + , sourceDirs = ["src", "doesnt-exist"] + }) - runShowBuildInfo ["benchmark:complex-benchmarks"] >> withPlan (do - recordBuildInfo "Complex" (bench "complex-benchmarks") - assertComponent "Complex" (bench "complex-benchmarks") defCompAssertion - { modules = ["Paths_Complex"] - , sourceFiles = ["Main.hs"] - , sourceDirs = ["benchmark"] - }) + runShowBuildInfo ["benchmark:complex-benchmarks"] >> withPlan (do + recordBuildInfo "Complex" (bench "complex-benchmarks") + assertComponent "Complex" (bench "complex-benchmarks") defCompAssertion + { modules = ["Paths_Complex"] + , sourceFiles = ["Main.hs"] + , sourceDirs = ["benchmark"] + }) - runShowBuildInfo ["test:func-test"] >> withPlan (do - recordBuildInfo "Complex" (test "func-test") - assertComponent "Complex" (test "func-test") defCompAssertion - { sourceFiles = ["FuncMain.hs"] - , sourceDirs = ["test"] - }) + runShowBuildInfo ["test:func-test"] >> withPlan (do + recordBuildInfo "Complex" (test "func-test") + assertComponent "Complex" (test "func-test") defCompAssertion + { sourceFiles = ["FuncMain.hs"] + , sourceDirs = ["test"] + }) - runShowBuildInfo ["test:unit-test"] >> withPlan (do - recordBuildInfo "Complex" (test "unit-test") - assertComponent "Complex" (test "unit-test") defCompAssertion - { sourceFiles = ["UnitMain.hs"] - , sourceDirs = ["test"] - }) + runShowBuildInfo ["test:unit-test"] >> withPlan (do + recordBuildInfo "Complex" (test "unit-test") + assertComponent "Complex" (test "unit-test") defCompAssertion + { sourceFiles = ["UnitMain.hs"] + , sourceDirs = ["test"] + })