Commit f00d3818 authored by Matt Renaud's avatar Matt Renaud Committed by Oleg Grenrus

Refactor shared TargetProblem data types into their own module.

Moved "problem rendering" to CmdErrorMessages module

Additions by Oleg Grenrus:

- There were CommonTargetProblem, but now
  TargetProblem has an extension point so we can have just one type.
  A lot of code is simplified as we don't need to pass in injection
  from CommonTargetProblem to the resulting `err` type.
parent 06c3eff2
......@@ -8,7 +8,9 @@ module Distribution.Client.CmdBench (
benchAction,
-- * Internals exposed for testing
TargetProblem(..),
componentNotBenchmarkProblem,
isSubComponentProblem,
noBenchmarksProblem,
selectPackageTargets,
selectComponentTarget
) where
......@@ -18,7 +20,11 @@ import Prelude ()
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
( renderTargetSelector, showTargetSelector, renderTargetProblem,
renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs,
targetSelectorFilter )
import Distribution.Client.TargetProblem
( TargetProblem (..) )
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
......@@ -98,7 +104,6 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
$ resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
......@@ -126,7 +131,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
-- or fail if there are no benchmarks or no buildable benchmarks.
--
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
-> [AvailableTarget k] -> Either BenchTargetProblem [k]
selectPackageTargets targetSelector targets
-- If there are any buildable benchmark targets then we select those
......@@ -139,7 +144,7 @@ selectPackageTargets targetSelector targets
-- If there are no benchmarks but some other targets then we report that
| not (null targets)
= Left (TargetProblemNoBenchmarks targetSelector)
= Left (noBenchmarksProblem targetSelector)
-- If there are no targets at all then we report that
| otherwise
......@@ -161,34 +166,27 @@ selectPackageTargets targetSelector targets
-- to the basic checks on being buildable etc.
--
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
-> AvailableTarget k -> Either BenchTargetProblem k
selectComponentTarget subtarget@WholeComponent t
| CBenchName _ <- availableTargetComponentName t
= either (Left . TargetProblemCommon) return $
selectComponentTargetBasic subtarget t
= selectComponentTargetBasic subtarget t
| otherwise
= Left (TargetProblemComponentNotBenchmark (availableTargetPackageId t)
(availableTargetComponentName t))
= Left (componentNotBenchmarkProblem
(availableTargetPackageId t)
(availableTargetComponentName t))
selectComponentTarget subtarget t
= Left (TargetProblemIsSubComponent (availableTargetPackageId t)
(availableTargetComponentName t)
subtarget)
= Left (isSubComponentProblem
(availableTargetPackageId t)
(availableTargetComponentName t)
subtarget)
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @bench@ command.
--
data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches benchmarks but none are buildable
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets TargetSelector
data BenchProblem =
-- | The 'TargetSelector' matches targets but no benchmarks
| TargetProblemNoBenchmarks TargetSelector
TargetProblemNoBenchmarks TargetSelector
-- | The 'TargetSelector' refers to a component that is not a benchmark
| TargetProblemComponentNotBenchmark PackageId ComponentName
......@@ -197,25 +195,30 @@ data TargetProblem =
| TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
reportTargetProblems verbosity =
die' verbosity . unlines . map renderTargetProblem
renderTargetProblem :: TargetProblem -> String
renderTargetProblem (TargetProblemCommon problem) =
renderTargetProblemCommon "run" problem
type BenchTargetProblem = TargetProblem BenchProblem
renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) =
renderTargetProblemNoneEnabled "benchmark" targetSelector targets
noBenchmarksProblem :: TargetSelector -> TargetProblem BenchProblem
noBenchmarksProblem = CustomTargetProblem . TargetProblemNoBenchmarks
renderTargetProblem (TargetProblemNoBenchmarks targetSelector) =
"Cannot run benchmarks for the target '" ++ showTargetSelector targetSelector
++ "' which refers to " ++ renderTargetSelector targetSelector
++ " because "
++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do"
++ " not contain any benchmarks."
componentNotBenchmarkProblem :: PackageId -> ComponentName -> TargetProblem BenchProblem
componentNotBenchmarkProblem pkgid name = CustomTargetProblem $
TargetProblemComponentNotBenchmark pkgid name
renderTargetProblem (TargetProblemNoTargets targetSelector) =
isSubComponentProblem
:: PackageId
-> ComponentName
-> SubComponentTarget
-> TargetProblem BenchProblem
isSubComponentProblem pkgid name subcomponent = CustomTargetProblem $
TargetProblemIsSubComponent pkgid name subcomponent
reportTargetProblems :: Verbosity -> [BenchTargetProblem] -> IO a
reportTargetProblems verbosity =
die' verbosity . unlines . map renderBenchTargetProblem
renderBenchTargetProblem :: BenchTargetProblem -> String
renderBenchTargetProblem (TargetProblemNoTargets targetSelector) =
case targetSelectorFilter targetSelector of
Just kind | kind /= BenchKind
-> "The bench command is for running benchmarks, but the target '"
......@@ -223,8 +226,18 @@ renderTargetProblem (TargetProblemNoTargets targetSelector) =
++ renderTargetSelector targetSelector ++ "."
_ -> renderTargetProblemNoTargets "benchmark" targetSelector
renderBenchTargetProblem problem =
renderTargetProblem "benchmark" renderBenchProblem problem
renderBenchProblem :: BenchProblem -> String
renderBenchProblem (TargetProblemNoBenchmarks targetSelector) =
"Cannot run benchmarks for the target '" ++ showTargetSelector targetSelector
++ "' which refers to " ++ renderTargetSelector targetSelector
++ " because "
++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do"
++ " not contain any benchmarks."
renderTargetProblem (TargetProblemComponentNotBenchmark pkgid cname) =
renderBenchProblem (TargetProblemComponentNotBenchmark pkgid cname) =
"The bench command is for running benchmarks, but the target '"
++ showTargetSelector targetSelector ++ "' refers to "
++ renderTargetSelector targetSelector ++ " from the package "
......@@ -232,7 +245,7 @@ renderTargetProblem (TargetProblemComponentNotBenchmark pkgid cname) =
where
targetSelector = TargetComponent pkgid cname WholeComponent
renderTargetProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
renderBenchProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
"The bench command can only run benchmarks as a whole, "
++ "not files or modules within them, but the target '"
++ showTargetSelector targetSelector ++ "' refers to "
......
......@@ -7,7 +7,6 @@ module Distribution.Client.CmdBuild (
buildAction,
-- * Internals exposed for testing
TargetProblem(..),
selectPackageTargets,
selectComponentTarget
) where
......@@ -16,6 +15,8 @@ import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.ProjectOrchestration
import Distribution.Client.TargetProblem
( TargetProblem (..), TargetProblem' )
import Distribution.Client.CmdErrorMessages
import Distribution.Client.NixStyleOptions
......@@ -112,11 +113,10 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo
-- Interpret the targets on the command line as build targets
-- (as opposed to say repl or haddock targets).
targets <- either (reportTargetProblems verbosity) return
targets <- either (reportBuildTargetProblems verbosity) return
$ resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
......@@ -152,7 +152,7 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo
-- components
--
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
-> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets targetSelector targets
-- If there are any buildable targets then we select those
......@@ -185,36 +185,12 @@ selectPackageTargets targetSelector targets
-- For the @build@ command we just need the basic checks on being buildable etc.
--
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic subtarget
-> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @build@ command.
--
data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
reportTargetProblems verbosity =
die' verbosity . unlines . map renderTargetProblem
renderTargetProblem :: TargetProblem -> String
renderTargetProblem (TargetProblemCommon problem) =
renderTargetProblemCommon "build" problem
renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) =
renderTargetProblemNoneEnabled "build" targetSelector targets
renderTargetProblem(TargetProblemNoTargets targetSelector) =
renderTargetProblemNoTargets "build" targetSelector
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems verbosity problems =
reportTargetProblems verbosity "build" problems
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies verbosity =
......
{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
-- | Utilities to help format error messages for the various CLI commands.
--
......@@ -10,14 +13,23 @@ module Distribution.Client.CmdErrorMessages (
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
( AvailableTarget(..), AvailableTargetStatus(..),
CannotPruneDependencies(..), TargetRequested(..) )
import Distribution.Client.TargetSelector
( SubComponentTarget(..) )
import Distribution.Client.TargetProblem
( TargetProblem(..), TargetProblem' )
import Distribution.Client.TargetSelector
( ComponentKindFilter, componentKind, showTargetSelector )
( ComponentKind(..), ComponentKindFilter, TargetSelector(..),
componentKind, showTargetSelector )
import Distribution.Package
( packageId, PackageName, packageName )
( PackageId, packageId, PackageName, packageName )
import Distribution.Simple.Utils
( die' )
import Distribution.Types.ComponentName
( showComponentName )
( ComponentName(..), showComponentName )
import Distribution.Types.LibraryName
( LibraryName(..) )
import Distribution.Solver.Types.OptionalStanza
......@@ -189,22 +201,38 @@ renderComponentKind Plural ckind = case ckind of
-------------------------------------------------------
-- Renderering error messages for TargetProblemCommon
-- Renderering error messages for TargetProblem
--
renderTargetProblemCommon :: String -> TargetProblemCommon -> String
renderTargetProblemCommon verb (TargetNotInProject pkgname) =
-- | Default implementation of 'reportTargetProblems' simply renders one problem per line.
reportTargetProblems :: Verbosity -> String -> [TargetProblem'] -> IO a
reportTargetProblems verbosity verb =
die' verbosity . unlines . map (renderTargetProblem verb absurd)
-- | Default implementation of 'renderTargetProblem'.
renderTargetProblem
:: String -- ^ verb
-> (a -> String) -- ^ how to render custom problems
-> TargetProblem a
-> String
renderTargetProblem _verb f (CustomTargetProblem x) = f x
renderTargetProblem verb _ (TargetProblemNoneEnabled targetSelector targets) =
renderTargetProblemNoneEnabled verb targetSelector targets
renderTargetProblem verb _ (TargetProblemNoTargets targetSelector) =
renderTargetProblemNoTargets verb targetSelector
renderTargetProblem verb _ (TargetNotInProject pkgname) =
"Cannot " ++ verb ++ " the package " ++ prettyShow pkgname ++ ", it is not "
++ "in this project (either directly or indirectly). If you want to add it "
++ "to the project then edit the cabal.project file."
renderTargetProblemCommon verb (TargetAvailableInIndex pkgname) =
renderTargetProblem verb _ (TargetAvailableInIndex pkgname) =
"Cannot " ++ verb ++ " the package " ++ prettyShow pkgname ++ ", it is not "
++ "in this project (either directly or indirectly), but it is in the current "
++ "package index. If you want to add it to the project then edit the "
++ "cabal.project file."
renderTargetProblemCommon verb (TargetComponentNotProjectLocal pkgid cname _) =
renderTargetProblem verb _ (TargetComponentNotProjectLocal pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because the "
++ "package " ++ prettyShow pkgid ++ " is not local to the project, and cabal "
++ "does not currently support building test suites or benchmarks of "
......@@ -212,7 +240,7 @@ renderTargetProblemCommon verb (TargetComponentNotProjectLocal pkgid cname _) =
++ "dependencies you can unpack the package locally and adjust the "
++ "cabal.project file to include that package directory."
renderTargetProblemCommon verb (TargetComponentNotBuildable pkgid cname _) =
renderTargetProblem verb _ (TargetComponentNotBuildable pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because it is "
++ "marked as 'buildable: False' within the '" ++ prettyShow (packageName pkgid)
++ ".cabal' file (at least for the current configuration). If you believe it "
......@@ -221,7 +249,7 @@ renderTargetProblemCommon verb (TargetComponentNotBuildable pkgid cname _) =
++ "edit the .cabal file to declare it as buildable and fix any resulting "
++ "build problems."
renderTargetProblemCommon verb (TargetOptionalStanzaDisabledByUser _ cname _) =
renderTargetProblem verb _ (TargetOptionalStanzaDisabledByUser _ cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because "
++ "building " ++ compkinds ++ " has been explicitly disabled in the "
++ "configuration. You can adjust this configuration in the "
......@@ -234,7 +262,7 @@ renderTargetProblemCommon verb (TargetOptionalStanzaDisabledByUser _ cname _) =
where
compkinds = renderComponentKind Plural (componentKind cname)
renderTargetProblemCommon verb (TargetOptionalStanzaDisabledBySolver pkgid cname _) =
renderTargetProblem verb _ (TargetOptionalStanzaDisabledBySolver pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because the "
++ "solver did not find a plan that included the " ++ compkinds
++ " for " ++ prettyShow pkgid ++ ". It is probably worth trying again with "
......@@ -247,7 +275,7 @@ renderTargetProblemCommon verb (TargetOptionalStanzaDisabledBySolver pkgid cname
where
compkinds = renderComponentKind Plural (componentKind cname)
renderTargetProblemCommon verb (TargetProblemUnknownComponent pkgname ecname) =
renderTargetProblem verb _ (TargetProblemUnknownComponent pkgname ecname) =
"Cannot " ++ verb ++ " the "
++ (case ecname of
Left ucname -> "component " ++ prettyShow ucname
......@@ -259,13 +287,13 @@ renderTargetProblemCommon verb (TargetProblemUnknownComponent pkgname ecname) =
Right cname -> renderComponentKind Singular (componentKind cname))
++ " with that name."
renderTargetProblemCommon verb (TargetProblemNoSuchPackage pkgid) =
renderTargetProblem verb _ (TargetProblemNoSuchPackage pkgid) =
"Internal error when trying to " ++ verb ++ " the package "
++ prettyShow pkgid ++ ". The package is not in the set of available targets "
++ "for the project plan, which would suggest an inconsistency "
++ "between readTargetSelectors and resolveTargets."
renderTargetProblemCommon verb (TargetProblemNoSuchComponent pkgid cname) =
renderTargetProblem verb _ (TargetProblemNoSuchComponent pkgid cname) =
"Internal error when trying to " ++ verb ++ " the "
++ showComponentName cname ++ " from the package " ++ prettyShow pkgid
++ ". The package,component pair is not in the set of available targets "
......
......@@ -8,7 +8,6 @@ module Distribution.Client.CmdHaddock (
haddockAction,
-- * Internals exposed for testing
TargetProblem(..),
selectPackageTargets,
selectComponentTarget
) where
......@@ -18,7 +17,8 @@ import Prelude ()
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.TargetProblem
( TargetProblem (..), TargetProblem' )
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
......@@ -87,11 +87,10 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do
-- When we interpret the targets on the command line, interpret them as
-- haddock targets
targets <- either (reportTargetProblems verbosity) return
targets <- either (reportBuildDocumentationTargetProblems verbosity) return
$ resolveTargets
(selectPackageTargets haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
......@@ -119,7 +118,7 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do
-- We do similarly for test-suites, benchmarks and foreign libs.
--
selectPackageTargets :: HaddockFlags -> TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
-> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets haddockFlags targetSelector targets
-- If there are any buildable targets then we select those
......@@ -169,35 +168,9 @@ selectPackageTargets haddockFlags targetSelector targets
-- etc.
--
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic subtarget
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @haddock@ command.
--
data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
reportTargetProblems verbosity =
die' verbosity . unlines . map renderTargetProblem
renderTargetProblem :: TargetProblem -> String
renderTargetProblem (TargetProblemCommon problem) =
renderTargetProblemCommon "build documentation for" problem
renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) =
renderTargetProblemNoneEnabled "build documentation for" targetSelector targets
-> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
renderTargetProblem(TargetProblemNoTargets targetSelector) =
renderTargetProblemNoTargets "build documentation for" targetSelector
reportBuildDocumentationTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildDocumentationTargetProblems verbosity problems =
reportTargetProblems verbosity "build documentation for" problems
......@@ -12,7 +12,6 @@ module Distribution.Client.CmdInstall (
installAction,
-- * Internals exposed for testing
TargetProblem(..),
selectPackageTargets,
selectComponentTarget,
-- * Internals exposed for CmdRepl + CmdRun
......@@ -28,6 +27,8 @@ import Distribution.Compat.Directory
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.CmdSdist
import Distribution.Client.TargetProblem
( TargetProblem', TargetProblem (..) )
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector
......@@ -489,7 +490,6 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS
let mTargets = resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
(Just pkgDb)
targetSelectors
......@@ -501,12 +501,12 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS
-- Not everything is local.
let
(errs', hackageNames) = partitionEithers . flip fmap errs $ \case
TargetProblemCommon (TargetAvailableInIndex name) -> Right name
err -> Left err
TargetAvailableInIndex name -> Right name
err -> Left err
-- report incorrect case for known package.
for_ errs' $ \case
TargetProblemCommon (TargetNotInProject hn) ->
TargetNotInProject hn ->
case searchByName (packageIndex pkgDb) (unPackageName hn) of
[] -> return ()
xs -> die' verbosity . concat $
......@@ -516,7 +516,7 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS
]
_ -> return ()
when (not . null $ errs') $ reportTargetProblems verbosity errs'
when (not . null $ errs') $ reportBuildTargetProblems verbosity errs'
let
targetSelectors' = flip filter targetSelectors $ \case
......@@ -529,11 +529,10 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS
-- This can't fail, because all of the errors are
-- removed (or we've given up).
targets <-
either (reportTargetProblems verbosity) return $
either (reportBuildTargetProblems verbosity) return $
resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors'
......@@ -551,11 +550,10 @@ constructProjectBuildContext
constructProjectBuildContext verbosity baseCtx targetSelectors = do
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
-- Interpret the targets on the command line as build targets
targets <- either (reportTargetProblems verbosity) return $
targets <- either (reportBuildTargetProblems verbosity) return $
resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
......@@ -914,7 +912,7 @@ getPackageDbStack compilerId storeDirFlag logsDirFlag = do
--
selectPackageTargets
:: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
-> [AvailableTarget k] -> Either TargetProblem' [k]
selectPackageTargets targetSelector targets
-- If there are any buildable targets then we select those
......@@ -948,36 +946,11 @@ selectPackageTargets targetSelector targets
--
selectComponentTarget
:: SubComponentTarget
-> AvailableTarget k -> Either TargetProblem k
selectComponentTarget subtarget =
either (Left . TargetProblemCommon) Right
. selectComponentTargetBasic subtarget
-> AvailableTarget k -> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @build@ command.
--
data TargetProblem =
TargetProblemCommon TargetProblemCommon
-- | The 'TargetSelector' matches targets but none are buildable
| TargetProblemNoneEnabled TargetSelector [AvailableTarget ()]
-- | There are no targets at all
| TargetProblemNoTargets TargetSelector
deriving (Eq, Show)
reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a
reportTargetProblems verbosity =
die' verbosity . unlines . map renderTargetProblem
renderTargetProblem :: TargetProblem -> String
renderTargetProblem (TargetProblemCommon problem) =
renderTargetProblemCommon "build" problem
renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) =
renderTargetProblemNoneEnabled "build" targetSelector targets
renderTargetProblem(TargetProblemNoTargets targetSelector) =
renderTargetProblemNoTargets "build" targetSelector
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "build" problems
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
reportCannotPruneDependencies verbosity =
......
......@@ -12,7 +12,7 @@ module Distribution.Client.CmdRepl (
replAction,
-- * Internals exposed for testing
TargetProblem(..),
matchesMultipleProblem,
selectPackageTargets,
selectComponentTarget
) where
......@@ -26,6 +26,13 @@ import qualified Distribution.Types.Lens as L
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.CmdErrorMessages
( renderTargetSelector, showTargetSelector,
renderTargetProblem,
targetSelectorRefersToPkgs,
renderComponentKind, renderListCommaAnd, renderListSemiAnd,
componentKind, sortGroupOn, Plural(..) )
import Distribution.Client.TargetProblem
( TargetProblem(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.ProjectBuilding
( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages )
......@@ -304,7 +311,6 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS
$ resolveTargets
selectPackageTargets
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
......@@ -314,7 +320,7 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS
-- same component, but not two that live in different components.
when (Set.size (distinctTargetComponents targets) > 1) $
reportTargetProblems verbosity
[TargetProblemMultipleTargets targets]
[multipleTargetsProblem targets]
return targets
......@@ -448,7 +454,7 @@ generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = f
-- multiple libs or exes.
--
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TargetProblem [k]
-> [AvailableTarget k] -> Either ReplTargetProblem [k]
selectPackageTargets targetSelector targets
-- If there is exactly one buildable library then we select that
......@@ -457,7 +463,7 @@ selectPackageTargets targetSelector targets
-- but fail if there are multiple buildable libraries.
| not (null targetsLibsBuildable)
= Left (TargetProblemMatchesMultiple targetSelector targetsLibsBuildable')
= Left (matchesMultipleProblem targetSelector targetsLibsBuildable')
-- If there is exactly one buildable executable then we select that