1 {-# LANGUAGE NamedFieldPuns #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE RecordWildCards #-}
4 {-# LANGUAGE TypeApplications #-}
6 -- | cabal-install CLI command: repl
7 module Distribution
.Client
.CmdRepl
8 ( -- * The @repl@ CLI and action
13 -- * Internals exposed for testing
14 , matchesMultipleProblem
15 , selectPackageTargets
16 , selectComponentTarget
17 , MultiReplDecision
(..)
20 import Distribution
.Client
.Compat
.Prelude
23 import Distribution
.Compat
.Lens
24 import qualified Distribution
.Types
.Lens
as L
26 import Distribution
.Client
.CmdErrorMessages
33 , renderTargetSelector
36 , targetSelectorRefersToPkgs
38 import Distribution
.Client
.DistDirLayout
41 import Distribution
.Client
.Errors
42 import qualified Distribution
.Client
.InstallPlan
as InstallPlan
43 import Distribution
.Client
.NixStyleOptions
45 , defaultNixStyleFlags
48 import Distribution
.Client
.ProjectBuilding
49 ( improveInstallPlanWithUpToDatePackages
50 , rebuildTargetsDryRun
52 import Distribution
.Client
.ProjectOrchestration
53 import Distribution
.Client
.ProjectPlanning
54 ( ElaboratedInstallPlan
55 , ElaboratedSharedConfig
(..)
57 import Distribution
.Client
.ProjectPlanning
.Types
58 ( elabOrderExeDependencies
59 , showElaboratedInstallPlan
61 import Distribution
.Client
.ScriptUtils
62 ( AcceptNoTargets
(..)
64 , fakeProjectSourcePackage
66 , updateContextAndWriteProjectFile
67 , updateContextAndWriteProjectFile
'
68 , withContextAndSelectors
70 import Distribution
.Client
.Setup
74 import qualified Distribution
.Client
.Setup
as Client
75 import Distribution
.Client
.TargetProblem
78 import Distribution
.Client
.Targets
80 , UserConstraintScope
(..)
82 import Distribution
.Client
.Types
83 ( PackageSpecifier
(..)
84 , UnresolvedSourcePackage
86 import Distribution
.Compiler
87 ( CompilerFlavor
(GHC
)
89 import Distribution
.Package
96 import Distribution
.Simple
.Command
100 import Distribution
.Simple
.Compiler
102 , compilerCompatVersion
104 import Distribution
.Simple
.Setup
106 , commonSetupTempFileOptions
109 import Distribution
.Simple
.Utils
112 , withTempDirectoryEx
115 import Distribution
.Solver
.Types
.ConstraintSource
116 ( ConstraintSource
(ConstraintSourceMultiRepl
)
118 import Distribution
.Solver
.Types
.PackageConstraint
119 ( PackageProperty
(PackagePropertyVersion
)
121 import Distribution
.Solver
.Types
.SourcePackage
124 import Distribution
.Types
.BuildInfo
128 import Distribution
.Types
.ComponentName
129 ( componentNameString
131 import Distribution
.Types
.CondTree
134 import Distribution
.Types
.Dependency
138 import Distribution
.Types
.Library
142 import Distribution
.Types
.ParStrat
143 import Distribution
.Types
.Version
147 import Distribution
.Types
.VersionRange
151 import Distribution
.Utils
.Generic
154 import Distribution
.Verbosity
158 import Language
.Haskell
.Extension
162 import Control
.Monad
(mapM)
163 import qualified Data
.ByteString
.Lazy
as BS
167 import qualified Data
.Map
as Map
168 import qualified Data
.Set
as Set
169 import Distribution
.Client
.ProjectConfig
170 ( ProjectConfig
(projectConfigShared
)
171 , ProjectConfigShared
(projectConfigConstraints
, projectConfigMultiRepl
)
173 import Distribution
.Client
.ReplFlags
174 ( EnvFlags
(envIncludeTransitive
, envPackages
)
179 import Distribution
.Compat
.Binary
(decode
)
180 import Distribution
.Simple
.Flag
(Flag
(Flag
), fromFlagOrDefault
)
181 import Distribution
.Simple
.Program
.Builtin
(ghcProgram
)
182 import Distribution
.Simple
.Program
.Db
(requireProgram
)
183 import Distribution
.Simple
.Program
.Run
185 , runProgramInvocation
187 import Distribution
.Simple
.Program
.Types
188 ( ConfiguredProgram
(programOverrideEnv
)
190 import System
.Directory
192 , getCurrentDirectory
196 import System
.FilePath
197 ( searchPathSeparator
202 replCommand
:: CommandUI
(NixStyleFlags ReplFlags
)
204 Client
.installCommand
205 { commandName
= "v2-repl"
206 , commandSynopsis
= "Open an interactive session for the given component."
207 , commandUsage
= usageAlternatives
"v2-repl" ["[TARGET] [FLAGS]"]
208 , commandDescription
= Just
$ \_
->
210 "Open an interactive session for a component within the project. The "
211 ++ "available targets are the same as for the 'v2-build' command: "
212 ++ "individual components within packages in the project, including "
213 ++ "libraries, executables, test-suites or benchmarks. Packages can "
214 ++ "also be specified in which case the library component in the "
215 ++ "package will be used, or the (first listed) executable in the "
216 ++ "package if there is no library.\n\n"
217 ++ "Dependencies are built or rebuilt as necessary. Additional "
218 ++ "configuration flags can be specified on the command line and these "
219 ++ "extend the project configuration from the 'cabal.project', "
220 ++ "'cabal.project.local' and other files."
221 , commandNotes
= Just
$ \pname
->
222 "Examples, open an interactive session:\n"
226 ++ " for the default component in the package in the current directory\n"
229 ++ " v2-repl pkgname\n"
230 ++ " for the default component in the package named 'pkgname'\n"
233 ++ " v2-repl ./pkgfoo\n"
234 ++ " for the default component in the package in the ./pkgfoo directory\n"
237 ++ " v2-repl cname\n"
238 ++ " for the component named 'cname'\n"
241 ++ " v2-repl pkgname:cname\n"
242 ++ " for the component 'cname' in the package 'pkgname'\n\n"
245 ++ " v2-repl --build-depends lens\n"
246 ++ " add the latest version of the library 'lens' to the default component "
247 ++ "(or no componentif there is no project present)\n"
250 ++ " v2-repl --build-depends \"lens >= 4.15 && < 4.18\"\n"
251 ++ " add a version (constrained between 4.15 and 4.18) of the library 'lens' "
252 ++ "to the default component (or no component if there is no project present)\n"
253 , commandDefaultFlags
= defaultNixStyleFlags defaultReplFlags
254 , commandOptions
= nixStyleOptions topReplOptions
257 data MultiReplDecision
= MultiReplDecision
258 { compilerVersion
:: Maybe Version
259 , enabledByFlag
:: Bool
263 useMultiRepl
:: MultiReplDecision
-> Bool
264 useMultiRepl MultiReplDecision
{compilerVersion
, enabledByFlag
} =
265 compilerVersion
>= Just minMultipleHomeUnitsVersion
&& enabledByFlag
267 multiReplDecision
:: ProjectConfigShared
-> Compiler
-> ReplFlags
-> MultiReplDecision
268 multiReplDecision ctx compiler flags
=
270 -- Check if the compiler is new enough, need at least 9.4 to start a multi session
271 (compilerCompatVersion GHC compiler
)
272 -- Then check the user actually asked for it, either via the project file, the global config or
273 -- a repl specific option.
274 (fromFlagOrDefault
False (projectConfigMultiRepl ctx
<> replUseMulti flags
))
276 -- | The @repl@ command is very much like @build@. It brings the install plan
277 -- up to date, selects that part of the plan needed by the given or implicit
278 -- repl target and then executes the plan.
280 -- Compared to @build@ the difference is that multiple targets are handled
281 -- specially and the target type is repl rather than build. The
282 -- general plan execution infrastructure handles both build and repl targets.
284 -- For more details on how this works, see the module
285 -- "Distribution.Client.ProjectOrchestration"
286 replAction
:: NixStyleFlags ReplFlags
-> [String] -> GlobalFlags
-> IO ()
287 replAction flags
@NixStyleFlags
{extraFlags
= r
@ReplFlags
{..}, ..} targetStrings globalFlags
=
288 withContextAndSelectors AcceptNoTargets
(Just LibKind
) flags targetStrings globalFlags ReplCommand
$ \targetCtx ctx targetSelectors
-> do
289 when (buildSettingOnlyDeps
(buildSettings ctx
)) $
290 dieWithException verbosity ReplCommandDoesn
'tSupport
291 let projectRoot
= distProjectRootDirectory
$ distDirLayout ctx
292 distDir
= distDirectory
$ distDirLayout ctx
294 baseCtx
<- case targetCtx
of
295 ProjectContext
-> return ctx
297 unless (null targetStrings
) $
298 dieWithException verbosity
$
299 ReplTakesNoArguments targetStrings
302 fakeProjectSourcePackage projectRoot
303 & lSrcpkgDescription
. L
.condLibrary
304 .~ Just
(CondNode library
[baseDep
] [])
305 library
= emptyLibrary
{libBuildInfo
= lBuildInfo
}
308 { targetBuildDepends
= [baseDep
]
309 , defaultLanguage
= Just Haskell2010
311 baseDep
= Dependency
"base" anyVersion mainLibSet
313 updateContextAndWriteProjectFile
' ctx sourcePackage
314 ScriptContext scriptPath scriptExecutable
-> do
315 unless (length targetStrings
== 1) $
316 dieWithException verbosity
$
317 ReplTakesSingleArgument targetStrings
318 existsScriptPath
<- doesFileExist scriptPath
319 unless existsScriptPath
$
320 dieWithException verbosity
$
321 ReplTakesSingleArgument targetStrings
323 updateContextAndWriteProjectFile ctx scriptPath scriptExecutable
325 -- If multi-repl is used, we need a Cabal recent enough to handle it.
326 -- We need to do this before solving, but the compiler version is only known
327 -- after solving (phaseConfigureCompiler), so instead of using
328 -- multiReplDecision we just check the flag.
330 if fromFlagOrDefault
False $
331 projectConfigMultiRepl
(projectConfigShared
$ projectConfig baseCtx
)
335 & lProjectConfig
. lProjectConfigShared
. lProjectConfigConstraints
336 %~
(multiReplCabalConstraint
:)
339 (originalComponent
, baseCtx
'') <-
340 if null (envPackages replEnvFlags
)
341 then return (Nothing
, baseCtx
')
342 else -- Unfortunately, the best way to do this is to let the normal solver
343 -- help us resolve the targets, but that isn't ideal for performance,
344 -- especially in the no-project case.
345 withInstallPlan
(lessVerbose verbosity
) baseCtx
' $ \elaboratedPlan sharedConfig
-> do
346 -- targets should be non-empty map, but there's no NonEmptyMap yet.
347 targets
<- validatedTargets
(projectConfigShared
(projectConfig ctx
)) (pkgConfigCompiler sharedConfig
) elaboratedPlan targetSelectors
350 (unitId
, _
) = fromMaybe (error "panic: targets should be non-empty") $ safeHead
$ Map
.toList targets
351 originalDeps
= installedUnitId
<$> InstallPlan
.directDeps elaboratedPlan unitId
352 oci
= OriginalComponentInfo unitId originalDeps
353 pkgId
= fromMaybe (error $ "cannot find " ++ prettyShow unitId
) $ packageId
<$> InstallPlan
.lookup elaboratedPlan unitId
354 baseCtx
'' = addDepsToProjectTarget
(envPackages replEnvFlags
) pkgId baseCtx
'
356 return (Just oci
, baseCtx
'')
358 -- Now, we run the solver again with the added packages. While the graph
359 -- won't actually reflect the addition of transitive dependencies,
360 -- they're going to be available already and will be offered to the REPL
361 -- and that's good enough.
363 -- In addition, to avoid a *third* trip through the solver, we are
364 -- replicating the second half of 'runProjectPreBuildPhase' by hand
366 (buildCtx
, compiler
, replOpts
', targets
) <- withInstallPlan verbosity baseCtx
'' $
367 \elaboratedPlan elaboratedShared
' -> do
368 let ProjectBaseContext
{..} = baseCtx
''
370 -- Recalculate with updated project.
371 targets
<- validatedTargets
(projectConfigShared projectConfig
) (pkgConfigCompiler elaboratedShared
') elaboratedPlan targetSelectors
375 pruneInstallPlanToTargets
379 includeTransitive
= fromFlagOrDefault
True (envIncludeTransitive replEnvFlags
)
387 let elaboratedPlan
'' =
388 improveInstallPlanWithUpToDatePackages
391 debugNoWrap verbosity
(showElaboratedInstallPlan elaboratedPlan
'')
396 { elaboratedPlanOriginal
= elaboratedPlan
397 , elaboratedPlanToExecute
= elaboratedPlan
''
398 , elaboratedShared
= elaboratedShared
'
400 , targetsMap
= targets
403 ElaboratedSharedConfig
{pkgConfigCompiler
= compiler
} = elaboratedShared
'
405 repl_flags
= case originalComponent
of
406 Just oci
-> generateReplFlags includeTransitive elaboratedPlan
' oci
409 return (buildCtx
, compiler
, configureReplOptions
& lReplOptionsFlags
%~
(++ repl_flags
), targets
)
411 -- Multi Repl implemention see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for
412 -- a high-level overview about how everything fits together.
413 if Set
.size
(distinctTargetComponents targets
) > 1
414 then withTempDirectoryEx verbosity tempFileOptions distDir
"multi-out" $ \dir
' -> do
416 dir
<- makeAbsolute dir
'
417 -- Modify the replOptions so that the ./Setup repl command will write options
418 -- into the multi-out directory.
419 replOpts
'' <- case targetCtx
of
420 ProjectContext
-> return $ replOpts
'{replOptionsFlagOutput
= Flag dir
}
421 _
-> usingGhciScript compiler projectRoot replOpts
'
423 let buildCtx
' = buildCtx
& lElaboratedShared
. lPkgConfigReplOptions
.~ replOpts
''
424 printPlan verbosity baseCtx
'' buildCtx
'
426 -- The project build phase will call `./Setup repl` but write the options
427 -- out into a file without starting a repl.
428 buildOutcomes
<- runProjectBuildPhase verbosity baseCtx
'' buildCtx
'
429 runProjectPostBuildPhase verbosity baseCtx
'' buildCtx
' buildOutcomes
431 -- calculate PATH, we construct a PATH which is the union of all paths from
432 -- the units which have been loaded. This is not quite right but usually works fine.
433 path_files
<- listDirectory
(dir
</> "paths")
435 -- Note: decode is partial. Should we use Structured here?
436 -- This might blow up with @build-type: Custom@ stuff.
437 ghcProgs
<- mapM (\f -> decode
@ConfiguredProgram
<$> BS
.readFile (dir
</> "paths" </> f
)) path_files
439 let all_paths
= concatMap programOverrideEnv ghcProgs
440 let sp
= intercalate
[searchPathSeparator
] (map fst (sortBy (comparing
@Int snd) $ Map
.toList
(combine_search_paths all_paths
)))
441 -- HACK: Just combine together all env overrides, placing the most common things last
443 -- ghc program with overriden PATH
444 (ghcProg
, _
) <- requireProgram verbosity ghcProgram
(pkgConfigCompilerProgs
(elaboratedShared buildCtx
'))
445 let ghcProg
' = ghcProg
{programOverrideEnv
= [("PATH", Just sp
)]}
447 -- Find what the unit files are, and start a repl based on all the response
448 -- files which have been created in the directory.
449 -- unit files for components
450 unit_files
<- listDirectory dir
452 -- Order the unit files so that the find target becomes the active unit
453 let active_unit_fp
:: Maybe FilePath
455 -- Get the first target selectors from the cli
456 activeTarget
<- safeHead targetSelectors
457 -- Lookup the targets :: Map UnitId [(ComponentTarget, NonEmpty TargetSelector)]
460 -- Keep the UnitId matching the desired target selector
461 & find (\(_
, xs
) -> any (\(_
, selectors
) -> activeTarget `
elem` selectors
) xs
)
463 -- Convert to filename (adapted from 'storePackageDirectory')
464 pure
(prettyShow unitId
)
465 unit_files_ordered
:: [FilePath]
467 let (active_unit_files
, other_units
) = partition (\fp
-> Just fp
== active_unit_fp
) unit_files
468 in -- GHC considers the last unit passed to be the active one
469 other_units
++ active_unit_files
471 render_j Serial
= "1"
472 render_j
(UseSem n
) = show @Int n
473 render_j
(NumJobs mn
) = maybe "" (show @Int) mn
475 -- run ghc --interactive with
476 runProgramInvocation verbosity
$
477 programInvocation ghcProg
' $
481 , "-" -- to ignore ghc.environment.* files
483 , render_j
(buildSettingNumJobs
(buildSettings ctx
))
485 : [ ["-unit", "@" ++ dir
</> unit
]
486 | unit
<- unit_files_ordered
492 -- single target repl
493 replOpts
'' <- case targetCtx
of
494 ProjectContext
-> return replOpts
'
495 _
-> usingGhciScript compiler projectRoot replOpts
'
497 let buildCtx
' = buildCtx
& lElaboratedShared
. lPkgConfigReplOptions
.~ replOpts
''
498 printPlan verbosity baseCtx
'' buildCtx
'
500 buildOutcomes
<- runProjectBuildPhase verbosity baseCtx
'' buildCtx
'
501 runProjectPostBuildPhase verbosity baseCtx
'' buildCtx
' buildOutcomes
503 combine_search_paths paths
=
504 foldl' go Map
.empty paths
506 go m
("PATH", Just s
) = foldl' (\m
' f
-> Map
.insertWith
(+) f
1 m
') m
(splitSearchPath s
)
509 verbosity
= fromFlagOrDefault normal
(setupVerbosity
$ configCommonFlags configFlags
)
510 tempFileOptions
= commonSetupTempFileOptions
$ configCommonFlags configFlags
512 validatedTargets ctx compiler elaboratedPlan targetSelectors
= do
513 let multi_repl_enabled
= multiReplDecision ctx compiler r
514 -- Interpret the targets on the command line as repl targets
515 -- (as opposed to say build or haddock targets).
517 either (reportTargetProblems verbosity
) return $
519 (selectPackageTargets multi_repl_enabled
)
520 selectComponentTarget
525 -- Reject multiple targets, or at least targets in different
526 -- components. It is ok to have two module/file targets in the
527 -- same component, but not two that live in different components.
528 when (Set
.size
(distinctTargetComponents targets
) > 1 && not (useMultiRepl multi_repl_enabled
)) $
531 [multipleTargetsProblem multi_repl_enabled targets
]
535 -- This is the constraint setup.Cabal>=3.11. 3.11 is when Cabal options
536 -- used for multi-repl were introduced.
537 -- Idelly we'd apply this constraint only on the closure of repl targets,
538 -- but that would require another solver run for marginal advantages that
539 -- will further shrink as 3.11 is adopted.
540 multiReplCabalConstraint
=
542 (UserAnySetupQualifier
(mkPackageName
"Cabal"))
543 (PackagePropertyVersion
$ orLaterVersion
$ mkVersion
[3, 11])
544 , ConstraintSourceMultiRepl
547 -- | First version of GHC which supports multiple home packages
548 minMultipleHomeUnitsVersion
:: Version
549 minMultipleHomeUnitsVersion
= mkVersion
[9, 4]
551 data OriginalComponentInfo
= OriginalComponentInfo
552 { ociUnitId
:: UnitId
553 , ociOriginalDeps
:: [UnitId
]
557 addDepsToProjectTarget
560 -> ProjectBaseContext
561 -> ProjectBaseContext
562 addDepsToProjectTarget deps pkgId ctx
=
563 (\p
-> ctx
{localPackages
= p
}) . fmap addDeps
. localPackages
$ ctx
566 :: PackageSpecifier UnresolvedSourcePackage
567 -> PackageSpecifier UnresolvedSourcePackage
568 addDeps
(SpecificSourcePackage pkg
)
569 | packageId pkg
/= pkgId
= SpecificSourcePackage pkg
570 | SourcePackage
{..} <- pkg
=
571 SpecificSourcePackage
$
573 { srcpkgDescription
=
574 -- New dependencies are added to the original ones found in the
575 -- `targetBuildDepends` field.
576 -- `traverseBuildInfos` is used in order to update _all_ the
577 -- occurrences of the field `targetBuildDepends`. It ensures that
578 -- fields depending on the latter are also consistently updated.
580 & (L
.traverseBuildInfos
. L
.targetBuildDepends
)
585 generateReplFlags
:: Bool -> ElaboratedInstallPlan
-> OriginalComponentInfo
-> [String]
586 generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo
{..} = flags
591 (InstallPlan
.foldPlanPackage
(const []) elabOrderExeDependencies
)
592 (InstallPlan
.dependencyClosure elaboratedPlan
[ociUnitId
])
594 deps
, deps
', trans
, trans
' :: [UnitId
]
596 deps
= installedUnitId
<$> InstallPlan
.directDeps elaboratedPlan ociUnitId
597 deps
' = deps
\\ ociOriginalDeps
598 trans
= installedUnitId
<$> InstallPlan
.dependencyClosure elaboratedPlan deps
'
599 trans
' = trans
\\ ociOriginalDeps
601 fmap (("-package-id " ++) . prettyShow
) . (\\ exeDeps
) $
602 if includeTransitive
then trans
' else deps
'
604 -- | Add repl options to ensure the repl actually starts in the current working directory.
606 -- In a global or script context, when we are using a fake package, @cabal repl@
607 -- starts in the fake package directory instead of the directory it was called from,
608 -- so we need to tell ghci to change back to the correct directory.
610 -- The @-ghci-script@ flag is path to the ghci script responsible for changing to the
611 -- correct directory. Only works on GHC >= 7.6, though. 🙁
612 usingGhciScript
:: Compiler
-> FilePath -> ReplOptions
-> IO ReplOptions
613 usingGhciScript compiler projectRoot replOpts
614 | compilerCompatVersion GHC compiler
>= Just minGhciScriptVersion
= do
615 let ghciScriptPath
= projectRoot
</> "setcwd.ghci"
616 cwd
<- getCurrentDirectory
617 writeFile ghciScriptPath
(":cd " ++ cwd
)
618 return $ replOpts
& lReplOptionsFlags
%~
(("-ghci-script" ++ ghciScriptPath
) :)
619 |
otherwise = return replOpts
621 -- | First version of GHC where GHCi supported the flag we need.
622 -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html
623 minGhciScriptVersion
:: Version
624 minGhciScriptVersion
= mkVersion
[7, 6]
626 -- | This defines what a 'TargetSelector' means for the @repl@ command.
627 -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
628 -- or otherwise classifies the problem.
630 -- For repl we select:
632 -- * the library if there is only one and it's buildable; or
634 -- * the exe if there is only one and it's buildable; or
636 -- * any other buildable component.
638 -- Fail if there are no buildable lib\/exe components, or if there are
639 -- multiple libs or exes.
643 -> [AvailableTarget k
]
644 -> Either ReplTargetProblem
[k
]
645 selectPackageTargets multiple_targets_allowed
=
646 -- If explicitly enabled, then select the targets like we would for multi-repl but
647 -- might still fail later because of compiler version.
648 if enabledByFlag multiple_targets_allowed
649 then selectPackageTargetsMulti
650 else selectPackageTargetsSingle multiple_targets_allowed
652 selectPackageTargetsMulti
654 -> [AvailableTarget k
]
655 -> Either ReplTargetProblem
[k
]
656 selectPackageTargetsMulti targetSelector targets
657 |
not (null targetsBuildable
) =
658 Right targetsBuildable
659 -- If there are no targets at all then we report that
661 Left
(TargetProblemNoTargets targetSelector
)
666 selectBuildableTargetsWith
'
667 (isRequested targetSelector
)
670 -- When there's a target filter like "pkg:tests" then we do select tests,
671 -- but if it's just a target like "pkg" then we don't build tests unless
672 -- they are requested by default (i.e. by using --enable-tests)
673 isRequested
(TargetAllPackages Nothing
) TargetNotRequestedByDefault
= False
674 isRequested
(TargetPackage _ _ Nothing
) TargetNotRequestedByDefault
= False
675 isRequested _ _
= True
677 -- | Target selection behaviour which only select a single target.
678 -- This is used when the compiler version doesn't support multi-repl or the user
679 -- didn't request it.
680 selectPackageTargetsSingle
683 -> [AvailableTarget k
]
684 -> Either ReplTargetProblem
[k
]
685 selectPackageTargetsSingle decision targetSelector targets
686 -- If there is exactly one buildable library then we select that
687 |
[target
] <- targetsLibsBuildable
=
689 -- but fail if there are multiple buildable libraries.
690 |
not (null targetsLibsBuildable
) =
691 Left
(matchesMultipleProblem decision targetSelector targetsLibsBuildable
')
692 -- If there is exactly one buildable executable then we select that
693 |
[target
] <- targetsExesBuildable
=
695 -- but fail if there are multiple buildable executables.
696 |
not (null targetsExesBuildable
) =
697 Left
(matchesMultipleProblem decision targetSelector targetsExesBuildable
')
698 -- If there is exactly one other target then we select that
699 |
[target
] <- targetsBuildable
=
701 -- but fail if there are multiple such targets
702 |
not (null targetsBuildable
) =
703 Left
(matchesMultipleProblem decision targetSelector targetsBuildable
')
704 -- If there are targets but none are buildable then we report those
705 |
not (null targets
) =
706 Left
(TargetProblemNoneEnabled targetSelector targets
')
707 -- If there are no targets at all then we report that
709 Left
(TargetProblemNoTargets targetSelector
)
711 targets
' = forgetTargetsDetail targets
712 ( targetsLibsBuildable
713 , targetsLibsBuildable
'
715 selectBuildableTargets
'
716 . filterTargetsKind LibKind
718 ( targetsExesBuildable
719 , targetsExesBuildable
'
721 selectBuildableTargets
'
722 . filterTargetsKind ExeKind
727 selectBuildableTargetsWith
'
728 (isRequested targetSelector
)
731 -- When there's a target filter like "pkg:tests" then we do select tests,
732 -- but if it's just a target like "pkg" then we don't build tests unless
733 -- they are requested by default (i.e. by using --enable-tests)
734 isRequested
(TargetAllPackages Nothing
) TargetNotRequestedByDefault
= False
735 isRequested
(TargetPackage _ _ Nothing
) TargetNotRequestedByDefault
= False
736 isRequested _ _
= True
738 -- | For a 'TargetComponent' 'TargetSelector', check if the component can be
741 -- For the @repl@ command we just need the basic checks on being buildable etc.
742 selectComponentTarget
743 :: SubComponentTarget
745 -> Either ReplTargetProblem k
746 selectComponentTarget
= selectComponentTargetBasic
749 = TargetProblemMatchesMultiple MultiReplDecision TargetSelector
[AvailableTarget
()]
750 |
-- | Multiple 'TargetSelector's match multiple targets
751 TargetProblemMultipleTargets MultiReplDecision TargetsMap
754 -- | The various error conditions that can occur when matching a
755 -- 'TargetSelector' against 'AvailableTarget's for the @repl@ command.
756 type ReplTargetProblem
= TargetProblem ReplProblem
758 matchesMultipleProblem
761 -> [AvailableTarget
()]
763 matchesMultipleProblem decision targetSelector targetsExesBuildable
=
764 CustomTargetProblem
$ TargetProblemMatchesMultiple decision targetSelector targetsExesBuildable
766 multipleTargetsProblem
770 multipleTargetsProblem decision
= CustomTargetProblem
. TargetProblemMultipleTargets decision
772 reportTargetProblems
:: Verbosity
-> [TargetProblem ReplProblem
] -> IO a
773 reportTargetProblems verbosity
=
774 dieWithException verbosity
. RenderReplTargetProblem
. map renderReplTargetProblem
776 renderReplTargetProblem
:: TargetProblem ReplProblem
-> String
777 renderReplTargetProblem
= renderTargetProblem
"open a repl for" renderReplProblem
779 renderReplProblem
:: ReplProblem
-> String
780 renderReplProblem
(TargetProblemMatchesMultiple decision targetSelector targets
) =
781 "Cannot open a repl for multiple components at once. The target '"
782 ++ showTargetSelector targetSelector
784 ++ renderTargetSelector targetSelector
786 ++ (if targetSelectorRefersToPkgs targetSelector
then "includes " else "are ")
789 ++ renderComponentKind Plural ckind
791 ++ renderListCommaAnd
792 [ maybe (prettyShow pkgname
) prettyShow
(componentNameString cname
)
794 , let cname
= availableTargetComponentName t
795 pkgname
= packageName
(availableTargetPackageId t
)
797 |
(ckind
, ts
) <- sortGroupOn availableTargetComponentKind targets
800 ++ explainMultiReplDecision decision
802 availableTargetComponentKind
=
804 . availableTargetComponentName
805 renderReplProblem
(TargetProblemMultipleTargets multi_decision selectorMap
) =
806 "Cannot open a repl for multiple components at once. The targets "
807 ++ renderListCommaAnd
808 [ "'" ++ showTargetSelector ts
++ "'"
809 | ts
<- uniqueTargetSelectors selectorMap
811 ++ " refer to different components."
813 ++ explainMultiReplDecision multi_decision
815 explainMultiReplDecision
:: MultiReplDecision
-> [Char]
816 explainMultiReplDecision MultiReplDecision
{compilerVersion
, enabledByFlag
} =
817 case (compilerVersion
>= Just minMultipleHomeUnitsVersion
, enabledByFlag
) of
818 -- Compiler not new enough, and not requested anyway.
819 (False, False) -> explanationSingleComponentLimitation compilerVersion
820 -- Compiler too old, but was requested
821 (False, True) -> "Multiple component session requested but compiler version is too old.\n" ++ explanationSingleComponentLimitation compilerVersion
822 -- Compiler new enough, but not requested
823 (True, False) -> explanationNeedToEnableFlag
824 _
-> error "explainMultiReplDecision"
826 explanationNeedToEnableFlag
:: String
827 explanationNeedToEnableFlag
=
828 "Your compiler supports a multiple component repl but support is not enabled.\n"
829 ++ "The experimental multi repl can be enabled by\n"
830 ++ " * Globally: Setting multi-repl: True in your .cabal/config\n"
831 ++ " * Project Wide: Setting multi-repl: True in your cabal.project file\n"
832 ++ " * Per Invocation: By passing --enable-multi-repl when starting the repl"
834 explanationSingleComponentLimitation
:: Maybe Version
-> String
835 explanationSingleComponentLimitation version
=
836 "The reason for this limitation is that your version "
838 ++ "of ghci does not "
839 ++ "support loading multiple components as source. Load just one component "
840 ++ "and when you make changes to a dependent component then quit and reload.\n"
841 ++ prettyShow minMultipleHomeUnitsVersion
842 ++ " is needed to support multiple component sessions."
844 versionString
= case version
of
846 Just ver
-> "(" ++ prettyShow ver
++ ") "
849 lElaboratedShared
:: Lens
' ProjectBuildContext ElaboratedSharedConfig
850 lElaboratedShared f s
= fmap (\x
-> s
{elaboratedShared
= x
}) (f
(elaboratedShared s
))
851 {-# INLINE lElaboratedShared #-}
853 lPkgConfigReplOptions
:: Lens
' ElaboratedSharedConfig ReplOptions
854 lPkgConfigReplOptions f s
= fmap (\x
-> s
{pkgConfigReplOptions
= x
}) (f
(pkgConfigReplOptions s
))
855 {-# INLINE lPkgConfigReplOptions #-}
857 lReplOptionsFlags
:: Lens
' ReplOptions
[String]
858 lReplOptionsFlags f s
= fmap (\x
-> s
{replOptionsFlags
= x
}) (f
(replOptionsFlags s
))
859 {-# INLINE lReplOptionsFlags #-}
861 lProjectConfig
:: Lens
' ProjectBaseContext ProjectConfig
862 lProjectConfig f s
= fmap (\x
-> s
{projectConfig
= x
}) (f
(projectConfig s
))
863 {-# INLINE lProjectConfig #-}
865 lProjectConfigShared
:: Lens
' ProjectConfig ProjectConfigShared
866 lProjectConfigShared f s
= fmap (\x
-> s
{projectConfigShared
= x
}) (f
(projectConfigShared s
))
867 {-# INLINE lProjectConfigShared #-}
869 lProjectConfigConstraints
:: Lens
' ProjectConfigShared
[(UserConstraint
, ConstraintSource
)]
870 lProjectConfigConstraints f s
= fmap (\x
-> s
{projectConfigConstraints
= x
}) (f
(projectConfigConstraints s
))
871 {-# INLINE lProjectConfigConstraints #-}