diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 7d68bb251de..8c677f990db 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) 0x30ebb8fffa1af2aefa9432ff4028eef8 #endif ] 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-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-solver/src/Distribution/Solver/Types/ConstraintSource.hs b/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs index 55293fecd18..7d821257234 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ConstraintSource.hs @@ -36,6 +36,10 @@ data ConstraintSource = -- target, when a more specific source is not known. | ConstraintSourceConfigFlagOrTarget + -- | Constraint introduced by --enable-multi-repl, which requires features + -- from Cabal >= 3.11 + | ConstraintSourceMultiRepl + -- | The source of the constraint is not specified. | ConstraintSourceUnknown @@ -65,6 +69,8 @@ showConstraintSource ConstraintSourceNonUpgradeablePackage = showConstraintSource ConstraintSourceFreeze = "cabal freeze" showConstraintSource ConstraintSourceConfigFlagOrTarget = "config file, command line flag, or user target" +showConstraintSource ConstraintSourceMultiRepl = + "--enable-multi-repl" showConstraintSource ConstraintSourceUnknown = "unknown source" showConstraintSource ConstraintSetupCabalMinVersion = "minimum version of Cabal used by Setup.hs" diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 64bcf2f0096..d3c130ba2d3 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -159,6 +159,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 8993e18e2de..766247145ba 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -187,12 +187,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 dcf659f036a..b8569a802bd 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 () @@ -33,6 +36,8 @@ import Distribution.Client.CmdErrorMessages targetSelectorRefersToPkgs, renderComponentKind, renderListCommaAnd, renderListSemiAnd, componentKind, sortGroupOn, Plural(..) ) +import Distribution.Client.Targets + ( UserConstraint(..), UserConstraintScope(..) ) import Distribution.Client.TargetProblem ( TargetProblem(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan @@ -42,7 +47,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,23 +58,22 @@ 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 ) + ( Package(..), packageName, mkPackageName, UnitId, installedUnitId ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) +import Distribution.Solver.Types.ConstraintSource + ( ConstraintSource(ConstraintSourceMultiRepl) ) +import Distribution.Solver.Types.PackageConstraint + ( PackageProperty(PackagePropertyVersion) ) import Distribution.Types.BuildInfo ( BuildInfo(..), emptyBuildInfo ) import Distribution.Types.ComponentName @@ -83,13 +87,13 @@ import Distribution.Types.Library import Distribution.Types.Version ( Version, mkVersion ) import Distribution.Types.VersionRange - ( anyVersion ) + ( anyVersion, orLaterVersion ) import Distribution.Utils.Generic ( safeHead ) import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Simple.Utils - ( wrapText, die', debugNoWrap ) + ( wrapText, die', debugNoWrap, withTempDirectoryEx, TempFileOptions (..) ) import Language.Haskell.Extension ( Language(..) ) @@ -98,40 +102,30 @@ 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 + ( programInvocation, runProgramInvocation ) +import Distribution.Simple.Program.Builtin ( ghcProgram ) +import Distribution.Simple.Program.Db ( requireProgram ) +import Control.Monad ( mapM ) +import Distribution.Compat.Binary ( decode ) +import qualified Data.ByteString.Lazy as BS +import Distribution.Simple.Program.Types + ( ConfiguredProgram(programOverrideEnv) ) +import Distribution.Client.ReplFlags + ( ReplFlags(..), + EnvFlags(envIncludeTransitive, envPackages), + defaultReplFlags, + topReplOptions ) +import Distribution.Simple.Flag ( Flag(Flag), fromFlagOrDefault ) +import Distribution.Client.ProjectConfig + ( ProjectConfigShared(projectConfigMultiRepl, projectConfigConstraints), + ProjectConfig(projectConfigShared) ) + + +replCommand :: CommandUI (NixStyleFlags ReplFlags) replCommand = Client.installCommand { commandName = "v2-repl", commandSynopsis = "Open an interactive session for the given component.", @@ -168,25 +162,42 @@ 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. -- --- Compared to @build@ the difference is that only one target is allowed --- (given or implicit) and the target type is repl rather than build. The +-- Compared to @build@ the difference is that multiple targets are handled +-- specially and the target type is repl rather than build. The -- general plan execution infrastructure handles both build and repl targets. -- -- 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 +205,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,24 +234,35 @@ replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetSt updateContextAndWriteProjectFile ctx scriptPath scriptExecutable - (originalComponent, baseCtx') <- if null (envPackages envFlags) - then return (Nothing, baseCtx) + -- If multi-repl is used, we need a Cabal recent enough to handle it. + -- We need to do this before solving, but the compiler version is only known + -- after solving (phaseConfigureCompiler), so instead of using + -- multiReplDecision we just check the flag. + let baseCtx' = if fromFlagOrDefault False $ + projectConfigMultiRepl (projectConfigShared $ projectConfig baseCtx) + <> replUseMulti + then baseCtx & lProjectConfig . lProjectConfigShared . lProjectConfigConstraints + %~ (multiReplCabalConstraint:) + else baseCtx + + (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') + return (Just oci, baseCtx'') -- Now, we run the solver again with the added packages. While the graph -- won't actually reflect the addition of transitive dependencies, @@ -249,26 +272,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' + 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 +304,96 @@ 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)) + return (buildCtx, compiler, configureReplOptions & lReplOptionsFlags %~ (++ repl_flags), targets) + + -- Multi Repl implemention see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for + -- a high-level overview about how everything fits together. + if Set.size (distinctTargetComponents targets) > 1 + then withTempDirectoryEx verbosity (TempFileOptions keepTempFiles) distDir "multi-out" $ \dir' -> do + -- multi target repl + dir <- makeAbsolute dir' + -- Modify the replOptions so that the ./Setup repl command will write options + -- into the multi-out directory. + replOpts'' <- case targetCtx of + ProjectContext -> return $ replOpts' { replOptionsFlagOutput = Flag dir} + _ -> usingGhciScript compiler projectRoot replOpts' + + let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' + printPlan verbosity baseCtx'' buildCtx' + + -- The project build phase will call `./Setup repl` but write the options + -- out into a file without starting a repl. + buildOutcomes <- runProjectBuildPhase verbosity baseCtx'' buildCtx' + runProjectPostBuildPhase verbosity baseCtx'' buildCtx' buildOutcomes + + -- calculate PATH, we construct a PATH which is the union of all paths from + -- the units which have been loaded. This is not quite right but usually works fine. + path_files <- listDirectory (dir "paths") + + -- Note: decode is partial. Should we use Structured here? + -- This might blow up with @build-type: Custom@ stuff. + ghcProgs <- mapM (\f -> decode @ConfiguredProgram <$> BS.readFile (dir "paths" f)) path_files + + let all_paths = concatMap programOverrideEnv ghcProgs + 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 + + -- ghc program with overriden PATH + (ghcProg, _) <- requireProgram verbosity ghcProgram (pkgConfigCompilerProgs (elaboratedShared buildCtx')) + let ghcProg' = ghcProg { programOverrideEnv = [("PATH", Just sp)]} + + + -- Find what the unit files are, and start a repl based on all the response + -- files which have been created in the directory. + -- unit files for components + unit_files <- listDirectory dir + + -- run ghc --interactive with + runProgramInvocation verbosity $ programInvocation ghcProg' $ concat $ + ["--interactive" + , "-package-env", "-" -- to ignore ghc.environment.* files + , "-j", show (buildSettingNumJobs (buildSettings ctx)) + ] : + [ ["-unit", "@" ++ dir unit] + | unit <- unit_files, unit /= "paths" + ] + + pure () + + else do + -- single target repl + replOpts'' <- case targetCtx of + ProjectContext -> return replOpts' + _ -> usingGhciScript compiler projectRoot replOpts' + + let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' + printPlan verbosity baseCtx'' buildCtx' + + 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) + keepTempFiles = fromFlagOrDefault False replKeepTempFiles - 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 +402,27 @@ 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 + -- This is the constraint setup.Cabal>=3.11. 3.11 is when Cabal options + -- used for multi-repl were introduced. + -- Idelly we'd apply this constraint only on the closure of repl targets, + -- but that would require another solver run for marginal advantages that + -- will further shrink as 3.11 is adopted. + multiReplCabalConstraint = + ( UserConstraint + (UserAnySetupQualifier (mkPackageName "Cabal")) + (PackagePropertyVersion $ orLaterVersion $ mkVersion [3,11]) + , ConstraintSourceMultiRepl ) + +-- | First version of GHC which supports multiple home packages +minMultipleHomeUnitsVersion :: Version +minMultipleHomeUnitsVersion = mkVersion [9, 4] + data OriginalComponentInfo = OriginalComponentInfo { ociUnitId :: UnitId , ociOriginalDeps :: [UnitId] @@ -383,6 +487,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 @@ -403,9 +508,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 multiple_targets_allowed + -- If explicitly 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] -selectPackageTargets targetSelector targets +selectPackageTargetsSingle decision targetSelector targets -- If there is exactly one buildable library then we select that | [target] <- targetsLibsBuildable @@ -413,7 +551,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 @@ -421,7 +559,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 @@ -429,7 +567,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) @@ -471,10 +609,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 @@ -483,16 +621,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 = @@ -502,7 +642,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 " @@ -517,24 +657,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 passing --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 @@ -548,3 +713,15 @@ lPkgConfigReplOptions f s = fmap (\x -> s { pkgConfigReplOptions = x }) (f (pkgC lReplOptionsFlags :: Lens' ReplOptions [String] lReplOptionsFlags f s = fmap (\x -> s { replOptionsFlags = x }) (f (replOptionsFlags s)) {-# inline lReplOptionsFlags #-} + +lProjectConfig :: Lens' ProjectBaseContext ProjectConfig +lProjectConfig f s = fmap (\x -> s { projectConfig = x }) (f (projectConfig s)) +{-# inline lProjectConfig #-} + +lProjectConfigShared :: Lens' ProjectConfig ProjectConfigShared +lProjectConfigShared f s = fmap (\x -> s { projectConfigShared = x }) (f (projectConfigShared s)) +{-# inline lProjectConfigShared #-} + +lProjectConfigConstraints :: Lens' ProjectConfigShared [(UserConstraint, ConstraintSource)] +lProjectConfigConstraints f s = fmap (\x -> s { projectConfigConstraints = x }) (f (projectConfigConstraints s)) +{-# inline lProjectConfigConstraints #-} diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 9143abb9848..58391044b0d 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 @@ -526,6 +529,8 @@ instance Semigroup SavedConfig where combine = combine' savedBenchmarkFlags lastNonEmpty = lastNonEmpty' savedBenchmarkFlags + combinedSavedReplMulti = combine' savedReplMulti id + combinedSavedProjectFlags = ProjectFlags { flagProjectDir = combine flagProjectDir , flagProjectFile = combine flagProjectFile @@ -992,7 +997,7 @@ configFieldDescriptions src = ++ toSavedConfig liftConfigFlag (configureOptions ParseArgs) - (["builddir", "constraint", "dependency", "ipid"] + (["builddir", "constraint", "dependency", "promised-dependency", "ipid"] ++ map fieldName installDirsFields) -- This is only here because viewAsFieldDescr gives us a parser @@ -1096,6 +1101,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) @@ -1110,6 +1119,7 @@ configFieldDescriptions src = ParseArgs ] + where toSavedConfig lift options exclusions replacements = [ lift (fromMaybe field replacement) @@ -1207,6 +1217,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/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/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs index 965ef74c5be..44d52febadd 100644 --- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs +++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs @@ -40,9 +40,9 @@ nixStyleOptions nixStyleOptions commandOptions showOrParseArgs = liftOptions configFlags set1 -- Note: [Hidden Flags] - -- hide "constraint", "dependency", and + -- hide "constraint", "dependency", "promised-dependency" and -- "exact-configuration" from the configure options. - (filter ((`notElem` ["constraint", "dependency" + (filter ((`notElem` ["constraint", "dependency", "promised-dependency" , "exact-configuration"]) . optionName) $ configureOptions showOrParseArgs) ++ liftOptions configExFlags set2 (configureExOptions showOrParseArgs diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index 19a6661b6f6..76e51432a11 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -226,7 +226,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 @@ -395,7 +395,7 @@ packageFileMonitorKeyValues elab = elabBuildTargets = [], elabTestTargets = [], elabBenchTargets = [], - elabReplTarget = Nothing, + elabReplTarget = [], elabHaddockTargets = [], elabBuildHaddocks = False, @@ -617,10 +617,10 @@ 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 rebuildTarget verbosity @@ -754,7 +754,7 @@ rebuildTarget verbosity case elabBuildStyle pkg of BuildAndInstall -> buildAndInstall - BuildInplaceOnly -> buildInplace buildStatus + BuildInplaceOnly {} -> buildInplace buildStatus where buildStatus = BuildStatusConfigure MonitorFirstRun @@ -764,7 +764,7 @@ rebuildTarget verbosity -- rebuildPhase :: BuildStatusRebuild -> FilePath -> IO BuildResult rebuildPhase buildStatus srcdir = - assert (elabBuildStyle pkg == BuildInplaceOnly) $ + assert (isInplaceBuildStyle $ elabBuildStyle pkg) buildInplace buildStatus srcdir builddir where @@ -898,7 +898,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 @@ -1238,7 +1238,7 @@ hasValidHaddockTargets ElaboratedConfiguredPackage{..} where components :: [ComponentTarget] components = elabBuildTargets ++ elabTestTargets ++ elabBenchTargets - ++ maybeToList elabReplTarget ++ elabHaddockTargets + ++ elabReplTarget ++ elabHaddockTargets componentHasHaddocks :: ComponentTarget -> Bool componentHasHaddocks (ComponentTarget name _) = @@ -1375,7 +1375,7 @@ buildInplaceUnpackedPackage verbosity -- whenRepl $ annotateFailureNoLog ReplFailed $ - setupInteractive replCommand replFlags replArgs + setupInteractive replCommand replFlags replArgs -- Haddock phase whenHaddock $ @@ -1436,8 +1436,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 40c0e5293e5..54d169fb74f 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 { @@ -726,6 +730,7 @@ convertToLegacySharedConfig , legacyInstallFlags = installFlags , legacyClientInstallFlags = projectConfigClientInstallFlags , legacyProjectFlags = projectFlags + , legacyMultiRepl = projectConfigMultiRepl } where globalFlags = GlobalFlags { @@ -1217,6 +1222,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 991551b9545..256a9ec1f43 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -205,7 +205,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 1adf2ed06a0..79459e40b56 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -907,6 +907,9 @@ printPlan verbosity , if verbosity >= deafening then prettyShow (installedUnitId elab) else prettyShow (packageId elab) + , case elabBuildStyle elab of + BuildInplaceOnly InMemory -> "(interactive)" + _ -> "" , case elabPkgOrComp elab of ElabPackage pkg -> showTargets elab ++ ifVerbose (showStanzas (pkgStanzasEnabled pkg)) ElabComponent comp -> @@ -1053,7 +1056,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 c9243c310e0..44cd5691deb 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 @@ -273,7 +273,8 @@ encodePlanAsJson distDirLayout elaboratedInstallPlan elaboratedSharedConfig = style2str :: Bool -> BuildStyle -> String style2str True _ = "local" - style2str False BuildInplaceOnly = "inplace" + style2str False (BuildInplaceOnly OnDisk) = "inplace" + style2str False (BuildInplaceOnly InMemory) = "interactive" style2str False BuildAndInstall = "global" jdisplay :: Pretty a => a -> J.Value @@ -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 7a924de3f80..794c8ff3dca 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -124,8 +124,8 @@ import Distribution.Types.ComponentName import Distribution.Types.DumpBuildInfo ( DumpBuildInfo (..) ) import Distribution.Types.LibraryName -import Distribution.Types.GivenComponent - (GivenComponent(..)) +import Distribution.Types.GivenComponent + ( GivenComponent(GivenComponent) ) import Distribution.Types.PackageVersionConstraint import Distribution.Types.PkgconfigDependency import Distribution.Types.UnqualComponentName @@ -250,7 +250,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)) @@ -261,7 +261,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 @@ -273,7 +273,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 @@ -713,7 +713,7 @@ rebuildInstallPlan verbosity installDirs elaboratedShared elaboratedPlan - liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan instantiatedPlan) + liftIO $ debugNoWrap verbosity (showElaboratedInstallPlan instantiatedPlan) return (instantiatedPlan, elaboratedShared) where withRepoCtx = projectConfigWithSolverRepoContext verbosity @@ -755,7 +755,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 @@ -1532,7 +1532,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: @@ -1567,11 +1568,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 in pruneInstallPlanPhase2) -- 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 @@ -1590,7 +1593,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 @@ -1790,7 +1793,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB filterExt' = filter (isExt . fst) pkgLibDependencies - = buildComponentDeps (filterExt . compLibDependencies) + = buildComponentDeps (filterExt' . compLibDependencies) pkgExeDependencies = buildComponentDeps (filterExt . compExeDependencies) pkgExeDependencyPaths @@ -1886,7 +1889,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBuildTargets = [] elabTestTargets = [] elabBenchTargets = [] - elabReplTarget = Nothing + elabReplTarget = [] elabHaddockTargets = [] elabBuildHaddocks = @@ -1896,7 +1899,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes elabLocalToProject = isLocalToProject pkg elabBuildStyle = if shouldBuildInplaceOnly pkg - then BuildInplaceOnly else BuildAndInstall + then BuildInplaceOnly OnDisk else BuildAndInstall elabPackageDbs = projectConfigPackageDBs sharedPackageConfig elabBuildPackageDBStack = buildAndRegisterDbs elabRegisterPackageDBStack = buildAndRegisterDbs @@ -2220,7 +2223,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] _ -> [] @@ -2445,9 +2448,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 @@ -2733,7 +2736,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) @@ -2837,13 +2840,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 } @@ -2853,6 +2855,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: -- @@ -2864,26 +2869,107 @@ setRootTargets targetAction perPkgTargetsMap = -- pruneInstallPlanPass1 :: [ElaboratedPlanPackage] -> [ElaboratedPlanPackage] -pruneInstallPlanPass1 pkgs = - map (mapConfiguredPackage fromPrunedPackage) - (fromMaybe [] $ Graph.closure graph roots) +pruneInstallPlanPass1 pkgs + -- if there are repl targets, we need to do a bit more work + -- See Note [Pruning for Multi Repl] + | 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 = Set.fromList [elabUnitId cp | InstallPlan.Configured cp <- fromMaybe [] $ Graph.revClosure closed_graph roots] + + add_repl_target :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage + add_repl_target ecp | elabUnitId ecp `Set.member` 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 = 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 = 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) @@ -2981,7 +3067,7 @@ pruneInstallPlanPass1 pkgs = | ComponentTarget cname _ <- elabBuildTargets pkg ++ elabTestTargets pkg ++ elabBenchTargets pkg - ++ maybeToList (elabReplTarget pkg) + ++ elabReplTarget pkg ++ elabHaddockTargets pkg , stanza <- maybeToList $ componentOptionalStanza $ @@ -2993,6 +3079,38 @@ pruneInstallPlanPass1 pkgs = [ installedUnitId pkg | InstallPlan.PreExisting pkg <- pkgs ] +{- +Note [Pruning for Multi Repl] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +For a multi-repl session, where we load more than one component into a GHCi repl, +it is required to uphold the so-called *closure property*. +This property, whose exact Note you can read in the GHC codebase, states +roughly: + +* If a component you want to load into a repl session transitively depends on a + component which transitively depends on another component you want to + load into the repl, then this component needs to be loaded + into the repl session as well. + +We make sure here, that this property is upheld, by calculating the +graph of components that we need to load into the repl given the set of 'roots' which +are the targets specified by the user. + +Practically, this is simply achieved by traversing all dependencies of +our roots (graph closure), and then from this closed graph, we calculate +the reverse closure, which gives us all components that depend on +'roots'. Thus, the result is a list of components that we need to load +into the repl to uphold the closure property. + +Further to this, we then check that all the enabled components are using a new enough +version of Cabal which understands the repl option to write the arguments to a file. + +If there is a package using a custom Setup.hs which is linked against a too old version +of Cabal then we need to disable that as otherwise we will end up passing unknown +arguments to `./Setup`. +-} + -- | Given a set of already installed packages @availablePkgs@, -- determine the set of available optional stanzas from @pkg@ -- which have all of their dependencies already installed. This is used @@ -3053,6 +3171,7 @@ pruneInstallPlanPass2 pkgs = map (mapConfiguredPackage setStanzasDepsAndTargets) pkgs where setStanzasDepsAndTargets elab = + elab { elabBuildTargets = ordNub $ elabBuildTargets elab @@ -3066,18 +3185,27 @@ 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 + -- We initially assume that all the dependencies are external (hence the boolean is always + -- False) and here we correct the dependencies so the right packages are marked promised. + 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 is being build in memory + , elabBuildStyle elab /= BuildInplaceOnly InMemory ] exeTargetsRequiredForRevDeps = -- TODO: allow requesting executable with different name @@ -3093,6 +3221,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 @@ -3393,7 +3528,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, @@ -3468,7 +3603,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) @@ -3592,24 +3727,22 @@ 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) - configDependencies = [ GivenComponent - (packageName srcid) - ln - cid - | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab - , let ln = case mb_cn - of Just (CLibName lname) -> lname - Just _ -> error "non-library dependency" - Nothing -> LMainLibName + -- + configDependencies = [ cidToGivenComponent cid + | (cid, is_internal) <- elabLibDependencies elab + , not is_internal ] - configPromisedDependencies = [] + configPromisedDependencies= [ cidToGivenComponent cid + | (cid, is_internal) <- elabLibDependencies elab + , is_internal + ] configConstraints = case elabPkgOrComp of ElabPackage _ -> [ thisPackageVersionConstraint srcid - | ConfiguredId srcid _ _uid <- elabLibDependencies elab ] + | (ConfiguredId srcid _ _uid, _) <- elabLibDependencies elab ] ElabComponent _ -> [] @@ -3633,6 +3766,14 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) configUseResponseFiles = mempty configAllowDependingOnPrivateLibs = Flag $ not $ libraryVisibilitySupported pkgConfigCompiler + cidToGivenComponent :: ConfiguredId -> GivenComponent + cidToGivenComponent (ConfiguredId srcid mb_cn cid) = GivenComponent (packageName srcid) ln cid + where + ln = case mb_cn of + Just (CLibName lname) -> lname + Just _ -> error "non-library dependency" + Nothing -> LMainLibName + setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] setupHsConfigureArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ }) = [] @@ -3727,9 +3868,7 @@ 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) setupHsCopyFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig @@ -3759,8 +3898,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,11 +4024,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 } @@ -4003,7 +4142,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 694b429c23a..3efb7fa9783 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 ( hsep, parens, text ) -- | The combination of an elaborated install plan plus a @@ -136,6 +142,27 @@ 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 @@ -327,7 +354,7 @@ data ElaboratedConfiguredPackage elabBuildTargets :: [ComponentTarget], elabTestTargets :: [ComponentTarget], elabBenchTargets :: [ComponentTarget], - elabReplTarget :: Maybe ComponentTarget, + elabReplTarget :: [ComponentTarget], elabHaddockTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, @@ -442,7 +469,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)) @@ -541,13 +568,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] +-- These are passed to the @Setup@ script via @--dependency@ or @--promised-dependency@. +elabLibDependencies :: ElaboratedConfiguredPackage -> [(ConfiguredId, Bool)] elabLibDependencies elab = case elabPkgOrComp elab of ElabPackage pkg -> ordNub (CD.nonSetupDeps (pkgLibDependencies pkg)) @@ -581,7 +608,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) @@ -625,7 +652,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,8 +670,9 @@ data ElaboratedComponent -- it's a setup dep. compComponentName :: Maybe ComponentName, -- | The *external* library dependencies of this component. We - -- pass this to the configure script. - compLibDependencies :: [ConfiguredId], + -- pass this to the configure script. The Bool indicates whether the + -- dependency is a promised dependency (True) or not (False). + 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,8 +719,9 @@ data ElaboratedPackage pkgInstalledId :: InstalledPackageId, -- | The exact dependencies (on other plan packages) - -- - pkgLibDependencies :: ComponentDeps [ConfiguredId], + -- The boolean value indicates whether the dependency is a promised dependency + -- or not. + pkgLibDependencies :: ComponentDeps [(ConfiguredId, Bool)], -- | Components which depend (transitively) on an internally -- defined library. These are used by 'elabRequiresRegistration', @@ -729,7 +758,7 @@ instance Structured ElaboratedPackage -- which can be useful in some circumstances. 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 @@ -743,7 +772,7 @@ data BuildStyle = -- the results discarded. BuildAndInstall - -- | The package is built, but the files are not installed anywhere, + -- | For 'OnDisk': The package is built, but the files are not installed anywhere, -- rather the build dir is kept and the package is registered inplace. -- -- Such packages can still subsequently be installed. @@ -751,18 +780,41 @@ data BuildStyle = -- Typically 'BuildAndInstall' packages will only depend on other -- 'BuildAndInstall' style packages and not on 'BuildInplaceOnly' ones. -- - | BuildInplaceOnly - deriving (Eq, Show, Generic) + -- For 'InMemory': 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 @'BuildInplaceOnly' 'InMemory'@ is only used by the 'repl' command. + -- + -- We use single constructor 'BuildInplaceOnly' as for most cases + -- inplace packages are handled similarly. + -- + | BuildInplaceOnly MemoryOrDisk + deriving (Eq, Ord, Show, Generic) + +-- | How 'BuildInplaceOnly' component is built. +data MemoryOrDisk + = OnDisk + | InMemory deriving (Eq, Ord, Show, Generic) + +-- Note: order of 'BuildStyle' and 'MemoryOrDisk' matters for 'Semigroup' / 'Monoid' instances + +isInplaceBuildStyle :: BuildStyle -> Bool +isInplaceBuildStyle (BuildInplaceOnly {}) = True +isInplaceBuildStyle BuildAndInstall = False + +instance Binary MemoryOrDisk +instance Structured MemoryOrDisk -instance Binary BuildStyle -instance Structured BuildStyle instance Semigroup BuildStyle where - BuildInplaceOnly <> _ = BuildInplaceOnly - _ <> BuildInplaceOnly = BuildInplaceOnly - _ <> _ = BuildAndInstall + -- 'BuildAndInstall' i.e. the smallest / first constructor is the unit. + (<>) = max + instance Monoid BuildStyle where - mempty = BuildAndInstall - mappend = (<>) + mempty = BuildAndInstall + +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..d6c7399e52c --- /dev/null +++ b/cabal-install/src/Distribution/Client/ReplFlags.hs @@ -0,0 +1,103 @@ +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, trueArg ) +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 + , replKeepTempFiles :: Flag Bool + } + +instance Semigroup ReplFlags where + (ReplFlags a1 a2 a3 a4) <> (ReplFlags b1 b2 b3 b4) = ReplFlags (a1 <> b1) (a2 <> b2) (a3 <> b3) (a4 <> b4) + +instance Monoid ReplFlags where + mempty = defaultReplFlags + +defaultReplFlags :: ReplFlags +defaultReplFlags = ReplFlags { configureReplOptions = mempty + , replEnvFlags = defaultEnvFlags + , replUseMulti = NoFlag + , replKeepTempFiles = NoFlag + } + +topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags] +topReplOptions showOrParseArgs = + liftOptions configureReplOptions set1 (replOptions showOrParseArgs) ++ + liftOptions replEnvFlags set2 (envOptions showOrParseArgs) ++ + [ liftOption replUseMulti set3 multiReplOption + + -- keeping temporary files is important functionality for HLS, + -- which runs @cabal repl@ with fake GHC to get cli arguments. + -- It will need the temporary files (incl. multi unit repl response files) + -- to stay, even after the @cabal repl@ command exits. + -- + , option [] ["keep-temp-files"] + "Keep temporary files" + replKeepTempFiles (\b flags -> flags { replKeepTempFiles = b }) + trueArg + ] + 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 1044cd3cb8c..e1aee425844 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -651,7 +651,7 @@ configureExCommand = configureCommand { commandDefaultFlags = (mempty, defaultConfigExFlags), commandOptions = \showOrParseArgs -> liftOptions fst setFst - (filter ((`notElem` ["constraint", "dependency", "exact-configuration"]) + (filter ((`notElem` ["constraint", "dependency", "promised-dependency", "exact-configuration"]) . optionName) $ configureOptions showOrParseArgs) ++ liftOptions snd setSnd (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) @@ -1726,9 +1726,9 @@ installCommand = CommandUI { commandOptions = \showOrParseArgs -> liftOptions get1 set1 -- Note: [Hidden Flags] - -- hide "constraint", "dependency", and + -- hide "constraint", "dependency", "promised-dependency" and -- "exact-configuration" from the configure options. - (filter ((`notElem` ["constraint", "dependency" + (filter ((`notElem` ["constraint", "dependency", "promised-dependency" , "exact-configuration"]) . optionName) $ configureOptions showOrParseArgs) diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 2f6825f983e..110a1258112 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -743,9 +743,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) @@ -757,9 +757,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") @@ -771,9 +771,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") @@ -786,7 +786,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") @@ -798,7 +798,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 ] @@ -808,7 +808,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 @@ -819,7 +819,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") @@ -831,7 +831,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" ) ] @@ -841,7 +841,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)) ] @@ -849,13 +849,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 8fcd15b1310..fc721bf309f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -563,6 +563,7 @@ instance Arbitrary ProjectConfigShared where projectConfigIndependentGoals <- arbitrary projectConfigPreferOldest <- arbitrary projectConfigProgPathExtra <- toNubList <$> listOf arbitraryShortToken + projectConfigMultiRepl <- arbitrary return ProjectConfigShared {..} where arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)] @@ -606,6 +607,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/MultiRepl/CabalTooOld/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out new file mode 100644 index 00000000000..9ad696f6e06 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-update +Downloading the latest package list from test-local-repo +# cabal v2-repl +Resolving dependencies... +Error: cabal: Could not resolve dependencies: +[__0] trying: pkg-a-0 (user goal) +[__1] next goal: pkg-a:setup.Cabal (dependency of pkg-a) +[__1] rejecting: pkg-a:setup.Cabal-/installed-, pkg-a:setup.Cabal-3.8.0.0 (constraint from --enable-multi-repl requires >=3.11) +[__1] fail (backjumping, conflict set: pkg-a, pkg-a:setup.Cabal) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pkg-a:setup.Cabal (3), pkg-a (2) diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.project new file mode 100644 index 00000000000..bf8292adeb5 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.project @@ -0,0 +1,2 @@ +packages: pkg-a/*.cabal +packages: pkg-b/*.cabal diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs new file mode 100644 index 00000000000..978b52e72ec --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest $ withRepo "repo" $ do + skipUnlessGhcVersion ">= 9.4" + void $ fails $ cabalWithStdin "v2-repl" ["--keep-temp-files","--enable-multi-repl","pkg-a", "pkg-b"] "" diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Foo.hs b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Foo.hs new file mode 100644 index 00000000000..997ca89eecd --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +foo :: Int +foo = 42 + diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Setup.hs b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..b68f934c67a --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-a/pkg-a.cabal @@ -0,0 +1,14 @@ +cabal-version: 2.2 +name: pkg-a +version: 0 +build-type: Custom + +custom-setup + setup-depends: + base >= 4 && < 5, + Cabal < 3.11 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/Bar.hs b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/Bar.hs new file mode 100644 index 00000000000..e8d379a620e --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/Bar.hs @@ -0,0 +1,6 @@ +module Bar (foo, bar) where + +import Foo (foo) + +bar :: Int +bar = 0xdeadc0de diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..8e1a273f0c4 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/pkg-b/pkg-b.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-b +version: 0 + +library + default-language: Haskell2010 + build-depends: base, pkg-a + exposed-modules: Bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/repo/Cabal-3.8.0.0/Cabal.cabal b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/repo/Cabal-3.8.0.0/Cabal.cabal new file mode 100644 index 00000000000..62f69e5d428 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/repo/Cabal-3.8.0.0/Cabal.cabal @@ -0,0 +1,5 @@ +cabal-version: 3.0 +-- Simulate an old Cabal +name: Cabal +version: 3.8.0.0 +library diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.out new file mode 100644 index 00000000000..1437190c25c --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.out @@ -0,0 +1,13 @@ +# cabal v2-repl +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - pkg-a-0 (interactive) (lib) (first run) + - pkg-b-0 (interactive) (lib) (first run) + - pkg-c-0 (interactive) (lib) (first run) +Configuring library for pkg-a-0.. +Preprocessing library for pkg-a-0.. +Configuring library for pkg-b-0.. +Preprocessing library for pkg-b-0.. +Configuring library for pkg-c-0.. +Preprocessing library for pkg-c-0.. diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.project new file mode 100644 index 00000000000..91b0dbb40ff --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.project @@ -0,0 +1,3 @@ +packages: pkg-a/*.cabal +packages: pkg-b/*.cabal +packages: pkg-c/*.cabal diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.test.hs new file mode 100644 index 00000000000..54a0afeb91e --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/cabal.test.hs @@ -0,0 +1,17 @@ +import Test.Cabal.Prelude + +main = do + cabalTest $ do + skipUnlessGhcVersion ">= 9.4" + -- Note: only the last package is interactive. + -- this test should load pkg-b too. + res <- cabalWithStdin "v2-repl" ["--enable-multi-repl","pkg-a", "pkg-c"] "" + + -- we should check that pkg-c is indeed loaded, + -- but currently the unit order is non-deterministic + -- Fix this when GHC has a way to change active unit. + -- TODO: ask for pkg-c unit, print Quu.quu + + assertOutputContains "- pkg-b-0 (interactive)" res + -- assertOutputContains "168" res + return () diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/Foo.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/Foo.hs new file mode 100644 index 00000000000..997ca89eecd --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +foo :: Int +foo = 42 + diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..e5241b65621 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-a/pkg-a.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-a +version: 0 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/Bar.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/Bar.hs new file mode 100644 index 00000000000..958a85a057e --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/Bar.hs @@ -0,0 +1,6 @@ +module Bar where + +import Foo + +bar :: Int +bar = foo + foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..8e1a273f0c4 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-b/pkg-b.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-b +version: 0 + +library + default-language: Haskell2010 + build-depends: base, pkg-a + exposed-modules: Bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/Quu.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/Quu.hs new file mode 100644 index 00000000000..b684b61e212 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/Quu.hs @@ -0,0 +1,6 @@ +module Quu where + +import Bar + +quu :: Int +quu = bar + bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/pkg-c.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/pkg-c.cabal new file mode 100644 index 00000000000..11363814d01 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledClosure/pkg-c/pkg-c.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-c +version: 0 + +library + default-language: Haskell2010 + build-depends: base, pkg-b + exposed-modules: Quu diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.out new file mode 100644 index 00000000000..c20aa4c5300 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-repl +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - pkg-a-0 (interactive) (lib) (first run) + - pkg-b-0 (interactive) (lib) (first run) +Configuring library for pkg-a-0.. +Preprocessing library for pkg-a-0.. +Configuring library for pkg-b-0.. +Preprocessing library for pkg-b-0.. diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.project new file mode 100644 index 00000000000..bf8292adeb5 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.project @@ -0,0 +1,2 @@ +packages: pkg-a/*.cabal +packages: pkg-b/*.cabal diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.test.hs new file mode 100644 index 00000000000..d7433375c94 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/cabal.test.hs @@ -0,0 +1,11 @@ +import Test.Cabal.Prelude + +main = do + cabalTest $ do + skipUnlessGhcVersion ">= 9.4" + -- the package order is non-deterministic. + -- add Bar.Bar input to test that packages are trully loaded + -- when GHC gets support for switching active units + res <- cabalWithStdin "v2-repl" ["--enable-multi-repl","pkg-a", "pkg-b"] "" + -- assertOutputContains "3735929054" res + return () diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/Foo.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/Foo.hs new file mode 100644 index 00000000000..997ca89eecd --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +foo :: Int +foo = 42 + diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..e5241b65621 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-a/pkg-a.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-a +version: 0 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/Bar.hs b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/Bar.hs new file mode 100644 index 00000000000..e8d379a620e --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/Bar.hs @@ -0,0 +1,6 @@ +module Bar (foo, bar) where + +import Foo (foo) + +bar :: Int +bar = 0xdeadc0de diff --git a/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..8e1a273f0c4 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/EnabledSucc/pkg-b/pkg-b.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-b +version: 0 + +library + default-language: Haskell2010 + build-depends: base, pkg-a + exposed-modules: Bar diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.multirepl-a.out b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.multirepl-a.out new file mode 100644 index 00000000000..1347c0477a9 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.multirepl-a.out @@ -0,0 +1,9 @@ +# cabal v2-repl +Resolving dependencies... +Error: cabal: Cannot open a repl for multiple components at once. The targets 'pkg-a' and 'pkg-b' refer to different components.. + +Your compiler supports a multiple component repl but support is not enabled. +The experimental multi repl can be enabled by + * Globally: Setting multi-repl: True in your .cabal/config + * Project Wide: Setting multi-repl: True in your cabal.project file + * Per Invocation: By passing --enable-multi-repl when starting the repl diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.project new file mode 100644 index 00000000000..bf8292adeb5 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.project @@ -0,0 +1,2 @@ +packages: pkg-a/*.cabal +packages: pkg-b/*.cabal diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.test.hs new file mode 100644 index 00000000000..e5207a203ff --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/cabal.test.hs @@ -0,0 +1,14 @@ +import Test.Cabal.Prelude + +main = do + cabalTest' "multirepl-a" $ do + skipUnlessGhcVersion ">= 9.4" + res <- fails $ cabalWithStdin "v2-repl" ["--disable-multi-repl","pkg-a", "pkg-b"] "foo" + assertOutputContains "Cannot open a repl for multiple components at once." res + assertOutputContains "Your compiler supports a multiple component repl but support is not enabled." res + + cabalTest' "multirepl-b" $ do + skipUnlessGhcVersion "< 9.4" + res <- fails $ cabalWithStdin "v2-repl" ["--disable-multi-repl","pkg-a", "pkg-b"] "foo" + assertOutputContains "Cannot open a repl for multiple components at once." res + assertOutputContains "The reason for this limitation is that your version" res diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/Foo.hs b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/Foo.hs new file mode 100644 index 00000000000..997ca89eecd --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/Foo.hs @@ -0,0 +1,5 @@ +module Foo where + +foo :: Int +foo = 42 + diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/pkg-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/pkg-a.cabal new file mode 100644 index 00000000000..e5241b65621 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-a/pkg-a.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-a +version: 0 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Foo diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/Bar.hs b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/Bar.hs new file mode 100644 index 00000000000..1dc878062ab --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/Bar.hs @@ -0,0 +1,4 @@ +module Bar where + +bar :: Int +bar = 0xdeadc0de diff --git a/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/pkg-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/pkg-b.cabal new file mode 100644 index 00000000000..0051d38106d --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/NotEnabledFail/pkg-b/pkg-b.cabal @@ -0,0 +1,8 @@ +cabal-version: 2.2 +name: pkg-b +version: 0 + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: Bar diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out index e492d1b1f88..6cb266721a1 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 '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:script-script.hs) (ephemeral targets) + - fake-package-0 (interactive) (exe:script-script.hs) (configuration changed) +Configuring executable '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 369c11213fd..5862609f652 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:script-script.hs) (first run) + - fake-package-0 (interactive) (exe:script-script.hs) (first run) Configuring executable '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 eb2e5aed262..71dbd3b5758 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:script-script.hs) (first run) + - fake-package-0 (interactive) (exe:script-script.hs) (first run) Configuring executable '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:script-script.hs) (first run) + - fake-package-0 (interactive) (exe: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..ece53ac08d2 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 (interactive) (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..ec3ab736e30 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 (interactive) (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..ece53ac08d2 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 (interactive) (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..ece53ac08d2 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 (interactive) (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..c0f7b65dbfe 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 (interactive) (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..c0f7b65dbfe 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 (interactive) (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..f4e64481ff0 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 (interactive) (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..c0f7b65dbfe 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 (interactive) (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..c0f7b65dbfe 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 (interactive) (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 a72770fb1c0..adb079d207f 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","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-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","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-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","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-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","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-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","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-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","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-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","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-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","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-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"] + }) diff --git a/changelog.d/pr-8726 b/changelog.d/pr-8726 new file mode 100644 index 00000000000..fa9975a33bb --- /dev/null +++ b/changelog.d/pr-8726 @@ -0,0 +1,18 @@ +synopsis: Add support for loading multiple components into one repl session +packages: cabal-install +prs: #8726 #8238 #8491 + +description: { + +The `repl` command is extended in order to allow starting a repl session with +multiple local components. When a user specifies a target to the "repl" command +which resolves to multiple local components then `cabal` will start a repl session +which loads them all into a single GHC session if the multi-repl is enabled. + +The multi-repl can be enabled by passing `--enable-multi-repl`, or writing `multi-repl: True` in +your cabal.project file. + +The feature is fully explained in [this blog post](https://well-typed.com/blog/2023/03/cabal-multi-unit/). + + +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 02dcddea5dd..4ad2fba355d 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -801,10 +801,6 @@ Local packages can also be specified, in which case the library component in the package will be used, or the (first listed) executable in the package if there is no library. Dependencies are built or rebuilt as necessary. -Currently, it is not supported to pass multiple targets to ``repl`` -(``repl`` will just successively open a separate GHCi session for -each target.) - Examples: :: @@ -869,6 +865,19 @@ The configuration information for the script is cached under the cabal directory and can be pre-built with ``cabal build path/to/script``. See ``cabal run`` for more information on scripts. +.. option:: --enable-multi-repl + + Allow starting GHCi with multiple targets. + This requires GHC with multiple home unit support (GHC-9.4+) + + The closure of required components will be loaded. + +.. option:: --disable-multi-repl + + Disallow starting GHCi with multiple targets. This reverts back to the behaviour + in version 3.10 and earlier where only a single component can be loaded at + once. + .. _cabal run: cabal run diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index ec3d8a08fd7..86d4263cfa0 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -880,6 +880,21 @@ feature was added. The command line variant of this flag is ``--enable-benchmarks`` and ``--disable-benchmarks``. +.. cfg-field:: multi-repl: boolean + --enable-multi-repl + --disable-multi-repl + :synopsis: Enable starting a repl with multiple targets. + + :default: ``False`` + + Allow starting GHCi with multiple targets. This requires GHC with multiple + home unit support (GHC-9.4+). + + The closure of required components will be loaded. + + The command line variant of this flag is ``--enable-multi-repl`` and + ``--disable-multi-repl``. + .. cfg-field:: extra-prog-path: paths (newline or comma separated) --extra-prog-path=PATH :synopsis: Add directories to program search path. diff --git a/doc/internal/multi-repl.md b/doc/internal/multi-repl.md new file mode 100644 index 00000000000..5f0f731e393 --- /dev/null +++ b/doc/internal/multi-repl.md @@ -0,0 +1,218 @@ +--- +author: matthew +title: Multiple Component support for cabal repl +postName: cabal-multi-unit +categories: cabal, ghc, hls, hasura, open-source +showtoc: true +--- + +Following on from [our work implementing support for compiling multiple units +at once in GHC](https://well-typed.com/blog/2022/01/multiple-home-units/), we have now been extending the ecosystem to take +advantage of this new support. This work has once again been made possible by +[Hasura](https://hasura.io/). This work continues our productive and +[long-running +collaboration](https://well-typed.com/blog/2022/05/hasura-supports-haskell-tooling/) +on important and difficult tooling tasks which will ultimately benefit the +entire ecosystem. + +This post focuses on updates to the `cabal repl` command, allowing +multiple components to be loaded at once into an interactive session. The work is being +reviewed in [Cabal MR #8726](https://github.com/haskell/cabal/pull/8726), and should +be available in a future release of `cabal-install`. + + + +# Multiple Component Repl + +When using `cabal`, most commands take a "target" which specifies which units you want +to operate on. A command such as `cabal build ` will resolve all the units that +the target `` resolves to, and build all of them. The behaviour of the `cabal repl` +command is different: you must specify a single unit to build. + +Here are some common targets which you can specify when using `cabal`. + +* `all`: Build all the locally defined components. +* `exe:haskell-language-server`: Build the executable called `haskell-language-server` +* `lib:pkg-a lib:pkg-b`: Build the local libraries pkg-a and pkg-b. +* `src/Main.hs`: Build the unit which `src/Main.hs` belongs to. + +After enabling multi-repl, passing a target specification to `cabal repl` which +resolves to multiple units will load all those units into a single repl session. +For example: + +``` +cabal repl --enable-multi-repl lib:pkg-a lib:pkg-b +``` + +When the modules are compiled, the unit which they came from is listed next +to the module name. The `interactive` herald in the build plan indicates that +the library will be loaded into GHCi rather than being built like a normal package. + +``` +In order, the following will be built (use -v for more details): + - pkg-a-0 (interactive) (lib) (first run) + - pkg-b-0 (interactive) (lib) (dependency rebuilt) +Preprocessing library for pkg-a-0.. +Preprocessing library for pkg-b-0.. +GHCi, version 9.4.3: https://www.haskell.org/ghc/ :? for help +[1 of 2] Compiling Foo[pkg-a-0-inplace] +[2 of 2] Compiling Bar[pkg-b-0-inplace] +Ok, two modules loaded. +``` + +You will need to use at least `ghc-9.4.1` in order to use multiple unit support. +It's advised to use `ghc-9.4.5` or `9.6.1`, in order to benefit from bug fixes. + +## Enabling Multi-repl + +There are three ways to enable the multi-repl depending on how much you like it: + +* Globally: Add `multi-repl: True` to your `~/.cabal/config` file. +* Project-wide: Add `multi-repl: True` to your cabal.project file. +* Per-invocation: Pass `--enable-multi-repl` when invoking `cabal repl`. + +A future cabal version is likely to enable multi-repl by default. For the time being, +and due to the experimental nature of the command and lack of support in ghci for some features, +the multi-repl feature is opt-in. + +# Closure Property for Multiple Home Units + +For tools or libraries using the GHC API there is one very [important closure property](https://well-typed.com/blog/2022/01/multiple-home-units/#closure-property-for-home-units) +which must be adhered to: + +> Any dependency which is not a home unit must not (transitively) depend on a home unit. + +For example, if you have three units `p`, `q` and `r`, and `p` depends on `q` which depends on `r`, then it +is illegal to load both `p` and `r` as home units but not `q`, because `q` is a dependency of the home unit `p` which depends +on another home unit `r`. + +`cabal` will automatically enable loading of all units which are needed by the closure +property (including non-local) packages. Given the previous example, if you specify +on the command line `cabal repl lib:p lib:q` then `lib:r` will also be loaded +into the same session as it is needed for the closure property. + +# Configuring and Promised Dependencies + +The lowest-level interface which the `Cabal` library provides in order to build a package +is the [`Setup.hs` script](https://cabal.readthedocs.io/en/3.10/setup-commands.html). +This consists of a normal Haskell file which depends on the `Cabal` library and can be executed +in order to build the package. This is done, after compiling `Setup.hs`, via the following invocations: + +``` +./Setup configure +./Setup build +``` + +The `configure` phase checks to make sure that everything is in order so that when +the build phase is run we know that all the environmental dependencies have already +been provisioned by the user. + +In the very old days, people would compile and run `Setup.hs` themselves in order to +build a package, but these days, all the interactions with `Setup.hs` are managed by a +higher-level build tool such as `cabal-install`, `stack` or `nix`. All of these tools +ultimately call `Setup.hs` scripts. + +The main technical change to enable the multi-repl was to modify the `Setup.hs` +scripts to allow you to configure a package before all its dependencies are +built. Now you can **promise** to `Setup.hs` +that a certain dependency will be built by the time we attempt to build the unit. Since +all units in a project are going to be built at the same time with one GHC invocation, they +all need to be configured before anything else is built. So we just **promise** that all local +packages will be built. + +``` +./Setup configure --promised-dependency=pkg-a +``` + +In addition to the `configure` and `build` commands, `Setup.hs` also provides a `repl` +command which starts `GHCi` and loads a single component. + +``` +./Setup repl +``` + +This design is quite awkward because the `Setup.hs` scripts operate on a per-component basis. The +interface is not aware of the existence of complicated multi-component projects, that is solely the +domain of higher-level tools like `cabal-install`. Therefore, instead of starting the repl from +the `Setup.hs` script, we need to start a multi-repl from `cabal-install`. However, the `Setup.hs` +script is still responsible for computing the arguments we need to pass to GHC in order to compile +that component. The solution is to allow the `repl` command to write its arguments into a file +so that they can be collected later by `cabal-install` to correctly start a multi-component session. + +``` +./Setup repl --repl-multi-file=multi-args +# Arguments can be found in the `multi-args` directory. +``` + +This allows all the units in your project to be configured before any of them are built. +After a project is configured, the `Setup` executable can be consulted to find out what +options GHC **would** use to build the unit, and because we have **promised** to +make sure things are built in the right order, we can supply these options to GHC +in order to start a multi unit GHCi session. + +# HLS support for multiple home units + +Zubin has already updated HLS to use native multiple home unit support for GHC-9.4. + +The missing piece has been a mechanism to set up a multi component session which +satisfies the closure property. Without such a mechanism, HLS would construct a multiple component session +incrementally by adding units to a session as they are opened by the user. For a complicated +project structure, users would have to very carefully load their files in the right order to +get a session which worked correctly. +Even worse, this doesn't even work when a non-local package is needed to satisfy the +closure property. + +HLS consults cabal in order to set up a session: it invokes `cabal repl` +and intercepts the final call to `ghc` which would start the repl. That command is then +used as the options which are needed for the session in order to compile that unit. + +Now that `cabal repl` supports creating a command line which specifies the options +for multiple components at once, it makes sense to augment the HLS session loading logic +to also understand these command lines in order to set up a whole multi-component session +at once. + +HLS now can understand and parse the kind of command line produced by a multiple +component session. As a result: + +* The correct session is initialised up-front. Loading any component in your + local project will work seamlessly and quickly. +* The time taken to initialise a session is reduced, because no local dependencies + are built before the session is started. All local components are configured + before anything is built. +* Cabal ensures the closure property holds, even for non-local packages. + +I have been testing this support when working on `cabal` and `ghc`, both projects +with many local dependencies and the experience is much improved. In particular for +`cabal`, the non-local `hackage-security` package is needed for the closure property but could +never be loaded before. This made using HLS on `cabal` very error-prone because if +you opened a file from the `Cabal` library and `cabal-install` library, you would +break the session without a way to recover it. For `ghc`, it is a lifeline to be able to +edit packages like `template-haskell` and see the changes ripple upwards through all +the boot libraries and compiler. + +# Limitations + +Now that there is a way to easily create and invoke a multi-repl session, +users are probably going to run into limitations of the multi-repl. + +Many features are not yet implemented because there is not a good way to change what +the "active unit" of the repl session is. Some more careful thinking needs to be done +to modify the GHCi interface in order to work nicely with multiple components in all situations. + +At this time, the multi-repl is best used for interactive development situations where +you want to use the repl to obtain fast-feedback about your project. +We have made sure that the multi-repl works with `ghcid` for example. + +# Conclusion + +Adding `cabal repl` support for multiple home units allows developers to easily +interact with multiple home unit support in GHC. There are still limitations to +the repl supported in multiple unit sessions, but as more users start using and wanting this +feature we hope to expand the repl to work properly with multiple home units as well. + +Well-Typed is able to work on GHC, HLS, Cabal and other core Haskell +infrastructure thanks to funding from various sponsors. If your company might be +able to contribute to this work, sponsor maintenance efforts, or fund the +implementation of other features, please +[read about how you can help](/blog/2022/11/funding-ghc-maintenance) or +[get in touch](mailto:info@well-typed.com).