1{-# LANGUAGE LambdaCase #-} 2{-# LANGUAGE NamedFieldPuns #-} 3{-# LANGUAGE OverloadedStrings #-} 4{-# LANGUAGE RankNTypes #-} 5{-# LANGUAGE RecordWildCards #-} 6 7-- | cabal-install CLI command: repl 8-- 9module Distribution.Client.CmdRepl ( 10 -- * The @repl@ CLI and action 11 replCommand, 12 replAction, 13 14 -- * Internals exposed for testing 15 TargetProblem(..), 16 selectPackageTargets, 17 selectComponentTarget 18 ) where 19 20import Prelude () 21import Distribution.Client.Compat.Prelude 22 23import Distribution.Compat.Lens 24import qualified Distribution.Types.Lens as L 25 26import Distribution.Client.CmdErrorMessages 27import Distribution.Client.CmdInstall 28 ( establishDummyProjectBaseContext ) 29import qualified Distribution.Client.InstallPlan as InstallPlan 30import Distribution.Client.ProjectBuilding 31 ( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages ) 32import Distribution.Client.ProjectConfig 33 ( ProjectConfig(..), withProjectOrGlobalConfigIgn 34 , projectConfigConfigFile ) 35import Distribution.Client.ProjectOrchestration 36import Distribution.Client.ProjectPlanning 37 ( ElaboratedSharedConfig(..), ElaboratedInstallPlan ) 38import Distribution.Client.ProjectPlanning.Types 39 ( elabOrderExeDependencies ) 40import Distribution.Client.Setup 41 ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) 42import qualified Distribution.Client.Setup as Client 43import Distribution.Client.Types 44 ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) 45import Distribution.Simple.Setup 46 ( HaddockFlags, TestFlags, BenchmarkFlags 47 , fromFlagOrDefault, replOptions 48 , Flag(..), toFlag, trueArg, falseArg ) 49import Distribution.Simple.Command 50 ( CommandUI(..), liftOption, usageAlternatives, option 51 , ShowOrParseArgs, OptionField, reqArg ) 52import Distribution.Compiler 53 ( CompilerFlavor(GHC) ) 54import Distribution.Simple.Compiler 55 ( compilerCompatVersion ) 56import Distribution.Package 57 ( Package(..), packageName, UnitId, installedUnitId ) 58import Distribution.PackageDescription.PrettyPrint 59import Distribution.Parsec 60 ( Parsec(..), parsecCommaList ) 61import Distribution.Pretty 62 ( prettyShow ) 63import Distribution.ReadE 64 ( ReadE, parsecToReadE ) 65import qualified Distribution.SPDX.License as SPDX 66import Distribution.Solver.Types.SourcePackage 67 ( SourcePackage(..) ) 68import Distribution.Types.BuildInfo 69 ( BuildInfo(..), emptyBuildInfo ) 70import Distribution.Types.ComponentName 71 ( componentNameString ) 72import Distribution.Types.CondTree 73 ( CondTree(..), traverseCondTreeC ) 74import Distribution.Types.Dependency 75 ( Dependency(..) ) 76import Distribution.Types.GenericPackageDescription 77 ( emptyGenericPackageDescription ) 78import Distribution.Types.LibraryName 79 ( LibraryName(..) ) 80import Distribution.Types.PackageDescription 81 ( PackageDescription(..), emptyPackageDescription ) 82import Distribution.Types.PackageName.Magic 83 ( fakePackageId ) 84import Distribution.Types.Library 85 ( Library(..), emptyLibrary ) 86import Distribution.Types.Version 87 ( mkVersion ) 88import Distribution.Types.VersionRange 89 ( anyVersion ) 90import Distribution.Deprecated.Text 91 ( display ) 92import Distribution.Utils.Generic 93 ( safeHead ) 94import Distribution.Verbosity 95 ( Verbosity, normal, lessVerbose ) 96import Distribution.Simple.Utils 97 ( wrapText, die', debugNoWrap, ordNub, createTempDirectory, handleDoesNotExist ) 98import Language.Haskell.Extension 99 ( Language(..) ) 100 101import Data.List 102 ( (\\) ) 103import qualified Data.Map as Map 104import qualified Data.Set as Set 105import System.Directory 106 ( getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive ) 107import System.FilePath 108 ( (</>) ) 109 110type ReplFlags = [String] 111 112data EnvFlags = EnvFlags 113 { envPackages :: [Dependency] 114 , envIncludeTransitive :: Flag Bool 115 , envIgnoreProject :: Flag Bool 116 } 117 118defaultEnvFlags :: EnvFlags 119defaultEnvFlags = EnvFlags 120 { envPackages = [] 121 , envIncludeTransitive = toFlag True 122 , envIgnoreProject = toFlag False 123 } 124 125envOptions :: ShowOrParseArgs -> [OptionField EnvFlags] 126envOptions _ = 127 [ option ['b'] ["build-depends"] 128 "Include an additional package in the environment presented to GHCi." 129 envPackages (\p flags -> flags { envPackages = p ++ envPackages flags }) 130 (reqArg "DEPENDENCY" dependencyReadE (fmap prettyShow :: [Dependency] -> [String])) 131 , option [] ["no-transitive-deps"] 132 "Don't automatically include transitive dependencies of requested packages." 133 envIncludeTransitive (\p flags -> flags { envIncludeTransitive = p }) 134 falseArg 135 , option ['z'] ["ignore-project"] 136 "Only include explicitly specified packages (and 'base')." 137 envIgnoreProject (\p flags -> flags { envIgnoreProject = p }) 138 trueArg 139 ] 140 where 141 dependencyReadE :: ReadE [Dependency] 142 dependencyReadE = 143 parsecToReadE 144 ("couldn't parse dependency: " ++) 145 (parsecCommaList parsec) 146 147replCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags 148 , HaddockFlags, TestFlags, BenchmarkFlags 149 , ReplFlags, EnvFlags 150 ) 151replCommand = Client.installCommand { 152 commandName = "v2-repl", 153 commandSynopsis = "Open an interactive session for the given component.", 154 commandUsage = usageAlternatives "v2-repl" [ "[TARGET] [FLAGS]" ], 155 commandDescription = Just $ \_ -> wrapText $ 156 "Open an interactive session for a component within the project. The " 157 ++ "available targets are the same as for the 'v2-build' command: " 158 ++ "individual components within packages in the project, including " 159 ++ "libraries, executables, test-suites or benchmarks. Packages can " 160 ++ "also be specified in which case the library component in the " 161 ++ "package will be used, or the (first listed) executable in the " 162 ++ "package if there is no library.\n\n" 163 164 ++ "Dependencies are built or rebuilt as necessary. Additional " 165 ++ "configuration flags can be specified on the command line and these " 166 ++ "extend the project configuration from the 'cabal.project', " 167 ++ "'cabal.project.local' and other files.", 168 commandNotes = Just $ \pname -> 169 "Examples, open an interactive session:\n" 170 ++ " " ++ pname ++ " v2-repl\n" 171 ++ " for the default component in the package in the current directory\n" 172 ++ " " ++ pname ++ " v2-repl pkgname\n" 173 ++ " for the default component in the package named 'pkgname'\n" 174 ++ " " ++ pname ++ " v2-repl ./pkgfoo\n" 175 ++ " for the default component in the package in the ./pkgfoo directory\n" 176 ++ " " ++ pname ++ " v2-repl cname\n" 177 ++ " for the component named 'cname'\n" 178 ++ " " ++ pname ++ " v2-repl pkgname:cname\n" 179 ++ " for the component 'cname' in the package 'pkgname'\n\n" 180 ++ " " ++ pname ++ " v2-repl --build-depends lens\n" 181 ++ " add the latest version of the library 'lens' to the default component " 182 ++ "(or no componentif there is no project present)\n" 183 ++ " " ++ pname ++ " v2-repl --build-depends \"lens >= 4.15 && < 4.18\"\n" 184 ++ " add a version (constrained between 4.15 and 4.18) of the library 'lens' " 185 ++ "to the default component (or no component if there is no project present)\n" 186 187 ++ cmdCommonHelpTextNewBuildBeta, 188 commandDefaultFlags = ( configFlags, configExFlags, installFlags 189 , haddockFlags, testFlags, benchmarkFlags 190 , [], defaultEnvFlags 191 ), 192 commandOptions = \showOrParseArgs -> 193 map liftOriginal (commandOptions Client.installCommand showOrParseArgs) 194 ++ map liftReplOpts (replOptions showOrParseArgs) 195 ++ map liftEnvOpts (envOptions showOrParseArgs) 196 } 197 where 198 (configFlags,configExFlags,installFlags,haddockFlags,testFlags,benchmarkFlags) 199 = commandDefaultFlags Client.installCommand 200 201 liftOriginal = liftOption projectOriginal updateOriginal 202 liftReplOpts = liftOption projectReplOpts updateReplOpts 203 liftEnvOpts = liftOption projectEnvOpts updateEnvOpts 204 205 projectOriginal (a,b,c,d,e,f,_,_) = (a,b,c,d,e,f) 206 updateOriginal (a,b,c,d,e,f) (_,_,_,_,_,_,g,h) = (a,b,c,d,e,f,g,h) 207 208 projectReplOpts (_,_,_,_,_,_,g,_) = g 209 updateReplOpts g (a,b,c,d,e,f,_,h) = (a,b,c,d,e,f,g,h) 210 211 projectEnvOpts (_,_,_,_,_,_,_,h) = h 212 updateEnvOpts h (a,b,c,d,e,f,g,_) = (a,b,c,d,e,f,g,h) 213 214-- | The @repl@ command is very much like @build@. It brings the install plan 215-- up to date, selects that part of the plan needed by the given or implicit 216-- repl target and then executes the plan. 217-- 218-- Compared to @build@ the difference is that only one target is allowed 219-- (given or implicit) and the target type is repl rather than build. The 220-- general plan execution infrastructure handles both build and repl targets. 221-- 222-- For more details on how this works, see the module 223-- "Distribution.Client.ProjectOrchestration" 224-- 225replAction :: ( ConfigFlags, ConfigExFlags, InstallFlags 226 , HaddockFlags, TestFlags, BenchmarkFlags 227 , ReplFlags, EnvFlags ) 228 -> [String] -> GlobalFlags -> IO () 229replAction ( configFlags, configExFlags, installFlags 230 , haddockFlags, testFlags, benchmarkFlags 231 , replFlags, envFlags ) 232 targetStrings globalFlags = do 233 let 234 ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags) 235 with = withProject cliConfig verbosity targetStrings 236 without config = withoutProject (config <> cliConfig) verbosity targetStrings 237 238 (baseCtx, targetSelectors, finalizer, replType) <- 239 withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without 240 241 when (buildSettingOnlyDeps (buildSettings baseCtx)) $ 242 die' verbosity $ "The repl command does not support '--only-dependencies'. " 243 ++ "You may wish to use 'build --only-dependencies' and then " 244 ++ "use 'repl'." 245 246 (originalComponent, baseCtx') <- if null (envPackages envFlags) 247 then return (Nothing, baseCtx) 248 else 249 -- Unfortunately, the best way to do this is to let the normal solver 250 -- help us resolve the targets, but that isn't ideal for performance, 251 -- especially in the no-project case. 252 withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do 253 -- targets should be non-empty map, but there's no NonEmptyMap yet. 254 targets <- validatedTargets elaboratedPlan targetSelectors 255 256 let 257 (unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets 258 originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId 259 oci = OriginalComponentInfo unitId originalDeps 260 pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId 261 baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx 262 263 return (Just oci, baseCtx') 264 265 -- Now, we run the solver again with the added packages. While the graph 266 -- won't actually reflect the addition of transitive dependencies, 267 -- they're going to be available already and will be offered to the REPL 268 -- and that's good enough. 269 -- 270 -- In addition, to avoid a *third* trip through the solver, we are 271 -- replicating the second half of 'runProjectPreBuildPhase' by hand 272 -- here. 273 (buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $ 274 \elaboratedPlan elaboratedShared' -> do 275 let ProjectBaseContext{..} = baseCtx' 276 277 -- Recalculate with updated project. 278 targets <- validatedTargets elaboratedPlan targetSelectors 279 280 let 281 elaboratedPlan' = pruneInstallPlanToTargets 282 TargetActionRepl 283 targets 284 elaboratedPlan 285 includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags) 286 287 pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared' 288 elaboratedPlan' 289 290 let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages 291 pkgsBuildStatus elaboratedPlan' 292 debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan'') 293 294 let 295 buildCtx = ProjectBuildContext 296 { elaboratedPlanOriginal = elaboratedPlan 297 , elaboratedPlanToExecute = elaboratedPlan'' 298 , elaboratedShared = elaboratedShared' 299 , pkgsBuildStatus 300 , targetsMap = targets 301 } 302 303 ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared' 304 305 -- First version of GHC where GHCi supported the flag we need. 306 -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html 307 minGhciScriptVersion = mkVersion [7, 6] 308 309 replFlags' = case originalComponent of 310 Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci 311 Nothing -> [] 312 replFlags'' = case replType of 313 GlobalRepl scriptPath 314 | Just version <- compilerCompatVersion GHC compiler 315 , version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags' 316 _ -> replFlags' 317 318 return (buildCtx, replFlags'') 319 320 let buildCtx' = buildCtx 321 { elaboratedShared = (elaboratedShared buildCtx) 322 { pkgConfigReplOptions = replFlags ++ replFlags'' } 323 } 324 printPlan verbosity baseCtx' buildCtx' 325 326 buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx' 327 runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes 328 finalizer 329 where 330 verbosity = fromFlagOrDefault normal (configVerbosity configFlags) 331 cliConfig = commandLineFlagsToProjectConfig 332 globalFlags configFlags configExFlags 333 installFlags 334 mempty -- ClientInstallFlags, not needed here 335 haddockFlags testFlags benchmarkFlags 336 globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) 337 338 validatedTargets elaboratedPlan targetSelectors = do 339 -- Interpret the targets on the command line as repl targets 340 -- (as opposed to say build or haddock targets). 341 targets <- either (reportTargetProblems verbosity) return 342 $ resolveTargets 343 selectPackageTargets 344 selectComponentTarget 345 TargetProblemCommon 346 elaboratedPlan 347 Nothing 348 targetSelectors 349 350 -- Reject multiple targets, or at least targets in different 351 -- components. It is ok to have two module/file targets in the 352 -- same component, but not two that live in different components. 353 when (Set.size (distinctTargetComponents targets) > 1) $ 354 reportTargetProblems verbosity 355 [TargetProblemMultipleTargets targets] 356 357 return targets 358 359data OriginalComponentInfo = OriginalComponentInfo 360 { ociUnitId :: UnitId 361 , ociOriginalDeps :: [UnitId] 362 } 363 deriving (Show) 364 365-- | Tracks what type of GHCi instance we're creating. 366data ReplType = ProjectRepl 367 | GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi 368 -- script responsible for changing to the 369 -- correct directory. Only works on GHC geq 370 -- 7.6, though. 371 deriving (Show, Eq) 372 373withProject :: ProjectConfig -> Verbosity -> [String] 374 -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) 375withProject cliConfig verbosity targetStrings = do 376 baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand 377 378 targetSelectors <- either (reportTargetSelectorProblems verbosity) return 379 =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings 380 381 return (baseCtx, targetSelectors, return (), ProjectRepl) 382 383withoutProject :: ProjectConfig -> Verbosity -> [String] 384 -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) 385withoutProject config verbosity extraArgs = do 386 unless (null extraArgs) $ 387 die' verbosity $ "'repl' doesn't take any extra arguments when outside a project: " ++ unwords extraArgs 388 389 globalTmp <- getTemporaryDirectory 390 tempDir <- createTempDirectory globalTmp "cabal-repl." 391 392 -- We need to create a dummy package that lives in our dummy project. 393 let 394 sourcePackage = SourcePackage 395 { packageInfoId = pkgId 396 , packageDescription = genericPackageDescription 397 , packageSource = LocalUnpackedPackage tempDir 398 , packageDescrOverride = Nothing 399 } 400 genericPackageDescription = emptyGenericPackageDescription 401 & L.packageDescription .~ packageDescription 402 & L.condLibrary .~ Just (CondNode library [baseDep] []) 403 packageDescription = emptyPackageDescription 404 { package = pkgId 405 , specVersionRaw = Left (mkVersion [2, 2]) 406 , licenseRaw = Left SPDX.NONE 407 } 408 library = emptyLibrary { libBuildInfo = buildInfo } 409 buildInfo = emptyBuildInfo 410 { targetBuildDepends = [baseDep] 411 , defaultLanguage = Just Haskell2010 412 } 413 baseDep = Dependency "base" anyVersion (Set.singleton LMainLibName) 414 pkgId = fakePackageId 415 416 writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription 417 418 let ghciScriptPath = tempDir </> "setcwd.ghci" 419 cwd <- getCurrentDirectory 420 writeFile ghciScriptPath (":cd " ++ cwd) 421 422 baseCtx <- 423 establishDummyProjectBaseContext 424 verbosity 425 config 426 tempDir 427 [SpecificSourcePackage sourcePackage] 428 OtherCommand 429 430 let 431 targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] 432 finalizer = handleDoesNotExist () (removeDirectoryRecursive tempDir) 433 434 return (baseCtx, targetSelectors, finalizer, GlobalRepl ghciScriptPath) 435 436addDepsToProjectTarget :: [Dependency] 437 -> PackageId 438 -> ProjectBaseContext 439 -> ProjectBaseContext 440addDepsToProjectTarget deps pkgId ctx = 441 (\p -> ctx { localPackages = p }) . fmap addDeps . localPackages $ ctx 442 where 443 addDeps :: PackageSpecifier UnresolvedSourcePackage 444 -> PackageSpecifier UnresolvedSourcePackage 445 addDeps (SpecificSourcePackage pkg) 446 | packageId pkg /= pkgId = SpecificSourcePackage pkg 447 | SourcePackage{..} <- pkg = 448 SpecificSourcePackage $ pkg { packageDescription = 449 packageDescription & (\f -> L.allCondTrees $ traverseCondTreeC f) 450 %~ (deps ++) 451 } 452 addDeps spec = spec 453 454generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> ReplFlags 455generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags 456 where 457 exeDeps :: [UnitId] 458 exeDeps = 459 foldMap 460 (InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies) 461 (InstallPlan.dependencyClosure elaboratedPlan [ociUnitId]) 462 463 deps, deps', trans, trans' :: [UnitId] 464 flags :: ReplFlags 465 deps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan ociUnitId 466 deps' = deps \\ ociOriginalDeps 467 trans = installedUnitId <$> InstallPlan.dependencyClosure elaboratedPlan deps' 468 trans' = trans \\ ociOriginalDeps 469 flags = fmap (("-package-id " ++) . prettyShow) . (\\ exeDeps) 470 $ if includeTransitive then trans' else deps' 471 472-- | This defines what a 'TargetSelector' means for the @repl@ command. 473-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, 474-- or otherwise classifies the problem. 475-- 476-- For repl we select: 477-- 478-- * the library if there is only one and it's buildable; or 479-- 480-- * the exe if there is only one and it's buildable; or 481-- 482-- * any other buildable component. 483-- 484-- Fail if there are no buildable lib\/exe components, or if there are 485-- multiple libs or exes. 486-- 487selectPackageTargets :: TargetSelector 488 -> [AvailableTarget k] -> Either TargetProblem [k] 489selectPackageTargets targetSelector targets 490 491 -- If there is exactly one buildable library then we select that 492 | [target] <- targetsLibsBuildable 493 = Right [target] 494 495 -- but fail if there are multiple buildable libraries. 496 | not (null targetsLibsBuildable) 497 = Left (TargetProblemMatchesMultiple targetSelector targetsLibsBuildable') 498 499 -- If there is exactly one buildable executable then we select that 500 | [target] <- targetsExesBuildable 501 = Right [target] 502 503 -- but fail if there are multiple buildable executables. 504 | not (null targetsExesBuildable) 505 = Left (TargetProblemMatchesMultiple targetSelector targetsExesBuildable') 506 507 -- If there is exactly one other target then we select that 508 | [target] <- targetsBuildable 509 = Right [target] 510 511 -- but fail if there are multiple such targets 512 | not (null targetsBuildable) 513 = Left (TargetProblemMatchesMultiple targetSelector targetsBuildable') 514 515 -- If there are targets but none are buildable then we report those 516 | not (null targets) 517 = Left (TargetProblemNoneEnabled targetSelector targets') 518 519 -- If there are no targets at all then we report that 520 | otherwise 521 = Left (TargetProblemNoTargets targetSelector) 522 where 523 targets' = forgetTargetsDetail targets 524 (targetsLibsBuildable, 525 targetsLibsBuildable') = selectBuildableTargets' 526 . filterTargetsKind LibKind 527 $ targets 528 (targetsExesBuildable, 529 targetsExesBuildable') = selectBuildableTargets' 530 . filterTargetsKind ExeKind 531 $ targets 532 (targetsBuildable, 533 targetsBuildable') = selectBuildableTargetsWith' 534 (isRequested targetSelector) targets 535 536 -- When there's a target filter like "pkg:tests" then we do select tests, 537 -- but if it's just a target like "pkg" then we don't build tests unless 538 -- they are requested by default (i.e. by using --enable-tests) 539 isRequested (TargetAllPackages Nothing) TargetNotRequestedByDefault = False 540 isRequested (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False 541 isRequested _ _ = True 542 543 544-- | For a 'TargetComponent' 'TargetSelector', check if the component can be 545-- selected. 546-- 547-- For the @repl@ command we just need the basic checks on being buildable etc. 548-- 549selectComponentTarget :: SubComponentTarget 550 -> AvailableTarget k -> Either TargetProblem k 551selectComponentTarget subtarget = 552 either (Left . TargetProblemCommon) Right 553 . selectComponentTargetBasic subtarget 554 555 556-- | The various error conditions that can occur when matching a 557-- 'TargetSelector' against 'AvailableTarget's for the @repl@ command. 558-- 559data TargetProblem = 560 TargetProblemCommon TargetProblemCommon 561 562 -- | The 'TargetSelector' matches targets but none are buildable 563 | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] 564 565 -- | There are no targets at all 566 | TargetProblemNoTargets TargetSelector 567 568 -- | A single 'TargetSelector' matches multiple targets 569 | TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()] 570 571 -- | Multiple 'TargetSelector's match multiple targets 572 | TargetProblemMultipleTargets TargetsMap 573 deriving (Eq, Show) 574 575reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a 576reportTargetProblems verbosity = 577 die' verbosity . unlines . map renderTargetProblem 578 579renderTargetProblem :: TargetProblem -> String 580renderTargetProblem (TargetProblemCommon problem) = 581 renderTargetProblemCommon "open a repl for" problem 582 583renderTargetProblem (TargetProblemMatchesMultiple targetSelector targets) = 584 "Cannot open a repl for multiple components at once. The target '" 585 ++ showTargetSelector targetSelector ++ "' refers to " 586 ++ renderTargetSelector targetSelector ++ " which " 587 ++ (if targetSelectorRefersToPkgs targetSelector then "includes " else "are ") 588 ++ renderListSemiAnd 589 [ "the " ++ renderComponentKind Plural ckind ++ " " ++ 590 renderListCommaAnd 591 [ maybe (display pkgname) display (componentNameString cname) 592 | t <- ts 593 , let cname = availableTargetComponentName t 594 pkgname = packageName (availableTargetPackageId t) 595 ] 596 | (ckind, ts) <- sortGroupOn availableTargetComponentKind targets 597 ] 598 ++ ".\n\n" ++ explanationSingleComponentLimitation 599 where 600 availableTargetComponentKind = componentKind 601 . availableTargetComponentName 602 603renderTargetProblem (TargetProblemMultipleTargets selectorMap) = 604 "Cannot open a repl for multiple components at once. The targets " 605 ++ renderListCommaAnd 606 [ "'" ++ showTargetSelector ts ++ "'" 607 | ts <- ordNub (concatMap snd (concat (Map.elems selectorMap))) ] 608 ++ " refer to different components." 609 ++ ".\n\n" ++ explanationSingleComponentLimitation 610 611renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = 612 renderTargetProblemNoneEnabled "open a repl for" targetSelector targets 613 614renderTargetProblem (TargetProblemNoTargets targetSelector) = 615 renderTargetProblemNoTargets "open a repl for" targetSelector 616 617 618explanationSingleComponentLimitation :: String 619explanationSingleComponentLimitation = 620 "The reason for this limitation is that current versions of ghci do not " 621 ++ "support loading multiple components as source. Load just one component " 622 ++ "and when you make changes to a dependent component then quit and reload." 623 624