diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs
index caaeb42eefe4cebdd92aec6fc8c62676d7a1a5ae..06b387c04aeeab017ec676f79202d6a5004ce9e1 100644
--- a/Cabal/src/Distribution/Simple/BuildTarget.hs
+++ b/Cabal/src/Distribution/Simple/BuildTarget.hs
@@ -25,6 +25,7 @@ module Distribution.Simple.BuildTarget
, BuildTarget (..)
, showBuildTarget
, QualLevel (..)
+ , buildTargetComponentName
-- * Parsing user build targets
, UserBuildTarget
@@ -61,9 +62,19 @@ import Distribution.Utils.Path
import Distribution.Verbosity
import Control.Arrow ((&&&))
-import Data.List (groupBy)
+import Control.Monad (msum)
+import Data.List (groupBy, stripPrefix)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
+import System.Directory (doesDirectoryExist, doesFileExist)
+import System.FilePath as FilePath
+ ( dropExtension
+ , hasTrailingPathSeparator
+ , joinPath
+ , normalise
+ , splitDirectories
+ , splitPath
+ )
-- | Take a list of 'String' build targets, and parse and validate them
-- into actual 'TargetInfo's to be built/registered/whatever.
@@ -80,15 +91,27 @@ readTargetInfos verbosity pkg_descr lbi args = do
-- | Various ways that a user may specify a build target.
data UserBuildTarget
- = -- | A target specified by a component name.
+ = -- | A target specified by a single name. This could be a component
+ -- module or file.
--
-- > cabal build foo
+ -- > cabal build Data.Foo
+ -- > cabal build Data/Foo.hs Data/Foo.hsc
UserBuildTargetSingle String
- | -- | A target specified by a component kind and a component name.
+ | -- | A target specified by a qualifier and name. This could be a component
+ -- name qualified by the component namespace kind, or a module or file
+ -- qualified by the component name.
--
- -- > cabal build lib:foo
- -- > cabal build test:foo-test
+ -- > cabal build lib:foo exe:foo
+ -- > cabal build foo:Data.Foo
+ -- > cabal build foo:Data/Foo.hs
UserBuildTargetDouble String String
+ | -- | A fully qualified target, either a module or file qualified by a
+ -- component name with the component namespace kind.
+ --
+ -- > cabal build lib:foo:Data/Foo.hs exe:foo:Data/Foo.hs
+ -- > cabal build lib:foo:Data.Foo exe:foo:Data.Foo
+ UserBuildTargetTriple String String String
deriving (Show, Eq, Ord)
-- ------------------------------------------------------------
@@ -101,10 +124,19 @@ data UserBuildTarget
data BuildTarget
= -- | A specific component
BuildTargetComponent ComponentName
+ | -- | A specific module within a specific component.
+ BuildTargetModule ComponentName ModuleName
+ | -- | A specific file within a specific component.
+ BuildTargetFile ComponentName FilePath
deriving (Eq, Show, Generic)
instance Binary BuildTarget
+buildTargetComponentName :: BuildTarget -> ComponentName
+buildTargetComponentName (BuildTargetComponent cn) = cn
+buildTargetComponentName (BuildTargetModule cn _) = cn
+buildTargetComponentName (BuildTargetFile cn _) = cn
+
-- | Read a list of user-supplied build target strings and resolve them to
-- 'BuildTarget's according to a 'PackageDescription'. If there are problems
-- with any of the targets e.g. they don't exist or are misformatted, throw an
@@ -114,11 +146,29 @@ readBuildTargets verbosity pkg targetStrs = do
let (uproblems, utargets) = readUserBuildTargets targetStrs
reportUserBuildTargetProblems verbosity uproblems
- let (bproblems, btargets) = resolveBuildTargets pkg utargets
+ utargets' <- traverse checkTargetExistsAsFile utargets
+
+ let (bproblems, btargets) = resolveBuildTargets pkg utargets'
reportBuildTargetProblems verbosity bproblems
return btargets
+checkTargetExistsAsFile :: UserBuildTarget -> IO (UserBuildTarget, Bool)
+checkTargetExistsAsFile t = do
+ fexists <- existsAsFile (fileComponentOfTarget t)
+ return (t, fexists)
+ where
+ existsAsFile f = do
+ exists <- doesFileExist f
+ case splitPath f of
+ (d : _) | hasTrailingPathSeparator d -> doesDirectoryExist d
+ (d : _ : _) | not exists -> doesDirectoryExist d
+ _ -> return exists
+
+ fileComponentOfTarget (UserBuildTargetSingle s1) = s1
+ fileComponentOfTarget (UserBuildTargetDouble _ s2) = s2
+ fileComponentOfTarget (UserBuildTargetTriple _ _ s3) = s3
+
-- ------------------------------------------------------------
-- * Parsing user targets
@@ -140,8 +190,8 @@ readUserBuildTargets = partitionEithers . map readUserBuildTarget
-- >>> readUserBuildTarget "lib:comp"
-- Right (UserBuildTargetDouble "lib" "comp")
--
--- >>> readUserBuildTarget "else:comp"
--- Right (UserBuildTargetDouble "else" "comp")
+-- >>> readUserBuildTarget "pkg:lib:comp"
+-- Right (UserBuildTargetTriple "pkg" "lib" "comp")
--
-- >>> readUserBuildTarget "\"comp\""
-- Right (UserBuildTargetSingle "comp")
@@ -149,8 +199,14 @@ readUserBuildTargets = partitionEithers . map readUserBuildTarget
-- >>> readUserBuildTarget "lib:\"comp\""
-- Right (UserBuildTargetDouble "lib" "comp")
--
--- >>> readUserBuildTarget "one:two:three"
--- Left (UserBuildTargetUnrecognised "one:two:three")
+-- >>> readUserBuildTarget "pkg:lib:\"comp\""
+-- Right (UserBuildTargetTriple "pkg" "lib" "comp")
+--
+-- >>> readUserBuildTarget "pkg:lib:comp:more"
+-- Left (UserBuildTargetUnrecognised "pkg:lib:comp:more")
+--
+-- >>> readUserBuildTarget "pkg:\"lib\":comp"
+-- Left (UserBuildTargetUnrecognised "pkg:\"lib\":comp")
readUserBuildTarget
:: String
-> Either
@@ -167,15 +223,18 @@ readUserBuildTarget targetstr =
ts <- tokens
return $ case ts of
(a, Nothing) -> UserBuildTargetSingle a
- (a, Just b) -> UserBuildTargetDouble a b
+ (a, Just (b, Nothing)) -> UserBuildTargetDouble a b
+ (a, Just (b, Just c)) -> UserBuildTargetTriple a b c
- tokens :: CabalParsing m => m (String, Maybe String)
+ tokens :: CabalParsing m => m (String, Maybe (String, Maybe String))
tokens =
- (\s -> (s, Nothing))
- <$> parsecHaskellString
- <|> (,)
- <$> token
- <*> P.optional (P.char ':' *> (parsecHaskellString <|> token))
+ (\s -> (s, Nothing)) <$> parsecHaskellString
+ <|> (,) <$> token <*> P.optional (P.char ':' *> tokens2)
+
+ tokens2 :: CabalParsing m => m (String, Maybe String)
+ tokens2 =
+ (\s -> (s, Nothing)) <$> parsecHaskellString
+ <|> (,) <$> token <*> P.optional (P.char ':' *> (parsecHaskellString <|> token))
token :: CabalParsing m => m String
token = P.munch1 (\x -> not (isSpace x) && x /= ':')
@@ -197,12 +256,22 @@ showUserBuildTarget = intercalate ":" . getComponents
where
getComponents (UserBuildTargetSingle s1) = [s1]
getComponents (UserBuildTargetDouble s1 s2) = [s1, s2]
+ getComponents (UserBuildTargetTriple s1 s2 s3) = [s1, s2, s3]
+
+-- | Unless you use 'QL1', this function is PARTIAL;
+-- use 'showBuildTarget' instead.
+showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String
+showBuildTarget' ql pkgid bt =
+ showUserBuildTarget (renderBuildTarget ql bt pkgid)
-- | Unambiguously render a 'BuildTarget', so that it can
-- be parsed in all situations.
showBuildTarget :: PackageId -> BuildTarget -> String
showBuildTarget pkgid t =
- showUserBuildTarget (renderBuildTarget QL2 t pkgid)
+ showBuildTarget' (qlBuildTarget t) pkgid t
+ where
+ qlBuildTarget BuildTargetComponent{} = QL2
+ qlBuildTarget _ = QL3
-- ------------------------------------------------------------
@@ -228,18 +297,19 @@ Just ex_pkgid = simpleParse "thelib"
-- refer to.
resolveBuildTargets
:: PackageDescription
- -> [UserBuildTarget]
+ -> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets pkg =
partitionEithers
- . map (resolveBuildTarget pkg)
+ . map (uncurry (resolveBuildTarget pkg))
resolveBuildTarget
:: PackageDescription
-> UserBuildTarget
+ -> Bool
-> Either BuildTargetProblem BuildTarget
-resolveBuildTarget pkg userTarget =
- case findMatch (matchBuildTarget pkg userTarget) of
+resolveBuildTarget pkg userTarget fexists =
+ case findMatch (matchBuildTarget pkg userTarget fexists) of
Unambiguous target -> Right target
Ambiguous targets -> Left (BuildTargetAmbiguous userTarget targets')
where
@@ -285,6 +355,7 @@ disambiguateBuildTargets pkgid original =
userTargetQualLevel (UserBuildTargetSingle _) = QL1
userTargetQualLevel (UserBuildTargetDouble _ _) = QL2
+ userTargetQualLevel (UserBuildTargetTriple _ _ _) = QL3
step
:: QualLevel
@@ -297,7 +368,7 @@ disambiguateBuildTargets pkgid original =
. sortBy (comparing fst)
. map (\t -> (renderBuildTarget ql t pkgid, t))
-data QualLevel = QL1 | QL2
+data QualLevel = QL1 | QL2 | QL3
deriving (Enum, Show)
renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
@@ -305,10 +376,19 @@ renderBuildTarget ql target pkgid =
case ql of
QL1 -> UserBuildTargetSingle s1 where s1 = single target
QL2 -> UserBuildTargetDouble s1 s2 where (s1, s2) = double target
+ QL3 -> UserBuildTargetTriple s1 s2 s3 where (s1, s2, s3) = triple target
where
single (BuildTargetComponent cn) = dispCName cn
+ single (BuildTargetModule _ m) = prettyShow m
+ single (BuildTargetFile _ f) = f
double (BuildTargetComponent cn) = (dispKind cn, dispCName cn)
+ double (BuildTargetModule cn m) = (dispCName cn, prettyShow m)
+ double (BuildTargetFile cn f) = (dispCName cn, f)
+
+ triple (BuildTargetComponent _) = error "triple BuildTargetComponent"
+ triple (BuildTargetModule cn m) = (dispKind cn, dispCName cn, prettyShow m)
+ triple (BuildTargetFile cn f) = (dispKind cn, dispCName cn, f)
dispCName = componentStringName pkgid
dispKind = showComponentKindShort . componentKind
@@ -343,6 +423,8 @@ reportBuildTargetProblems verbosity problems = do
targets
where
showBuildTargetKind (BuildTargetComponent _) = "component"
+ showBuildTargetKind (BuildTargetModule _ _) = "module"
+ showBuildTargetKind (BuildTargetFile _ _) = "file"
----------------------------------
-- Top level BuildTarget matcher
@@ -351,16 +433,47 @@ reportBuildTargetProblems verbosity problems = do
matchBuildTarget
:: PackageDescription
-> UserBuildTarget
+ -> Bool
-> Match BuildTarget
-matchBuildTarget pkg utarget =
+matchBuildTarget pkg = \utarget fexists ->
case utarget of
UserBuildTargetSingle str1 ->
- matchComponent1 cinfo str1
+ matchBuildTarget1 cinfo str1 fexists
UserBuildTargetDouble str1 str2 ->
- matchComponent2 cinfo str1 str2
+ matchBuildTarget2 cinfo str1 str2 fexists
+ UserBuildTargetTriple str1 str2 str3 ->
+ matchBuildTarget3 cinfo str1 str2 str3 fexists
where
cinfo = pkgComponentInfo pkg
+matchBuildTarget1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
+matchBuildTarget1 cinfo str1 fexists =
+ matchComponent1 cinfo str1
+ `matchPlusShadowing` matchModule1 cinfo str1
+ `matchPlusShadowing` matchFile1 cinfo str1 fexists
+
+matchBuildTarget2
+ :: [ComponentInfo]
+ -> String
+ -> String
+ -> Bool
+ -> Match BuildTarget
+matchBuildTarget2 cinfo str1 str2 fexists =
+ matchComponent2 cinfo str1 str2
+ `matchPlusShadowing` matchModule2 cinfo str1 str2
+ `matchPlusShadowing` matchFile2 cinfo str1 str2 fexists
+
+matchBuildTarget3
+ :: [ComponentInfo]
+ -> String
+ -> String
+ -> String
+ -> Bool
+ -> Match BuildTarget
+matchBuildTarget3 cinfo str1 str2 str3 fexists =
+ matchModule3 cinfo str1 str2 str3
+ `matchPlusShadowing` matchFile3 cinfo str1 str2 str3 fexists
+
data ComponentInfo = ComponentInfo
{ cinfoName :: ComponentName
, cinfoStrName :: ComponentStringName
@@ -515,7 +628,11 @@ guardComponentName s
| otherwise = matchErrorExpected "component name" s
where
validComponentChar c =
- isAlphaNum c || c `elem` "._-'"
+ isAlphaNum c
+ || c == '.'
+ || c == '_'
+ || c == '-'
+ || c == '\''
matchComponentName :: [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName cs str =
@@ -539,6 +656,180 @@ matchComponentKindAndName cs ckind str =
[((cinfoKind c, cinfoStrName c), c) | c <- cs]
(ckind, str)
+------------------------------
+-- Matching module targets
+--
+
+matchModule1 :: [ComponentInfo] -> String -> Match BuildTarget
+matchModule1 cs = \str1 -> do
+ guardModuleName str1
+ nubMatchErrors $ do
+ c <- tryEach cs
+ let ms = cinfoModules c
+ m <- matchModuleName ms str1
+ return (BuildTargetModule (cinfoName c) m)
+
+matchModule2 :: [ComponentInfo] -> String -> String -> Match BuildTarget
+matchModule2 cs = \str1 str2 -> do
+ guardComponentName str1
+ guardModuleName str2
+ c <- matchComponentName cs str1
+ let ms = cinfoModules c
+ m <- matchModuleName ms str2
+ return (BuildTargetModule (cinfoName c) m)
+
+matchModule3
+ :: [ComponentInfo]
+ -> String
+ -> String
+ -> String
+ -> Match BuildTarget
+matchModule3 cs str1 str2 str3 = do
+ ckind <- matchComponentKind str1
+ guardComponentName str2
+ c <- matchComponentKindAndName cs ckind str2
+ guardModuleName str3
+ let ms = cinfoModules c
+ m <- matchModuleName ms str3
+ return (BuildTargetModule (cinfoName c) m)
+
+-- utils:
+
+guardModuleName :: String -> Match ()
+guardModuleName s
+ | all validModuleChar s
+ && not (null s) =
+ increaseConfidence
+ | otherwise = matchErrorExpected "module name" s
+ where
+ validModuleChar c = isAlphaNum c || c == '.' || c == '_' || c == '\''
+
+matchModuleName :: [ModuleName] -> String -> Match ModuleName
+matchModuleName ms str =
+ orNoSuchThing "module" str $
+ increaseConfidenceFor $
+ matchInexactly
+ caseFold
+ [ (prettyShow m, m)
+ | m <- ms
+ ]
+ str
+
+------------------------------
+-- Matching file targets
+--
+
+matchFile1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
+matchFile1 cs str1 exists =
+ nubMatchErrors $ do
+ c <- tryEach cs
+ filepath <- matchComponentFile c str1 exists
+ return (BuildTargetFile (cinfoName c) filepath)
+
+matchFile2 :: [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
+matchFile2 cs str1 str2 exists = do
+ guardComponentName str1
+ c <- matchComponentName cs str1
+ filepath <- matchComponentFile c str2 exists
+ return (BuildTargetFile (cinfoName c) filepath)
+
+matchFile3
+ :: [ComponentInfo]
+ -> String
+ -> String
+ -> String
+ -> Bool
+ -> Match BuildTarget
+matchFile3 cs str1 str2 str3 exists = do
+ ckind <- matchComponentKind str1
+ guardComponentName str2
+ c <- matchComponentKindAndName cs ckind str2
+ filepath <- matchComponentFile c str3 exists
+ return (BuildTargetFile (cinfoName c) filepath)
+
+matchComponentFile :: ComponentInfo -> String -> Bool -> Match FilePath
+matchComponentFile c str fexists =
+ expecting "file" str $
+ matchPlus
+ (matchFileExists str fexists)
+ ( matchPlusShadowing
+ ( msum
+ [ matchModuleFileRooted dirs ms str
+ , matchOtherFileRooted dirs hsFiles str
+ ]
+ )
+ ( msum
+ [ matchModuleFileUnrooted ms str
+ , matchOtherFileUnrooted hsFiles str
+ , matchOtherFileUnrooted cFiles str
+ , matchOtherFileUnrooted jsFiles str
+ ]
+ )
+ )
+ where
+ dirs = cinfoSrcDirs c
+ ms = cinfoModules c
+ hsFiles = cinfoHsFiles c
+ cFiles = cinfoCFiles c
+ jsFiles = cinfoJsFiles c
+
+-- utils
+
+matchFileExists :: FilePath -> Bool -> Match a
+matchFileExists _ False = mzero
+matchFileExists fname True = do
+ increaseConfidence
+ matchErrorNoSuch "file" fname
+
+matchModuleFileUnrooted :: [ModuleName] -> String -> Match FilePath
+matchModuleFileUnrooted ms str = do
+ let filepath = normalise str
+ _ <- matchModuleFileStem ms filepath
+ return filepath
+
+matchModuleFileRooted :: [FilePath] -> [ModuleName] -> String -> Match FilePath
+matchModuleFileRooted dirs ms str = nubMatches $ do
+ let filepath = normalise str
+ filepath' <- matchDirectoryPrefix dirs filepath
+ _ <- matchModuleFileStem ms filepath'
+ return filepath
+
+matchModuleFileStem :: [ModuleName] -> FilePath -> Match ModuleName
+matchModuleFileStem ms =
+ increaseConfidenceFor
+ . matchInexactly
+ caseFold
+ [(toFilePath m, m) | m <- ms]
+ . dropExtension
+
+matchOtherFileRooted :: [FilePath] -> [FilePath] -> FilePath -> Match FilePath
+matchOtherFileRooted dirs fs str = do
+ let filepath = normalise str
+ filepath' <- matchDirectoryPrefix dirs filepath
+ _ <- matchFile fs filepath'
+ return filepath
+
+matchOtherFileUnrooted :: [FilePath] -> FilePath -> Match FilePath
+matchOtherFileUnrooted fs str = do
+ let filepath = normalise str
+ _ <- matchFile fs filepath
+ return filepath
+
+matchFile :: [FilePath] -> FilePath -> Match FilePath
+matchFile fs =
+ increaseConfidenceFor
+ . matchInexactly caseFold [(f, f) | f <- fs]
+
+matchDirectoryPrefix :: [FilePath] -> FilePath -> Match FilePath
+matchDirectoryPrefix dirs filepath =
+ exactMatches $
+ catMaybes
+ [stripDirectory (normalise dir) filepath | dir <- dirs]
+ where
+ stripDirectory :: FilePath -> FilePath -> Maybe FilePath
+ stripDirectory dir fp =
+ joinPath `fmap` stripPrefix (splitDirectories dir) (splitDirectories fp)
+
------------------------------
-- Matching monad
--
@@ -592,6 +883,13 @@ matchPlus a@(NoMatch d1 ms) b@(NoMatch d2 ms')
| d1 < d2 = b
| otherwise = NoMatch d1 (ms ++ ms')
+-- | Combine two matchers. This is similar to 'ambiguousWith' with the
+-- difference that an exact match from the left matcher shadows any exact
+-- match on the right. Inexact matches are still collected however.
+matchPlusShadowing :: Match a -> Match a -> Match a
+matchPlusShadowing a@(ExactMatch _ _) (ExactMatch _ _) = a
+matchPlusShadowing a b = matchPlus a b
+
instance Functor Match where
fmap _ (NoMatch d ms) = NoMatch d ms
fmap f (ExactMatch d xs) = ExactMatch d (fmap f xs)
@@ -609,9 +907,8 @@ instance Monad Match where
addDepth d $
foldr matchPlus matchZero (map f xs)
InexactMatch d xs >>= f =
- addDepth d
- . forceInexact
- $ foldr matchPlus matchZero (map f xs)
+ addDepth d . forceInexact $
+ foldr matchPlus matchZero (map f xs)
addDepth :: Confidence -> Match a -> Match a
addDepth d' (NoMatch d msgs) = NoMatch (d' + d) msgs
@@ -630,6 +927,10 @@ matchErrorExpected, matchErrorNoSuch :: String -> String -> Match a
matchErrorExpected thing got = NoMatch 0 [MatchErrorExpected thing got]
matchErrorNoSuch thing got = NoMatch 0 [MatchErrorNoSuch thing got]
+expecting :: String -> String -> Match a -> Match a
+expecting thing got (NoMatch 0 _) = matchErrorExpected thing got
+expecting _ _ m = m
+
orNoSuchThing :: String -> String -> Match a -> Match a
orNoSuchThing thing got (NoMatch 0 _) = matchErrorNoSuch thing got
orNoSuchThing _ _ m = m
@@ -640,15 +941,26 @@ increaseConfidence = ExactMatch 1 [()]
increaseConfidenceFor :: Match a -> Match a
increaseConfidenceFor m = m >>= \r -> increaseConfidence >> return r
+nubMatches :: Eq a => Match a -> Match a
+nubMatches (NoMatch d msgs) = NoMatch d msgs
+nubMatches (ExactMatch d xs) = ExactMatch d (nub xs)
+nubMatches (InexactMatch d xs) = InexactMatch d (nub xs)
+
+nubMatchErrors :: Match a -> Match a
+nubMatchErrors (NoMatch d msgs) = NoMatch d (nub msgs)
+nubMatchErrors (ExactMatch d xs) = ExactMatch d xs
+nubMatchErrors (InexactMatch d xs) = InexactMatch d xs
+
-- | Lift a list of matches to an exact match.
-exactMatches :: [a] -> Match a
+exactMatches, inexactMatches :: [a] -> Match a
exactMatches [] = matchZero
exactMatches xs = ExactMatch 0 xs
-
-inexactMatches :: [a] -> Match a
inexactMatches [] = matchZero
inexactMatches xs = InexactMatch 0 xs
+tryEach :: [a] -> Match a
+tryEach = exactMatches
+
------------------------------
-- Top level match runner
--
@@ -739,9 +1051,10 @@ checkBuildTargets
let (enabled, disabled) =
partitionEithers
[ case componentDisabledReason enabledComps comp of
- Nothing -> Left cname
+ Nothing -> Left target'
Just reason -> Right (cname, reason)
- | (BuildTargetComponent cname) <- targets
+ | target <- targets
+ , let target'@(cname, _) = swizzleTarget target
, let comp = getComponent pkg_descr cname
]
@@ -749,13 +1062,28 @@ checkBuildTargets
[] -> return ()
((cname, reason) : _) -> dieWithException verbosity $ CheckBuildTargets $ formatReason (showComponentName cname) reason
+ for_ [(c, t) | (c, Just t) <- enabled] $ \(c, t) ->
+ warn verbosity $
+ "Ignoring '"
+ ++ either prettyShow id t
+ ++ ". The whole "
+ ++ showComponentName c
+ ++ " will be processed. (Support for "
+ ++ "module and file targets has not been implemented yet.)"
+
-- Pick out the actual CLBIs for each of these cnames
- for enabled $ \cname -> do
+ enabled' <- for enabled $ \(cname, _) -> do
case componentNameTargets' pkg_descr lbi cname of
[] -> error "checkBuildTargets: nothing enabled"
[target] -> return target
_targets -> error "checkBuildTargets: multiple copies enabled"
+
+ return enabled'
where
+ swizzleTarget (BuildTargetComponent c) = (c, Nothing)
+ swizzleTarget (BuildTargetModule c m) = (c, Just (Left m))
+ swizzleTarget (BuildTargetFile c f) = (c, Just (Right f))
+
formatReason cn DisabledComponent =
"Cannot process the "
++ cn
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 9609262868f4e15be333a3284c7d406eb91b2d86..6d22bf3a06ad615cb323b05857fc6534e79d9a38 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -310,6 +310,7 @@ test-suite unit-tests
UnitTests.Distribution.Client.InstallPlan
UnitTests.Distribution.Client.JobControl
UnitTests.Distribution.Client.ProjectConfig
+ UnitTests.Distribution.Client.ProjectPlanning
UnitTests.Distribution.Client.Store
UnitTests.Distribution.Client.Tar
UnitTests.Distribution.Client.Targets
diff --git a/cabal-install/src/Distribution/Client/CmdBench.hs b/cabal-install/src/Distribution/Client/CmdBench.hs
index db8b50f4b5557bbb61a659a5648c6ec207316290..b39aa9d6755e62137910130f51f0a81c64a46e2f 100644
--- a/cabal-install/src/Distribution/Client/CmdBench.hs
+++ b/cabal-install/src/Distribution/Client/CmdBench.hs
@@ -8,6 +8,7 @@ module Distribution.Client.CmdBench
-- * Internals exposed for testing
, componentNotBenchmarkProblem
+ , isSubComponentProblem
, noBenchmarksProblem
, selectPackageTargets
, selectComponentTarget
@@ -196,17 +197,25 @@ selectPackageTargets targetSelector targets
-- For the @bench@ command we just need to check it is a benchmark, in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either BenchTargetProblem k
-selectComponentTarget t
+selectComponentTarget subtarget@WholeComponent t
| CBenchName _ <- availableTargetComponentName t =
- selectComponentTargetBasic t
+ selectComponentTargetBasic subtarget t
| otherwise =
Left
( componentNotBenchmarkProblem
(availableTargetPackageId t)
(availableTargetComponentName t)
)
+selectComponentTarget subtarget t =
+ 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.
@@ -215,6 +224,8 @@ data BenchProblem
TargetProblemNoBenchmarks TargetSelector
| -- | The 'TargetSelector' refers to a component that is not a benchmark
TargetProblemComponentNotBenchmark PackageId ComponentName
+ | -- | Asking to benchmark an individual file or module is not supported
+ TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (Eq, Show)
type BenchTargetProblem = TargetProblem BenchProblem
@@ -227,6 +238,15 @@ componentNotBenchmarkProblem pkgid name =
CustomTargetProblem $
TargetProblemComponentNotBenchmark pkgid name
+isSubComponentProblem
+ :: PackageId
+ -> ComponentName
+ -> SubComponentTarget
+ -> TargetProblem BenchProblem
+isSubComponentProblem pkgid name subcomponent =
+ CustomTargetProblem $
+ TargetProblemIsSubComponent pkgid name subcomponent
+
reportTargetProblems :: Verbosity -> [BenchTargetProblem] -> IO a
reportTargetProblems verbosity =
dieWithException verbosity . RenderBenchTargetProblem . map renderBenchTargetProblem
@@ -263,4 +283,13 @@ renderBenchProblem (TargetProblemComponentNotBenchmark pkgid cname) =
++ prettyShow pkgid
++ "."
where
- targetSelector = TargetComponent pkgid cname
+ targetSelector = TargetComponent pkgid cname WholeComponent
+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 "
+ ++ renderTargetSelector targetSelector
+ ++ "."
+ where
+ targetSelector = TargetComponent pkgid cname subtarget
diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs
index 575e0d95d0b7f9a8169d666dd3b91114a88189f3..be4b26b00389faa2de7fbb44a88c6593eaff6f83 100644
--- a/cabal-install/src/Distribution/Client/CmdBuild.hs
+++ b/cabal-install/src/Distribution/Client/CmdBuild.hs
@@ -226,7 +226,8 @@ selectPackageTargets targetSelector targets
--
-- For the @build@ command we just need the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
diff --git a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs
index 0a4b326c9f002fdf94b08c6181db6e42e9b87426..8345d9ed59aea02dc47f820af7d2326652d4e05f 100644
--- a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs
+++ b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs
@@ -24,6 +24,7 @@ import Distribution.Client.TargetProblem
import Distribution.Client.TargetSelector
( ComponentKind (..)
, ComponentKindFilter
+ , SubComponentTarget (..)
, TargetSelector (..)
, componentKind
, showTargetSelector
@@ -141,18 +142,28 @@ renderTargetSelector (TargetAllPackages (Just kfilter)) =
"all the "
++ renderComponentKind Plural kfilter
++ " in the project"
-renderTargetSelector (TargetComponent pkgid cname) =
- "the "
+renderTargetSelector (TargetComponent pkgid cname subtarget) =
+ renderSubComponentTarget subtarget
+ ++ "the "
++ renderComponentName (packageName pkgid) cname
-renderTargetSelector (TargetComponentUnknown pkgname (Left ucname)) =
- "the component "
+renderTargetSelector (TargetComponentUnknown pkgname (Left ucname) subtarget) =
+ renderSubComponentTarget subtarget
+ ++ "the component "
++ prettyShow ucname
++ " in the package "
++ prettyShow pkgname
-renderTargetSelector (TargetComponentUnknown pkgname (Right cname)) =
- "the "
+renderTargetSelector (TargetComponentUnknown pkgname (Right cname) subtarget) =
+ renderSubComponentTarget subtarget
+ ++ "the "
++ renderComponentName pkgname cname
+renderSubComponentTarget :: SubComponentTarget -> String
+renderSubComponentTarget WholeComponent = ""
+renderSubComponentTarget (FileTarget filename) =
+ "the file " ++ filename ++ " in "
+renderSubComponentTarget (ModuleTarget modname) =
+ "the module " ++ prettyShow modname ++ " in "
+
renderOptionalStanza :: Plural -> OptionalStanza -> String
renderOptionalStanza Singular TestStanzas = "test suite"
renderOptionalStanza Plural TestStanzas = "test suites"
@@ -249,7 +260,7 @@ renderTargetProblem verb _ (TargetAvailableInIndex pkgname) =
++ "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."
-renderTargetProblem verb _ (TargetComponentNotProjectLocal pkgid cname) =
+renderTargetProblem verb _ (TargetComponentNotProjectLocal pkgid cname _) =
"Cannot "
++ verb
++ " the "
@@ -262,7 +273,7 @@ renderTargetProblem verb _ (TargetComponentNotProjectLocal pkgid cname) =
++ "non-local dependencies. To run test suites or benchmarks from "
++ "dependencies you can unpack the package locally and adjust the "
++ "cabal.project file to include that package directory."
-renderTargetProblem verb _ (TargetComponentNotBuildable pkgid cname) =
+renderTargetProblem verb _ (TargetComponentNotBuildable pkgid cname _) =
"Cannot "
++ verb
++ " the "
@@ -275,7 +286,7 @@ renderTargetProblem verb _ (TargetComponentNotBuildable pkgid cname) =
++ "property is conditional on flags. Alternatively you may simply have to "
++ "edit the .cabal file to declare it as buildable and fix any resulting "
++ "build problems."
-renderTargetProblem verb _ (TargetOptionalStanzaDisabledByUser _ cname) =
+renderTargetProblem verb _ (TargetOptionalStanzaDisabledByUser _ cname _) =
"Cannot "
++ verb
++ " the "
@@ -294,7 +305,7 @@ renderTargetProblem verb _ (TargetOptionalStanzaDisabledByUser _ cname) =
++ "explanation."
where
compkinds = renderComponentKind Plural (componentKind cname)
-renderTargetProblem verb _ (TargetOptionalStanzaDisabledBySolver pkgid cname) =
+renderTargetProblem verb _ (TargetOptionalStanzaDisabledBySolver pkgid cname _) =
"Cannot "
++ verb
++ " the "
diff --git a/cabal-install/src/Distribution/Client/CmdHaddock.hs b/cabal-install/src/Distribution/Client/CmdHaddock.hs
index 0dabb2a745fb88423c5b635e5d704c0506459f52..b67bda4bcecc02f10d4140ccefc12978df99e14e 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddock.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs
@@ -268,7 +268,8 @@ selectPackageTargets haddockFlags targetSelector targets
-- For the @haddock@ command we just need the basic checks on being buildable
-- etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs
index 0adeca99446f5e1b593a028476f935322ef80d57..4e0a84bda516c7f05a6cea5d7d5da87e811d5069 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall.hs
@@ -774,7 +774,7 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS
let
targetSelectors' = flip filter targetSelectors $ \case
- TargetComponentUnknown name _
+ TargetComponentUnknown name _ _
| name `elem` hackageNames -> False
TargetPackageNamed name _
| name `elem` hackageNames -> False
@@ -954,7 +954,7 @@ warnIfNoExes verbosity buildCtx =
selectors = concatMap (NE.toList . snd) targets
noExes = null $ catMaybes $ exeMaybe <$> components
- exeMaybe (ComponentTarget (CExeName exe)) = Just exe
+ exeMaybe (ComponentTarget (CExeName exe) _) = Just exe
exeMaybe _ = Nothing
-- | Return the package specifiers and non-global environment file entries.
@@ -1034,7 +1034,7 @@ installCheckUnitExes
else traverse_ warnAbout (zip symlinkables exes)
where
exes = catMaybes $ (exeMaybe . fst) <$> components
- exeMaybe (ComponentTarget (CExeName exe)) = Just exe
+ exeMaybe (ComponentTarget (CExeName exe) _) = Just exe
exeMaybe _ = Nothing
warnAbout (True, _) = return ()
@@ -1136,7 +1136,7 @@ entriesForLibraryComponents :: TargetsMap -> [GhcEnvironmentFileEntry]
entriesForLibraryComponents = Map.foldrWithKey' (\k v -> mappend (go k v)) []
where
hasLib :: (ComponentTarget, NonEmpty TargetSelector) -> Bool
- hasLib (ComponentTarget (CLibName _), _) = True
+ hasLib (ComponentTarget (CLibName _) _, _) = True
hasLib _ = False
go
@@ -1262,7 +1262,8 @@ selectPackageTargets targetSelector targets
--
-- For the @build@ command we just need the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either TargetProblem' k
selectComponentTarget = selectComponentTargetBasic
diff --git a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
index 2573635f8806cf2ce1cbf99007c4f48625fb1471..c6939729f61ffc7d3909b037127da36073f340b1 100644
--- a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
@@ -52,7 +52,7 @@ woPackageTargets :: WithoutProjectTargetSelector -> TargetSelector
woPackageTargets (WoPackageId pid) =
TargetPackageNamed (pkgName pid) Nothing
woPackageTargets (WoPackageComponent pid cn) =
- TargetComponentUnknown (pkgName pid) (Right cn)
+ TargetComponentUnknown (pkgName pid) (Right cn) WholeComponent
woPackageTargets (WoURI _) =
TargetAllPackages (Just ExeKind)
diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs
index 6c4c112c44d1254ac9134ac99febe16c64962d1e..1fefd3a7375635f05b85853c85ebdf5ecf85b15b 100644
--- a/cabal-install/src/Distribution/Client/CmdListBin.hs
+++ b/cabal-install/src/Distribution/Client/CmdListBin.hs
@@ -290,9 +290,10 @@ selectPackageTargets targetSelector targets
-- (an executable, a test, or a benchmark), in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either ListBinTargetProblem k
-selectComponentTarget t =
+selectComponentTarget subtarget@WholeComponent t =
case availableTargetComponentName t of
CExeName _ -> component
CTestName _ -> component
@@ -302,7 +303,14 @@ selectComponentTarget t =
where
pkgid = availableTargetPackageId t
cname = availableTargetComponentName t
- component = selectComponentTargetBasic t
+ component = selectComponentTargetBasic subtarget t
+selectComponentTarget subtarget t =
+ Left
+ ( isSubComponentProblem
+ (availableTargetPackageId t)
+ (availableTargetComponentName t)
+ subtarget
+ )
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
@@ -315,6 +323,8 @@ data ListBinProblem
TargetProblemMultipleTargets TargetsMap
| -- | The 'TargetSelector' refers to a component that is not an executable
TargetProblemComponentNotRightKind PackageId ComponentName
+ | -- | Asking to run an individual file or module is not supported
+ TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (Eq, Show)
type ListBinTargetProblem = TargetProblem ListBinProblem
@@ -335,6 +345,15 @@ componentNotRightKindProblem pkgid name =
CustomTargetProblem $
TargetProblemComponentNotRightKind pkgid name
+isSubComponentProblem
+ :: PackageId
+ -> ComponentName
+ -> SubComponentTarget
+ -> TargetProblem ListBinProblem
+isSubComponentProblem pkgid name subcomponent =
+ CustomTargetProblem $
+ TargetProblemIsSubComponent pkgid name subcomponent
+
reportTargetProblems :: Verbosity -> [ListBinTargetProblem] -> IO a
reportTargetProblems verbosity =
dieWithException verbosity . ListBinTargetException . unlines . map renderListBinTargetProblem
@@ -385,7 +404,16 @@ renderListBinProblem (TargetProblemComponentNotRightKind pkgid cname) =
++ prettyShow pkgid
++ "."
where
- targetSelector = TargetComponent pkgid cname
+ targetSelector = TargetComponent pkgid cname WholeComponent
+renderListBinProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
+ "The list-bin command can only find a binary as a whole, "
+ ++ "not files or modules within them, but the target '"
+ ++ showTargetSelector targetSelector
+ ++ "' refers to "
+ ++ renderTargetSelector targetSelector
+ ++ "."
+ where
+ targetSelector = TargetComponent pkgid cname subtarget
renderListBinProblem (TargetProblemNoRightComps targetSelector) =
"Cannot list-bin the target '"
++ showTargetSelector targetSelector
diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs
index bed2cdc6ee8f9c953d1789effa021e634f64b731..e243eb8297428902e036aa940c36021f91205281 100644
--- a/cabal-install/src/Distribution/Client/CmdRepl.hs
+++ b/cabal-install/src/Distribution/Client/CmdRepl.hs
@@ -734,7 +734,8 @@ selectPackageTargetsSingle decision targetSelector targets
--
-- For the @repl@ command we just need the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either ReplTargetProblem k
selectComponentTarget = selectComponentTargetBasic
diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs
index a2a9cebd63787cfce32a837e8a8dffd07d6eeb0c..b390dacb22e94593c5ed16642dc9ef15217136ad 100644
--- a/cabal-install/src/Distribution/Client/CmdRun.hs
+++ b/cabal-install/src/Distribution/Client/CmdRun.hs
@@ -439,9 +439,10 @@ selectPackageTargets targetSelector targets
-- (an executable, a test, or a benchmark), in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either RunTargetProblem k
-selectComponentTarget t =
+selectComponentTarget subtarget@WholeComponent t =
case availableTargetComponentName t of
CExeName _ -> component
CTestName _ -> component
@@ -450,7 +451,14 @@ selectComponentTarget t =
where
pkgid = availableTargetPackageId t
cname = availableTargetComponentName t
- component = selectComponentTargetBasic t
+ component = selectComponentTargetBasic subtarget t
+selectComponentTarget subtarget t =
+ Left
+ ( isSubComponentProblem
+ (availableTargetPackageId t)
+ (availableTargetComponentName t)
+ subtarget
+ )
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
@@ -463,6 +471,8 @@ data RunProblem
TargetProblemMultipleTargets TargetsMap
| -- | The 'TargetSelector' refers to a component that is not an executable
TargetProblemComponentNotExe PackageId ComponentName
+ | -- | Asking to run an individual file or module is not supported
+ TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (Eq, Show)
type RunTargetProblem = TargetProblem RunProblem
@@ -483,6 +493,15 @@ componentNotExeProblem pkgid name =
CustomTargetProblem $
TargetProblemComponentNotExe pkgid name
+isSubComponentProblem
+ :: PackageId
+ -> ComponentName
+ -> SubComponentTarget
+ -> TargetProblem RunProblem
+isSubComponentProblem pkgid name subcomponent =
+ CustomTargetProblem $
+ TargetProblemIsSubComponent pkgid name subcomponent
+
reportTargetProblems :: Verbosity -> [RunTargetProblem] -> IO a
reportTargetProblems verbosity =
dieWithException verbosity . CmdRunReportTargetProblems . unlines . map renderRunTargetProblem
@@ -536,7 +555,16 @@ renderRunProblem (TargetProblemComponentNotExe pkgid cname) =
++ prettyShow pkgid
++ "."
where
- targetSelector = TargetComponent pkgid cname
+ targetSelector = TargetComponent pkgid cname WholeComponent
+renderRunProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
+ "The run command can only run an executable as a whole, "
+ ++ "not files or modules within them, but the target '"
+ ++ showTargetSelector targetSelector
+ ++ "' refers to "
+ ++ renderTargetSelector targetSelector
+ ++ "."
+ where
+ targetSelector = TargetComponent pkgid cname subtarget
renderRunProblem (TargetProblemNoExes targetSelector) =
"Cannot run the target '"
++ showTargetSelector targetSelector
diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs
index 01ab558e65527a71b306257b577d50074d8036d2..c77c1eae9105b2aad76326978c7c0ec19b58a82e 100644
--- a/cabal-install/src/Distribution/Client/CmdSdist.hs
+++ b/cabal-install/src/Distribution/Client/CmdSdist.hs
@@ -377,8 +377,8 @@ reifyTargetSelectors pkgs sels =
go (TargetPackage _ _ (Just kind)) = [Left (AllComponentsOnly kind)]
go (TargetAllPackages (Just kind)) = [Left (AllComponentsOnly kind)]
go (TargetPackageNamed pname _) = [Left (NonlocalPackageNotAllowed pname)]
- go (TargetComponentUnknown pname _) = [Left (NonlocalPackageNotAllowed pname)]
- go (TargetComponent _ cname) = [Left (ComponentsNotAllowed cname)]
+ go (TargetComponentUnknown pname _ _) = [Left (NonlocalPackageNotAllowed pname)]
+ go (TargetComponent _ cname _) = [Left (ComponentsNotAllowed cname)]
data TargetProblem
= AllComponentsOnly ComponentKind
diff --git a/cabal-install/src/Distribution/Client/CmdTest.hs b/cabal-install/src/Distribution/Client/CmdTest.hs
index bb5ed9d124f82f13946966a9bc2df74e49f61229..74fcc3a78b2bec20279336cf6276c8a9e7d92356 100644
--- a/cabal-install/src/Distribution/Client/CmdTest.hs
+++ b/cabal-install/src/Distribution/Client/CmdTest.hs
@@ -7,6 +7,7 @@ module Distribution.Client.CmdTest
, testAction
-- * Internals exposed for testing
+ , isSubComponentProblem
, notTestProblem
, noTestsProblem
, selectPackageTargets
@@ -205,18 +206,26 @@ selectPackageTargets targetSelector targets
-- For the @test@ command we just need to check it is a test-suite, in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either TestTargetProblem k
-selectComponentTarget t
+selectComponentTarget subtarget@WholeComponent t
| CTestName _ <- availableTargetComponentName t =
either Left return $
- selectComponentTargetBasic t
+ selectComponentTargetBasic subtarget t
| otherwise =
Left
( notTestProblem
(availableTargetPackageId t)
(availableTargetComponentName t)
)
+selectComponentTarget subtarget t =
+ Left
+ ( isSubComponentProblem
+ (availableTargetPackageId t)
+ (availableTargetComponentName t)
+ subtarget
+ )
-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @test@ command.
@@ -225,6 +234,8 @@ data TestProblem
TargetProblemNoTests TargetSelector
| -- | The 'TargetSelector' refers to a component that is not a test-suite
TargetProblemComponentNotTest PackageId ComponentName
+ | -- | Asking to test an individual file or module is not supported
+ TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (Eq, Show)
type TestTargetProblem = TargetProblem TestProblem
@@ -235,6 +246,15 @@ noTestsProblem = CustomTargetProblem . TargetProblemNoTests
notTestProblem :: PackageId -> ComponentName -> TargetProblem TestProblem
notTestProblem pkgid name = CustomTargetProblem $ TargetProblemComponentNotTest pkgid name
+isSubComponentProblem
+ :: PackageId
+ -> ComponentName
+ -> SubComponentTarget
+ -> TargetProblem TestProblem
+isSubComponentProblem pkgid name subcomponent =
+ CustomTargetProblem $
+ TargetProblemIsSubComponent pkgid name subcomponent
+
reportTargetProblems :: Verbosity -> Flag Bool -> [TestTargetProblem] -> IO a
reportTargetProblems verbosity failWhenNoTestSuites problems =
case (failWhenNoTestSuites, problems) of
@@ -289,4 +309,13 @@ renderTestProblem (TargetProblemComponentNotTest pkgid cname) =
++ prettyShow pkgid
++ "."
where
- targetSelector = TargetComponent pkgid cname
+ targetSelector = TargetComponent pkgid cname WholeComponent
+renderTestProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
+ "The test command can only run test suites as a whole, "
+ ++ "not files or modules within them, but the target '"
+ ++ showTargetSelector targetSelector
+ ++ "' refers to "
+ ++ renderTargetSelector targetSelector
+ ++ "."
+ where
+ targetSelector = TargetComponent pkgid cname subtarget
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs
index eef99b280c3485531c046c64fd4b30d67f01f753..b93064ea7be9ccb8158c3eb3b3ce31e856cf3377 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs
@@ -92,20 +92,19 @@ packageFileMonitorKeyValues
packageFileMonitorKeyValues elab =
(elab_config, buildComponents)
where
- -- The first part, 'elab_config', is the value used to guard (re)configuring the package.
+ -- The first part is the value used to guard (re)configuring the package.
-- That is, if this value changes then we will reconfigure.
-- The ElaboratedConfiguredPackage consists mostly (but not entirely) of
-- information that affects the (re)configure step. But those parts that
-- do not affect the configure step need to be nulled out. Those parts are
-- the specific targets that we're going to build.
--
- -- The second part is the value used to guard the build step. So this is
- -- more or less the opposite of the first part, as it's just the info about
- -- what targets we're going to build.
- --
+
-- Additionally we null out the parts that don't affect the configure step because they're simply
-- about how tests or benchmarks are run
+ -- TODO there may be more things to null here too, in the future.
+
elab_config :: ElaboratedConfiguredPackage
elab_config =
elab
@@ -128,7 +127,7 @@ packageFileMonitorKeyValues elab =
-- what targets we're going to build.
--
buildComponents :: Set ComponentName
- buildComponents = Set.fromList [cn | ComponentTarget cn <- elabBuildTargets elab]
+ buildComponents = elabBuildTargetWholeComponents elab
-- | Do all the checks on whether a package has changed and thus needs either
-- rebuilding or reconfiguring and rebuilding.
diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
index 0a95df746af205d98b39bb97de980de092f0080f..cbe5a67cea6f9bf4698a1bfbf304c6eb659eca83 100644
--- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
+++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs
@@ -887,7 +887,7 @@ hasValidHaddockTargets ElaboratedConfiguredPackage{..}
++ elabHaddockTargets
componentHasHaddocks :: ComponentTarget -> Bool
- componentHasHaddocks (ComponentTarget name) =
+ componentHasHaddocks (ComponentTarget name _) =
case name of
CLibName LMainLibName -> hasHaddocks
CLibName (LSubLibName _) -> elabHaddockInternal && hasHaddocks
diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
index 4f5c9faeed8e95f3b77eb1c69a991eeab1e8a9a1..db99b2576b92e29aa836dbec54a4ee57a881a2e4 100644
--- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs
@@ -71,6 +71,7 @@ module Distribution.Client.ProjectOrchestration
, ComponentName (..)
, ComponentKind (..)
, ComponentTarget (..)
+ , SubComponentTarget (..)
, selectComponentTargetBasic
, distinctTargetComponents
@@ -607,7 +608,8 @@ resolveTargets
-> Either (TargetProblem err) [k]
)
-> ( forall k
- . AvailableTarget k
+ . SubComponentTarget
+ -> AvailableTarget k
-> Either (TargetProblem err) k
)
-> ElaboratedInstallPlan
@@ -645,7 +647,7 @@ resolveTargets
| Just ats <-
fmap (maybe id filterTargetsKind mkfilter) $
Map.lookup pkgid availableTargetsByPackageId =
- fmap componentTargets $
+ fmap (componentTargets WholeComponent) $
selectPackageTargets bt ats
| otherwise =
Left (TargetProblemNoSuchPackage pkgid)
@@ -663,23 +665,23 @@ resolveTargets
-- .cabal files for a single package?
checkTarget bt@(TargetAllPackages mkfilter) =
- fmap componentTargets
+ fmap (componentTargets WholeComponent)
. selectPackageTargets bt
. maybe id filterTargetsKind mkfilter
. filter availableTargetLocalToProject
$ concat (Map.elems availableTargetsByPackageId)
- checkTarget (TargetComponent pkgid cname)
+ checkTarget (TargetComponent pkgid cname subtarget)
| Just ats <-
Map.lookup
(pkgid, cname)
availableTargetsByPackageIdAndComponentName =
- fmap componentTargets $
- selectComponentTargets ats
+ fmap (componentTargets subtarget) $
+ selectComponentTargets subtarget ats
| Map.member pkgid availableTargetsByPackageId =
Left (TargetProblemNoSuchComponent pkgid cname)
| otherwise =
Left (TargetProblemNoSuchPackage pkgid)
- checkTarget (TargetComponentUnknown pkgname ecname)
+ checkTarget (TargetComponentUnknown pkgname ecname subtarget)
| Just ats <- case ecname of
Left ucname ->
Map.lookup
@@ -689,8 +691,8 @@ resolveTargets
Map.lookup
(pkgname, cname)
availableTargetsByPackageNameAndComponentName =
- fmap componentTargets $
- selectComponentTargets ats
+ fmap (componentTargets subtarget) $
+ selectComponentTargets subtarget ats
| Map.member pkgname availableTargetsByPackageName =
Left (TargetProblemUnknownComponent pkgname ecname)
| otherwise =
@@ -699,7 +701,7 @@ resolveTargets
| Just ats <-
fmap (maybe id filterTargetsKind mkfilter) $
Map.lookup pkgname availableTargetsByPackageName =
- fmap componentTargets
+ fmap (componentTargets WholeComponent)
. selectPackageTargets bt
$ ats
| Just SourcePackageDb{packageIndex} <- mPkgDb
@@ -710,18 +712,20 @@ resolveTargets
Left (TargetNotInProject pkgname)
componentTargets
- :: [(b, ComponentName)]
+ :: SubComponentTarget
+ -> [(b, ComponentName)]
-> [(b, ComponentTarget)]
- componentTargets =
- map (fmap (\cname -> ComponentTarget cname))
+ componentTargets subtarget =
+ map (fmap (\cname -> ComponentTarget cname subtarget))
selectComponentTargets
- :: [AvailableTarget k]
+ :: SubComponentTarget
+ -> [AvailableTarget k]
-> Either (TargetProblem err) [k]
- selectComponentTargets =
+ selectComponentTargets subtarget =
either (Left . NE.head) Right
. checkErrors
- . map selectComponentTarget
+ . map (selectComponentTarget subtarget)
checkErrors :: [Either e a] -> Either (NonEmpty e) [a]
checkErrors =
@@ -877,9 +881,11 @@ forgetTargetsDetail = map forgetTargetDetail
-- buildable and isn't a test suite or benchmark that is disabled. This
-- can also be used to do these basic checks as part of a custom impl that
selectComponentTargetBasic
- :: AvailableTarget k
+ :: SubComponentTarget
+ -> AvailableTarget k
-> Either (TargetProblem a) k
selectComponentTargetBasic
+ subtarget
AvailableTarget
{ availableTargetPackageId = pkgid
, availableTargetComponentName = cname
@@ -887,13 +893,13 @@ selectComponentTargetBasic
} =
case availableTargetStatus of
TargetDisabledByUser ->
- Left (TargetOptionalStanzaDisabledByUser pkgid cname)
+ Left (TargetOptionalStanzaDisabledByUser pkgid cname subtarget)
TargetDisabledBySolver ->
- Left (TargetOptionalStanzaDisabledBySolver pkgid cname)
+ Left (TargetOptionalStanzaDisabledBySolver pkgid cname subtarget)
TargetNotLocal ->
- Left (TargetComponentNotProjectLocal pkgid cname)
+ Left (TargetComponentNotProjectLocal pkgid cname subtarget)
TargetNotBuildable ->
- Left (TargetComponentNotBuildable pkgid cname)
+ Left (TargetComponentNotBuildable pkgid cname subtarget)
TargetBuildable targetKey _ ->
Right targetKey
@@ -918,7 +924,7 @@ distinctTargetComponents targetsMap =
Set.fromList
[ (uid, cname)
| (uid, cts) <- Map.toList targetsMap
- , (ComponentTarget cname, _) <- cts
+ , (ComponentTarget cname _, _) <- cts
]
------------------------------------------------------------------------------
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index deff1f38bf06b4e955443e765953ec3cbb797058..ad9e507ae5c2bb03d55e7008f3ed9828ff9bb49a 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -57,6 +57,7 @@ module Distribution.Client.ProjectPlanning
, AvailableTargetStatus (..)
, TargetRequested (..)
, ComponentTarget (..)
+ , SubComponentTarget (..)
, showComponentTarget
, nubComponentTargets
@@ -68,6 +69,7 @@ module Distribution.Client.ProjectPlanning
-- * Utils required for building
, pkgHasEphemeralBuildTargets
+ , elabBuildTargetWholeComponents
, configureCompiler
-- * Setup.hs CLI flags for building
@@ -3051,7 +3053,7 @@ nubComponentTargets =
concatMap (wholeComponentOverrides . map snd)
. groupBy ((==) `on` fst)
. sortBy (compare `on` fst)
- . map (\t@((ComponentTarget cname, _)) -> (cname, t))
+ . map (\t@((ComponentTarget cname _, _)) -> (cname, t))
. map compatSubComponentTargets
where
-- If we're building the whole component then that the only target all we
@@ -3060,7 +3062,7 @@ nubComponentTargets =
:: [(ComponentTarget, a)]
-> [(ComponentTarget, NonEmpty a)]
wholeComponentOverrides ts =
- case [ta | ta@(ComponentTarget _, _) <- ts] of
+ case [ta | ta@(ComponentTarget _ WholeComponent, _) <- ts] of
((t, x) : _) ->
let
-- Delete tuple (t, x) from original list to avoid duplicates.
@@ -3073,9 +3075,9 @@ nubComponentTargets =
-- Not all Cabal Setup.hs versions support sub-component targets, so switch
-- them over to the whole component
compatSubComponentTargets :: (ComponentTarget, a) -> (ComponentTarget, a)
- compatSubComponentTargets target@(ComponentTarget cname, x)
+ compatSubComponentTargets target@(ComponentTarget cname _subtarget, x)
| not setupHsSupportsSubComponentTargets =
- (ComponentTarget cname, x)
+ (ComponentTarget cname WholeComponent, x)
| otherwise = target
-- Actually the reality is that no current version of Cabal's Setup.hs
@@ -3091,6 +3093,19 @@ pkgHasEphemeralBuildTargets elab =
|| (not . null) (elabTestTargets elab)
|| (not . null) (elabBenchTargets elab)
|| (not . null) (elabHaddockTargets elab)
+ || (not . null)
+ [ () | ComponentTarget _ subtarget <- elabBuildTargets elab, subtarget /= WholeComponent
+ ]
+
+-- | The components that we'll build all of, meaning that after they're built
+-- we can skip building them again (unlike with building just some modules or
+-- other files within a component).
+elabBuildTargetWholeComponents
+ :: ElaboratedConfiguredPackage
+ -> Set ComponentName
+elabBuildTargetWholeComponents elab =
+ Set.fromList
+ [cname | ComponentTarget cname WholeComponent <- elabBuildTargets elab]
------------------------------------------------------------------------------
@@ -3264,7 +3279,7 @@ pruneInstallPlanPass1 pkgs
add_repl_target ecp
| elabUnitId ecp `Set.member` all_desired_repl_targets =
ecp
- { elabReplTarget = maybeToList (ComponentTarget <$> elabComponentName ecp)
+ { elabReplTarget = maybeToList (ComponentTarget <$> (elabComponentName ecp) <*> pure WholeComponent)
, elabBuildStyle = BuildInplaceOnly InMemory
}
| otherwise = ecp
@@ -3402,7 +3417,7 @@ pruneInstallPlanPass1 pkgs
optionalStanzasRequiredByTargets pkg =
optStanzaSetFromList
[ stanza
- | ComponentTarget cname <-
+ | ComponentTarget cname _ <-
elabBuildTargets pkg
++ elabTestTargets pkg
++ elabBenchTargets pkg
@@ -3562,7 +3577,7 @@ pruneInstallPlanPass2 pkgs =
libTargetsRequiredForRevDeps =
[ c
| installedUnitId elab `Set.member` hasReverseLibDeps
- , let c = ComponentTarget (CLibName Cabal.defaultLibName)
+ , let c = ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent
, -- Don't enable building for anything which is being build in memory
elabBuildStyle elab /= BuildInplaceOnly InMemory
]
@@ -3575,6 +3590,7 @@ pruneInstallPlanPass2 pkgs =
packageName $
elabPkgSourceId elab
)
+ WholeComponent
| installedUnitId elab `Set.member` hasReverseExeDeps
]
@@ -3990,7 +4006,7 @@ setupHsConfigureArgs
-> [String]
setupHsConfigureArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabPackage _}) = []
setupHsConfigureArgs elab@(ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent comp}) =
- [showComponentTarget (packageId elab) (ComponentTarget cname)]
+ [showComponentTarget (packageId elab) (ComponentTarget cname WholeComponent)]
where
cname =
fromMaybe
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
index 1a5ace436aeb8ceb242093d27e92d95f0a7f127f..96de8adea45b9b67f233707c0c4447882af3c1b7 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs
@@ -48,6 +48,7 @@ module Distribution.Client.ProjectPlanning.Types
, showComponentTarget
, showTestComponentTarget
, showBenchComponentTarget
+ , SubComponentTarget (..)
, isSubLibComponentTarget
, isForeignLibComponentTarget
, isExeComponentTarget
@@ -63,6 +64,9 @@ import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.PackageHash
+import Distribution.Client.TargetSelector
+ ( SubComponentTarget (..)
+ )
import Distribution.Client.DistDirLayout
import Distribution.Client.InstallPlan
@@ -393,7 +397,7 @@ elabRequiresRegistration elab =
-- redundant anymore.
|| any (depends_on_lib pkg) (elabBuildTargets elab)
where
- depends_on_lib pkg (ComponentTarget cn) =
+ depends_on_lib pkg (ComponentTarget cn _) =
not
( null
( CD.select
@@ -408,11 +412,10 @@ elabRequiresRegistration elab =
-- that means we have to look more carefully to see
-- if there is anything to register
Cabal.hasLibs (elabPkgDescription elab)
-
-- NB: this means we DO NOT reregister if you just built a
-- single file
- is_lib_target (ComponentTarget cn) = is_lib cn
-
+ is_lib_target (ComponentTarget cn WholeComponent) = is_lib cn
+ is_lib_target _ = False
is_lib (CLibName _) = True
is_lib _ = False
@@ -797,7 +800,7 @@ type ElaboratedReadyPackage = GenericReadyPackage ElaboratedConfiguredPackage
-- | Specific targets within a package or component to act on e.g. to build,
-- haddock or open a repl.
-data ComponentTarget = ComponentTarget ComponentName
+data ComponentTarget = ComponentTarget ComponentName SubComponentTarget
deriving (Eq, Ord, Show, Generic)
instance Binary ComponentTarget
@@ -810,35 +813,38 @@ showComponentTarget pkgid =
Cabal.showBuildTarget pkgid . toBuildTarget
where
toBuildTarget :: ComponentTarget -> Cabal.BuildTarget
- toBuildTarget (ComponentTarget cname) =
- Cabal.BuildTargetComponent cname
+ toBuildTarget (ComponentTarget cname subtarget) =
+ case subtarget of
+ WholeComponent -> Cabal.BuildTargetComponent cname
+ ModuleTarget mname -> Cabal.BuildTargetModule cname mname
+ FileTarget fname -> Cabal.BuildTargetFile cname fname
showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String
-showTestComponentTarget _ (ComponentTarget (CTestName n)) = Just $ prettyShow n
+showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ prettyShow n
showTestComponentTarget _ _ = Nothing
isTestComponentTarget :: ComponentTarget -> Bool
-isTestComponentTarget (ComponentTarget (CTestName _)) = True
+isTestComponentTarget (ComponentTarget (CTestName _) _) = True
isTestComponentTarget _ = False
showBenchComponentTarget :: PackageId -> ComponentTarget -> Maybe String
-showBenchComponentTarget _ (ComponentTarget (CBenchName n)) = Just $ prettyShow n
+showBenchComponentTarget _ (ComponentTarget (CBenchName n) _) = Just $ prettyShow n
showBenchComponentTarget _ _ = Nothing
isBenchComponentTarget :: ComponentTarget -> Bool
-isBenchComponentTarget (ComponentTarget (CBenchName _)) = True
+isBenchComponentTarget (ComponentTarget (CBenchName _) _) = True
isBenchComponentTarget _ = False
isForeignLibComponentTarget :: ComponentTarget -> Bool
-isForeignLibComponentTarget (ComponentTarget (CFLibName _)) = True
+isForeignLibComponentTarget (ComponentTarget (CFLibName _) _) = True
isForeignLibComponentTarget _ = False
isExeComponentTarget :: ComponentTarget -> Bool
-isExeComponentTarget (ComponentTarget (CExeName _)) = True
+isExeComponentTarget (ComponentTarget (CExeName _) _) = True
isExeComponentTarget _ = False
isSubLibComponentTarget :: ComponentTarget -> Bool
-isSubLibComponentTarget (ComponentTarget (CLibName (LSubLibName _))) = True
+isSubLibComponentTarget (ComponentTarget (CLibName (LSubLibName _)) _) = True
isSubLibComponentTarget _ = False
componentOptionalStanza :: CD.Component -> Maybe OptionalStanza
diff --git a/cabal-install/src/Distribution/Client/TargetProblem.hs b/cabal-install/src/Distribution/Client/TargetProblem.hs
index 1292c490968576f5a9f8c3dd0a586a325c1bd8eb..680250273c0224c1c0de025e839f92730e4ba9bd 100644
--- a/cabal-install/src/Distribution/Client/TargetProblem.hs
+++ b/cabal-install/src/Distribution/Client/TargetProblem.hs
@@ -9,7 +9,7 @@ import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.ProjectPlanning (AvailableTarget)
-import Distribution.Client.TargetSelector (TargetSelector)
+import Distribution.Client.TargetSelector (SubComponentTarget, TargetSelector)
import Distribution.Package (PackageId, PackageName)
import Distribution.Simple.LocalBuildInfo (ComponentName (..))
import Distribution.Types.UnqualComponentName (UnqualComponentName)
@@ -21,15 +21,19 @@ data TargetProblem a
| TargetComponentNotProjectLocal
PackageId
ComponentName
+ SubComponentTarget
| TargetComponentNotBuildable
PackageId
ComponentName
+ SubComponentTarget
| TargetOptionalStanzaDisabledByUser
PackageId
ComponentName
+ SubComponentTarget
| TargetOptionalStanzaDisabledBySolver
PackageId
ComponentName
+ SubComponentTarget
| TargetProblemUnknownComponent
PackageName
(Either UnqualComponentName ComponentName)
diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs
index 4932f07361f76072254a4729d8d917e2b481dfbf..d29413642de738a53b72c0d32e3cf8ac4d5b57ef 100644
--- a/cabal-install/src/Distribution/Client/TargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/TargetSelector.hs
@@ -25,6 +25,7 @@ module Distribution.Client.TargetSelector
, TargetImplicitCwd (..)
, ComponentKind (..)
, ComponentKindFilter
+ , SubComponentTarget (..)
, QualLevel (..)
, componentKind
@@ -65,6 +66,7 @@ import Distribution.Types.UnqualComponentName
import Distribution.ModuleName
( ModuleName
+ , toFilePath
)
import Distribution.PackageDescription
( Benchmark (..)
@@ -99,6 +101,9 @@ import Control.Arrow ((&&&))
import Control.Monad hiding
( mfilter
)
+import Data.List
+ ( stripPrefix
+ )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Lazy as Map.Lazy
import qualified Data.Map.Strict as Map
@@ -130,11 +135,15 @@ import qualified System.Directory as IO
import System.FilePath
( dropTrailingPathSeparator
, equalFilePath
+ , normalise
, (<.>)
, (</>)
)
import System.FilePath as FilePath
- ( splitPath
+ ( dropExtension
+ , joinPath
+ , splitDirectories
+ , splitPath
, takeExtension
)
import Text.EditDistance
@@ -183,13 +192,14 @@ data TargetSelector
| -- | All packages, or all components of a particular kind in all packages.
TargetAllPackages (Maybe ComponentKindFilter)
| -- | A specific component in a package within the project.
- TargetComponent PackageId ComponentName
+ TargetComponent PackageId ComponentName SubComponentTarget
| -- | A component in a package, but where it cannot be verified that the
-- package has such a component, or because the package is itself not
-- known.
TargetComponentUnknown
PackageName
(Either UnqualComponentName ComponentName)
+ SubComponentTarget
deriving (Eq, Ord, Show, Generic)
-- | Does this 'TargetPackage' selector arise from syntax referring to a
@@ -204,6 +214,21 @@ data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
type ComponentKindFilter = ComponentKind
+-- | Either the component as a whole or detail about a file or module target
+-- within a component.
+data SubComponentTarget
+ = -- | The component as a whole
+ WholeComponent
+ | -- | A specific module within a component.
+ ModuleTarget ModuleName
+ | -- | A specific file within a component. Note that this does not carry the
+ -- file extension.
+ FileTarget FilePath
+ deriving (Eq, Ord, Show, Generic)
+
+instance Binary SubComponentTarget
+instance Structured SubComponentTarget
+
-- ------------------------------------------------------------
-- * Top level, do everything
@@ -389,8 +414,12 @@ showTargetSelectorKind bt = case bt of
TargetPackageNamed _ (Just _) -> "named-package:filter"
TargetAllPackages Nothing -> "package *"
TargetAllPackages (Just _) -> "package *:filter"
- TargetComponent _ _ -> "component"
- TargetComponentUnknown _ _ -> "unknown-component"
+ TargetComponent _ _ WholeComponent -> "component"
+ TargetComponent _ _ ModuleTarget{} -> "module"
+ TargetComponent _ _ FileTarget{} -> "file"
+ TargetComponentUnknown _ _ WholeComponent -> "unknown-component"
+ TargetComponentUnknown _ _ ModuleTarget{} -> "unknown-module"
+ TargetComponentUnknown _ _ FileTarget{} -> "unknown-file"
-- ------------------------------------------------------------
@@ -607,7 +636,7 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
go (TargetPackage _ _ (Just filter')) = kfilter == filter'
go (TargetPackageNamed _ (Just filter')) = kfilter == filter'
go (TargetAllPackages (Just filter')) = kfilter == filter'
- go (TargetComponent _ cname)
+ go (TargetComponent _ cname _)
| CLibName _ <- cname = kfilter == LibKind
| CFLibName _ <- cname = kfilter == FLibKind
| CExeName _ <- cname = kfilter == ExeKind
@@ -936,6 +965,8 @@ syntaxForms
]
]
, syntaxForm1Component ocinfo
+ , syntaxForm1Module cinfo
+ , syntaxForm1File pinfo
]
, -- two-component partially qualified forms
-- fully qualified form for 'all'
@@ -945,8 +976,24 @@ syntaxForms
, syntaxForm2PackageComponent pinfo
, syntaxForm2PackageFilter pinfo
, syntaxForm2KindComponent cinfo
+ , shadowingAlternatives
+ [ syntaxForm2PackageModule pinfo
+ , syntaxForm2PackageFile pinfo
+ ]
+ , shadowingAlternatives
+ [ syntaxForm2ComponentModule cinfo
+ , syntaxForm2ComponentFile cinfo
+ ]
, -- rarely used partially qualified forms
syntaxForm3PackageKindComponent pinfo
+ , shadowingAlternatives
+ [ syntaxForm3PackageComponentModule pinfo
+ , syntaxForm3PackageComponentFile pinfo
+ ]
+ , shadowingAlternatives
+ [ syntaxForm3KindComponentModule cinfo
+ , syntaxForm3KindComponentFile cinfo
+ ]
, syntaxForm3NamespacePackageFilter pinfo
, -- fully-qualified forms for all and cwd with filter
syntaxForm3MetaAllFilter
@@ -956,6 +1003,8 @@ syntaxForms
, syntaxForm4MetaNamespacePackageFilter pinfo
, -- fully-qualified forms for component, module and file
syntaxForm5MetaNamespacePackageKindComponent pinfo
+ , syntaxForm7MetaNamespacePackageKindComponentNamespaceModule pinfo
+ , syntaxForm7MetaNamespacePackageKindComponentNamespaceFile pinfo
]
where
ambiguousAlternatives = Prelude.foldr1 AmbiguousAlternatives
@@ -1017,12 +1066,49 @@ syntaxForm1Component cs =
syntaxForm1 render $ \str1 _fstatus1 -> do
guardComponentName str1
c <- matchComponentName cs str1
- return (TargetComponent (cinfoPackageId c) (cinfoName c))
+ return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent)
where
- render (TargetComponent p c) =
+ render (TargetComponent p c WholeComponent) =
[TargetStringFileStatus1 (dispC p c) noFileStatus]
render _ = []
+-- | Syntax: module
+--
+-- > cabal build Data.Foo
+syntaxForm1Module :: [KnownComponent] -> Syntax
+syntaxForm1Module cs =
+ syntaxForm1 render $ \str1 _fstatus1 -> do
+ guardModuleName str1
+ let ms = [(m, c) | c <- cs, m <- cinfoModules c]
+ (m, c) <- matchModuleNameAnd ms str1
+ return (TargetComponent (cinfoPackageId c) (cinfoName c) (ModuleTarget m))
+ where
+ render (TargetComponent _p _c (ModuleTarget m)) =
+ [TargetStringFileStatus1 (dispM m) noFileStatus]
+ render _ = []
+
+-- | Syntax: file name
+--
+-- > cabal build Data/Foo.hs bar/Main.hsc
+syntaxForm1File :: [KnownPackage] -> Syntax
+syntaxForm1File ps =
+ -- Note there's a bit of an inconsistency here vs the other syntax forms
+ -- for files. For the single-part syntax the target has to point to a file
+ -- that exists (due to our use of matchPackageDirectoryPrefix), whereas for
+ -- all the other forms we don't require that.
+ syntaxForm1 render $ \str1 fstatus1 ->
+ expecting "file" str1 $ do
+ (pkgfile, ~KnownPackage{pinfoId, pinfoComponents}) <-
+ -- always returns the KnownPackage case
+ matchPackageDirectoryPrefix ps fstatus1
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ (filepath, c) <- matchComponentFile pinfoComponents pkgfile
+ return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
+ where
+ render (TargetComponent _p _c (FileTarget f)) =
+ [TargetStringFileStatus1 f noFileStatus]
+ render _ = []
+
---
-- | Syntax: :all
@@ -1110,16 +1196,16 @@ syntaxForm2PackageComponent ps =
KnownPackage{pinfoId, pinfoComponents} ->
orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
c <- matchComponentName pinfoComponents str2
- return (TargetComponent pinfoId (cinfoName c))
+ return (TargetComponent pinfoId (cinfoName c) WholeComponent)
-- TODO: the error here ought to say there's no component by that name in
-- this package, and name the package
KnownPackageName pn ->
let cn = mkUnqualComponentName str2
- in return (TargetComponentUnknown pn (Left cn))
+ in return (TargetComponentUnknown pn (Left cn) WholeComponent)
where
- render (TargetComponent p c) =
+ render (TargetComponent p c WholeComponent) =
[TargetStringFileStatus2 (dispP p) noFileStatus (dispC p c)]
- render (TargetComponentUnknown pn (Left cn)) =
+ render (TargetComponentUnknown pn (Left cn) WholeComponent) =
[TargetStringFileStatus2 (dispPN pn) noFileStatus (prettyShow cn)]
render _ = []
@@ -1132,12 +1218,108 @@ syntaxForm2KindComponent cs =
ckind <- matchComponentKind str1
guardComponentName str2
c <- matchComponentKindAndName cs ckind str2
- return (TargetComponent (cinfoPackageId c) (cinfoName c))
+ return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent)
where
- render (TargetComponent p c) =
+ render (TargetComponent p c WholeComponent) =
[TargetStringFileStatus2 (dispCK c) noFileStatus (dispC p c)]
render _ = []
+-- | Syntax: package : module
+--
+-- > cabal build foo:Data.Foo
+-- > cabal build ./foo:Data.Foo
+-- > cabal build ./foo.cabal:Data.Foo
+syntaxForm2PackageModule :: [KnownPackage] -> Syntax
+syntaxForm2PackageModule ps =
+ syntaxForm2 render $ \str1 fstatus1 str2 -> do
+ guardPackage str1 fstatus1
+ guardModuleName str2
+ p <- matchPackage ps str1 fstatus1
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ let ms = [(m, c) | c <- pinfoComponents, m <- cinfoModules c]
+ (m, c) <- matchModuleNameAnd ms str2
+ return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
+ KnownPackageName pn -> do
+ m <- matchModuleNameUnknown str2
+ -- We assume the primary library component of the package:
+ return (TargetComponentUnknown pn (Right $ CLibName LMainLibName) (ModuleTarget m))
+ where
+ render (TargetComponent p _c (ModuleTarget m)) =
+ [TargetStringFileStatus2 (dispP p) noFileStatus (dispM m)]
+ render _ = []
+
+-- | Syntax: component : module
+--
+-- > cabal build foo:Data.Foo
+syntaxForm2ComponentModule :: [KnownComponent] -> Syntax
+syntaxForm2ComponentModule cs =
+ syntaxForm2 render $ \str1 _fstatus1 str2 -> do
+ guardComponentName str1
+ guardModuleName str2
+ c <- matchComponentName cs str1
+ orNoThingIn "component" (cinfoStrName c) $ do
+ let ms = cinfoModules c
+ m <- matchModuleName ms str2
+ return
+ ( TargetComponent
+ (cinfoPackageId c)
+ (cinfoName c)
+ (ModuleTarget m)
+ )
+ where
+ render (TargetComponent p c (ModuleTarget m)) =
+ [TargetStringFileStatus2 (dispC p c) noFileStatus (dispM m)]
+ render _ = []
+
+-- | Syntax: package : filename
+--
+-- > cabal build foo:Data/Foo.hs
+-- > cabal build ./foo:Data/Foo.hs
+-- > cabal build ./foo.cabal:Data/Foo.hs
+syntaxForm2PackageFile :: [KnownPackage] -> Syntax
+syntaxForm2PackageFile ps =
+ syntaxForm2 render $ \str1 fstatus1 str2 -> do
+ guardPackage str1 fstatus1
+ p <- matchPackage ps str1 fstatus1
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ (filepath, c) <- matchComponentFile pinfoComponents str2
+ return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
+ KnownPackageName pn ->
+ let filepath = str2
+ in -- We assume the primary library component of the package:
+ return (TargetComponentUnknown pn (Right $ CLibName LMainLibName) (FileTarget filepath))
+ where
+ render (TargetComponent p _c (FileTarget f)) =
+ [TargetStringFileStatus2 (dispP p) noFileStatus f]
+ render _ = []
+
+-- | Syntax: component : filename
+--
+-- > cabal build foo:Data/Foo.hs
+syntaxForm2ComponentFile :: [KnownComponent] -> Syntax
+syntaxForm2ComponentFile cs =
+ syntaxForm2 render $ \str1 _fstatus1 str2 -> do
+ guardComponentName str1
+ c <- matchComponentName cs str1
+ orNoThingIn "component" (cinfoStrName c) $ do
+ (filepath, _) <- matchComponentFile [c] str2
+ return
+ ( TargetComponent
+ (cinfoPackageId c)
+ (cinfoName c)
+ (FileTarget filepath)
+ )
+ where
+ render (TargetComponent p c (FileTarget f)) =
+ [TargetStringFileStatus2 (dispC p c) noFileStatus f]
+ render _ = []
+
+---
+
-- | Syntax: :all : filter
--
-- > cabal build :all:tests
@@ -1204,17 +1386,123 @@ syntaxForm3PackageKindComponent ps =
KnownPackage{pinfoId, pinfoComponents} ->
orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
c <- matchComponentKindAndName pinfoComponents ckind str3
- return (TargetComponent pinfoId (cinfoName c))
+ return (TargetComponent pinfoId (cinfoName c) WholeComponent)
KnownPackageName pn ->
let cn = mkComponentName pn ckind (mkUnqualComponentName str3)
- in return (TargetComponentUnknown pn (Right cn))
+ in return (TargetComponentUnknown pn (Right cn) WholeComponent)
where
- render (TargetComponent p c) =
+ render (TargetComponent p c WholeComponent) =
[TargetStringFileStatus3 (dispP p) noFileStatus (dispCK c) (dispC p c)]
- render (TargetComponentUnknown pn (Right c)) =
+ render (TargetComponentUnknown pn (Right c) WholeComponent) =
[TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCK c) (dispC' pn c)]
render _ = []
+-- | Syntax: package : component : module
+--
+-- > cabal build foo:foo:Data.Foo
+-- > cabal build foo/:foo:Data.Foo
+-- > cabal build foo.cabal:foo:Data.Foo
+syntaxForm3PackageComponentModule :: [KnownPackage] -> Syntax
+syntaxForm3PackageComponentModule ps =
+ syntaxForm3 render $ \str1 fstatus1 str2 str3 -> do
+ guardPackage str1 fstatus1
+ guardComponentName str2
+ guardModuleName str3
+ p <- matchPackage ps str1 fstatus1
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ c <- matchComponentName pinfoComponents str2
+ orNoThingIn "component" (cinfoStrName c) $ do
+ let ms = cinfoModules c
+ m <- matchModuleName ms str3
+ return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
+ KnownPackageName pn -> do
+ let cn = mkUnqualComponentName str2
+ m <- matchModuleNameUnknown str3
+ return (TargetComponentUnknown pn (Left cn) (ModuleTarget m))
+ where
+ render (TargetComponent p c (ModuleTarget m)) =
+ [TargetStringFileStatus3 (dispP p) noFileStatus (dispC p c) (dispM m)]
+ render (TargetComponentUnknown pn (Left c) (ModuleTarget m)) =
+ [TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCN c) (dispM m)]
+ render _ = []
+
+-- | Syntax: namespace : component : module
+--
+-- > cabal build lib:foo:Data.Foo
+syntaxForm3KindComponentModule :: [KnownComponent] -> Syntax
+syntaxForm3KindComponentModule cs =
+ syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
+ ckind <- matchComponentKind str1
+ guardComponentName str2
+ guardModuleName str3
+ c <- matchComponentKindAndName cs ckind str2
+ orNoThingIn "component" (cinfoStrName c) $ do
+ let ms = cinfoModules c
+ m <- matchModuleName ms str3
+ return
+ ( TargetComponent
+ (cinfoPackageId c)
+ (cinfoName c)
+ (ModuleTarget m)
+ )
+ where
+ render (TargetComponent p c (ModuleTarget m)) =
+ [TargetStringFileStatus3 (dispCK c) noFileStatus (dispC p c) (dispM m)]
+ render _ = []
+
+-- | Syntax: package : component : filename
+--
+-- > cabal build foo:foo:Data/Foo.hs
+-- > cabal build foo/:foo:Data/Foo.hs
+-- > cabal build foo.cabal:foo:Data/Foo.hs
+syntaxForm3PackageComponentFile :: [KnownPackage] -> Syntax
+syntaxForm3PackageComponentFile ps =
+ syntaxForm3 render $ \str1 fstatus1 str2 str3 -> do
+ guardPackage str1 fstatus1
+ guardComponentName str2
+ p <- matchPackage ps str1 fstatus1
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ c <- matchComponentName pinfoComponents str2
+ orNoThingIn "component" (cinfoStrName c) $ do
+ (filepath, _) <- matchComponentFile [c] str3
+ return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
+ KnownPackageName pn ->
+ let cn = mkUnqualComponentName str2
+ filepath = str3
+ in return (TargetComponentUnknown pn (Left cn) (FileTarget filepath))
+ where
+ render (TargetComponent p c (FileTarget f)) =
+ [TargetStringFileStatus3 (dispP p) noFileStatus (dispC p c) f]
+ render (TargetComponentUnknown pn (Left c) (FileTarget f)) =
+ [TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCN c) f]
+ render _ = []
+
+-- | Syntax: namespace : component : filename
+--
+-- > cabal build lib:foo:Data/Foo.hs
+syntaxForm3KindComponentFile :: [KnownComponent] -> Syntax
+syntaxForm3KindComponentFile cs =
+ syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
+ ckind <- matchComponentKind str1
+ guardComponentName str2
+ c <- matchComponentKindAndName cs ckind str2
+ orNoThingIn "component" (cinfoStrName c) $ do
+ (filepath, _) <- matchComponentFile [c] str3
+ return
+ ( TargetComponent
+ (cinfoPackageId c)
+ (cinfoName c)
+ (FileTarget filepath)
+ )
+ where
+ render (TargetComponent p c (FileTarget f)) =
+ [TargetStringFileStatus3 (dispCK c) noFileStatus (dispC p c) f]
+ render _ = []
+
syntaxForm3NamespacePackageFilter :: [KnownPackage] -> Syntax
syntaxForm3NamespacePackageFilter ps =
syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
@@ -1272,17 +1560,114 @@ syntaxForm5MetaNamespacePackageKindComponent ps =
KnownPackage{pinfoId, pinfoComponents} ->
orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
c <- matchComponentKindAndName pinfoComponents ckind str5
- return (TargetComponent pinfoId (cinfoName c))
+ return (TargetComponent pinfoId (cinfoName c) WholeComponent)
KnownPackageName pn ->
let cn = mkComponentName pn ckind (mkUnqualComponentName str5)
- in return (TargetComponentUnknown pn (Right cn))
+ in return (TargetComponentUnknown pn (Right cn) WholeComponent)
where
- render (TargetComponent p c) =
+ render (TargetComponent p c WholeComponent) =
[TargetStringFileStatus5 "" "pkg" (dispP p) (dispCK c) (dispC p c)]
- render (TargetComponentUnknown pn (Right c)) =
+ render (TargetComponentUnknown pn (Right c) WholeComponent) =
[TargetStringFileStatus5 "" "pkg" (dispPN pn) (dispCK c) (dispC' pn c)]
render _ = []
+-- | Syntax: :pkg : package : namespace : component : module : module
+--
+-- > cabal build :pkg:foo:lib:foo:module:Data.Foo
+syntaxForm7MetaNamespacePackageKindComponentNamespaceModule
+ :: [KnownPackage] -> Syntax
+syntaxForm7MetaNamespacePackageKindComponentNamespaceModule ps =
+ syntaxForm7 render $ \str1 str2 str3 str4 str5 str6 str7 -> do
+ guardNamespaceMeta str1
+ guardNamespacePackage str2
+ guardPackageName str3
+ ckind <- matchComponentKind str4
+ guardComponentName str5
+ guardNamespaceModule str6
+ p <- matchPackage ps str3 noFileStatus
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ c <- matchComponentKindAndName pinfoComponents ckind str5
+ orNoThingIn "component" (cinfoStrName c) $ do
+ let ms = cinfoModules c
+ m <- matchModuleName ms str7
+ return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
+ KnownPackageName pn -> do
+ let cn = mkComponentName pn ckind (mkUnqualComponentName str2)
+ m <- matchModuleNameUnknown str7
+ return (TargetComponentUnknown pn (Right cn) (ModuleTarget m))
+ where
+ render (TargetComponent p c (ModuleTarget m)) =
+ [ TargetStringFileStatus7
+ ""
+ "pkg"
+ (dispP p)
+ (dispCK c)
+ (dispC p c)
+ "module"
+ (dispM m)
+ ]
+ render (TargetComponentUnknown pn (Right c) (ModuleTarget m)) =
+ [ TargetStringFileStatus7
+ ""
+ "pkg"
+ (dispPN pn)
+ (dispCK c)
+ (dispC' pn c)
+ "module"
+ (dispM m)
+ ]
+ render _ = []
+
+-- | Syntax: :pkg : package : namespace : component : file : filename
+--
+-- > cabal build :pkg:foo:lib:foo:file:Data/Foo.hs
+syntaxForm7MetaNamespacePackageKindComponentNamespaceFile
+ :: [KnownPackage] -> Syntax
+syntaxForm7MetaNamespacePackageKindComponentNamespaceFile ps =
+ syntaxForm7 render $ \str1 str2 str3 str4 str5 str6 str7 -> do
+ guardNamespaceMeta str1
+ guardNamespacePackage str2
+ guardPackageName str3
+ ckind <- matchComponentKind str4
+ guardComponentName str5
+ guardNamespaceFile str6
+ p <- matchPackage ps str3 noFileStatus
+ case p of
+ KnownPackage{pinfoId, pinfoComponents} ->
+ orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do
+ c <- matchComponentKindAndName pinfoComponents ckind str5
+ orNoThingIn "component" (cinfoStrName c) $ do
+ (filepath, _) <- matchComponentFile [c] str7
+ return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
+ KnownPackageName pn ->
+ let cn = mkComponentName pn ckind (mkUnqualComponentName str5)
+ filepath = str7
+ in return (TargetComponentUnknown pn (Right cn) (FileTarget filepath))
+ where
+ render (TargetComponent p c (FileTarget f)) =
+ [ TargetStringFileStatus7
+ ""
+ "pkg"
+ (dispP p)
+ (dispCK c)
+ (dispC p c)
+ "file"
+ f
+ ]
+ render (TargetComponentUnknown pn (Right c) (FileTarget f)) =
+ [ TargetStringFileStatus7
+ ""
+ "pkg"
+ (dispPN pn)
+ (dispCK c)
+ (dispC' pn c)
+ "file"
+ f
+ ]
+ render _ = []
+
---------------------------------------
-- Syntax utils
--
@@ -1312,29 +1697,40 @@ type Match5 =
-> String
-> String
-> Match TargetSelector
+type Match7 =
+ String
+ -> String
+ -> String
+ -> String
+ -> String
+ -> String
+ -> String
+ -> Match TargetSelector
syntaxForm1 :: Renderer -> Match1 -> Syntax
+syntaxForm2 :: Renderer -> Match2 -> Syntax
+syntaxForm3 :: Renderer -> Match3 -> Syntax
+syntaxForm4 :: Renderer -> Match4 -> Syntax
+syntaxForm5 :: Renderer -> Match5 -> Syntax
+syntaxForm7 :: Renderer -> Match7 -> Syntax
syntaxForm1 render f =
Syntax QL1 match render
where
match = \(TargetStringFileStatus1 str1 fstatus1) ->
f str1 fstatus1
-syntaxForm2 :: Renderer -> Match2 -> Syntax
syntaxForm2 render f =
Syntax QL2 match render
where
match = \(TargetStringFileStatus2 str1 fstatus1 str2) ->
f str1 fstatus1 str2
-syntaxForm3 :: Renderer -> Match3 -> Syntax
syntaxForm3 render f =
Syntax QL3 match render
where
match = \(TargetStringFileStatus3 str1 fstatus1 str2 str3) ->
f str1 fstatus1 str2 str3
-syntaxForm4 :: Renderer -> Match4 -> Syntax
syntaxForm4 render f =
Syntax QLFull match render
where
@@ -1342,7 +1738,6 @@ syntaxForm4 render f =
f str1 str2 str3 str4
match _ = mzero
-syntaxForm5 :: Renderer -> Match5 -> Syntax
syntaxForm5 render f =
Syntax QLFull match render
where
@@ -1350,6 +1745,13 @@ syntaxForm5 render f =
f str1 str2 str3 str4 str5
match _ = mzero
+syntaxForm7 render f =
+ Syntax QLFull match render
+ where
+ match (TargetStringFileStatus7 str1 str2 str3 str4 str5 str6 str7) =
+ f str1 str2 str3 str4 str5 str6 str7
+ match _ = mzero
+
dispP :: Package p => p -> String
dispP = prettyShow . packageName
@@ -1362,6 +1764,9 @@ dispC = componentStringName . packageName
dispC' :: PackageName -> ComponentName -> String
dispC' = componentStringName
+dispCN :: UnqualComponentName -> String
+dispCN = prettyShow
+
dispK :: ComponentKind -> String
dispK = showComponentKindShort
@@ -1371,6 +1776,9 @@ dispCK = dispK . componentKind
dispF :: ComponentKind -> String
dispF = showComponentKindFilterShort
+dispM :: ModuleName -> String
+dispM = prettyShow
+
-------------------------------
-- Package and component info
--
@@ -1561,6 +1969,12 @@ guardNamespacePackage = guardToken ["pkg", "package"] "'pkg' namespace"
guardNamespaceCwd :: String -> Match ()
guardNamespaceCwd = guardToken ["cwd"] "'cwd' namespace"
+guardNamespaceModule :: String -> Match ()
+guardNamespaceModule = guardToken ["mod", "module"] "'module' namespace"
+
+guardNamespaceFile :: String -> Match ()
+guardNamespaceFile = guardToken ["file"] "'file' namespace"
+
guardToken :: [String] -> String -> String -> Match ()
guardToken tokens msg s
| caseFold s `elem` tokens = increaseConfidence
@@ -1772,7 +2186,97 @@ matchComponentKindAndName cs ckind str =
render c = showComponentKindShort (cinfoKind c) ++ ":" ++ cinfoStrName c
------------------------------
--- Utils
+-- Matching module targets
+--
+
+guardModuleName :: String -> Match ()
+guardModuleName s =
+ case simpleParsec s :: Maybe ModuleName of
+ Just _ -> increaseConfidence
+ _
+ | all validModuleChar s
+ && not (null s) ->
+ return ()
+ | otherwise -> matchErrorExpected "module name" s
+ where
+ validModuleChar c = isAlphaNum c || c == '.' || c == '_' || c == '\''
+
+matchModuleName :: [ModuleName] -> String -> Match ModuleName
+matchModuleName ms str =
+ orNoSuchThing "module" str (map prettyShow ms) $
+ increaseConfidenceFor $
+ matchInexactly caseFold prettyShow ms str
+
+matchModuleNameAnd :: [(ModuleName, a)] -> String -> Match (ModuleName, a)
+matchModuleNameAnd ms str =
+ orNoSuchThing "module" str (map (prettyShow . fst) ms) $
+ increaseConfidenceFor $
+ matchInexactly caseFold (prettyShow . fst) ms str
+
+matchModuleNameUnknown :: String -> Match ModuleName
+matchModuleNameUnknown str =
+ expecting "module" str $
+ increaseConfidenceFor $
+ matchParse str
+
+------------------------------
+-- Matching file targets
+--
+
+matchPackageDirectoryPrefix
+ :: [KnownPackage]
+ -> FileStatus
+ -> Match (FilePath, KnownPackage)
+matchPackageDirectoryPrefix ps (FileStatusExistsFile filepath) =
+ increaseConfidenceFor $
+ matchDirectoryPrefix pkgdirs filepath
+ where
+ pkgdirs =
+ [ (dir, p)
+ | p@KnownPackage{pinfoDirectory = Just (dir, _)} <- ps
+ ]
+matchPackageDirectoryPrefix _ _ = mzero
+
+matchComponentFile
+ :: [KnownComponent]
+ -> String
+ -> Match (FilePath, KnownComponent)
+matchComponentFile cs str =
+ orNoSuchThing "file" str [] $
+ matchComponentModuleFile cs str
+ <|> matchComponentOtherFile cs str
+
+matchComponentOtherFile
+ :: [KnownComponent]
+ -> String
+ -> Match (FilePath, KnownComponent)
+matchComponentOtherFile cs =
+ matchFile
+ [ (normalise (srcdir </> file), c)
+ | c <- cs
+ , srcdir <- cinfoSrcDirs c
+ , file <-
+ cinfoHsFiles c
+ ++ cinfoCFiles c
+ ++ cinfoJsFiles c
+ ]
+ . normalise
+
+matchComponentModuleFile
+ :: [KnownComponent]
+ -> String
+ -> Match (FilePath, KnownComponent)
+matchComponentModuleFile cs str = do
+ matchFile
+ [ (normalise (d </> toFilePath m), c)
+ | c <- cs
+ , d <- cinfoSrcDirs c
+ , m <- cinfoModules c
+ ]
+ (dropExtension (normalise str)) -- Drop the extension because FileTarget
+ -- is stored without the extension
+
+-- utils
-- | Compare two filepaths for equality using DirActions' canonicalizePath
-- to normalize AND canonicalize filepaths before comparison.
@@ -1789,6 +2293,25 @@ compareFilePath DirActions{..} fp1 fp2
c2 <- canonicalizePath fp2
pure $ equalFilePath c1 c2
+matchFile :: [(FilePath, a)] -> FilePath -> Match (FilePath, a)
+matchFile fs =
+ increaseConfidenceFor
+ . matchInexactly caseFold fst fs
+
+matchDirectoryPrefix :: [(FilePath, a)] -> FilePath -> Match (FilePath, a)
+matchDirectoryPrefix dirs filepath =
+ tryEach $
+ [ (file, x)
+ | (dir, x) <- dirs
+ , file <- maybeToList (stripDirectory dir)
+ ]
+ where
+ stripDirectory :: FilePath -> Maybe FilePath
+ stripDirectory dir =
+ joinPath `fmap` stripPrefix (splitDirectories dir) filepathsplit
+
+ filepathsplit = splitDirectories filepath
+
------------------------------
-- Matching monad
--
@@ -1900,6 +2423,10 @@ matchErrorExpected thing got = NoMatch 0 [MatchErrorExpected thing got]
matchErrorNoSuch :: String -> String -> [String] -> Match a
matchErrorNoSuch thing got alts = NoMatch 0 [MatchErrorNoSuch thing got alts]
+expecting :: String -> String -> Match a -> Match a
+expecting thing got (NoMatch 0 _) = matchErrorExpected thing got
+expecting _ _ m = m
+
orNoSuchThing :: String -> String -> [String] -> Match a -> Match a
orNoSuchThing thing got alts (NoMatch 0 _) = matchErrorNoSuch thing got alts
orNoSuchThing _ _ _ m = m
@@ -1929,6 +2456,9 @@ inexactMatches xs = Match Inexact 0 xs
unknownMatch :: a -> Match a
unknownMatch x = Match Unknown 0 [x]
+tryEach :: [a] -> Match a
+tryEach = exactMatches
+
------------------------------
-- Top level match runner
--
@@ -2059,7 +2589,7 @@ ex1pinfo =
-}
{-
stargets =
- [ TargetComponent (CExeName "foo")
+ [ TargetComponent (CExeName "foo") WholeComponent
, TargetComponent (CExeName "foo") (ModuleTarget (mkMn "Foo"))
, TargetComponent (CExeName "tst") (ModuleTarget (mkMn "Foo"))
]
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index ef40f64a8a643727bd15a85d93407f317fdadd8b..55ea3747b9f0fbc4e37ac947821eea041079081d 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -57,7 +57,9 @@ import Distribution.Simple.Command
import qualified Distribution.Simple.Flag as Flag
import Distribution.System
import Distribution.Version
+import Distribution.ModuleName (ModuleName)
import Distribution.Text
+import Distribution.Utils.Path
import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
import Distribution.Client.Setup (globalStoreDir)
import Distribution.Client.GlobalFlags (defaultGlobalFlags)
@@ -232,8 +234,40 @@ testTargetSelectors reportSubCase = do
do Right ts <- readTargetSelectors'
[ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p"
, "lib:q", "q:lib:q", ":pkg:q:lib:q" ]
- ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName))
- ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName))
+ ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent)
+ ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent)
+
+ reportSubCase "module"
+ do Right ts <- readTargetSelectors'
+ [ "P", "lib:p:P", "p:p:P", ":pkg:p:lib:p:module:P"
+ , "QQ", "lib:q:QQ", "q:q:QQ", ":pkg:q:lib:q:module:QQ"
+ , "pexe:PMain" -- p:P or q:QQ would be ambiguous here
+ , "qexe:QMain" -- package p vs component p
+ ]
+ ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P"))
+ ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ"))
+ ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain")
+ , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain")
+ ]
+
+ reportSubCase "file"
+ do Right ts <- readTargetSelectors'
+ [ "./P.hs", "p:P.lhs", "lib:p:P.hsc", "p:p:P.hsc",
+ ":pkg:p:lib:p:file:P.y"
+ , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc",
+ ":pkg:q:lib:q:file:QQ.y"
+ , "q/Q.hs", "q:Q.lhs", "lib:q:Q.hsc", "q:q:Q.hsc",
+ ":pkg:q:lib:q:file:Q.y"
+ , "app/Main.hs", "p:app/Main.hs", "exe:ppexe:app/Main.hs", "p:ppexe:app/Main.hs",
+ ":pkg:p:exe:ppexe:file:app/Main.hs"
+ ]
+ ts @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P"))
+ ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ"))
+ ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "Q"))
+ ++ replicate 5 (TargetComponent "p-0.1" (CExeName "ppexe") (FileTarget ("app" </> "Main.hs")))
+ -- Note there's a bit of an inconsistency here: for the single-part
+ -- syntax the target has to point to a file that exists, whereas for
+ -- all the other forms we don't require that.
cleanProject testdir
where
@@ -336,6 +370,24 @@ testTargetSelectorAmbiguous reportSubCase = do
, mkexe "other2" `withCFiles` ["Foo"] ]
]
+ -- File target is ambiguous, part of multiple components
+ reportSubCase "ambiguous: file in multiple comps"
+ assertAmbiguous "Bar.hs"
+ [ mkTargetFile "foo" (CExeName "bar") "Bar"
+ , mkTargetFile "foo" (CExeName "bar2") "Bar"
+ ]
+ [ mkpkg "foo" [ mkexe "bar" `withModules` ["Bar"]
+ , mkexe "bar2" `withModules` ["Bar"] ]
+ ]
+ reportSubCase "ambiguous: file in multiple comps with path"
+ assertAmbiguous ("src" </> "Bar.hs")
+ [ mkTargetFile "foo" (CExeName "bar") ("src" </> "Bar")
+ , mkTargetFile "foo" (CExeName "bar2") ("src" </> "Bar")
+ ]
+ [ mkpkg "foo" [ mkexe "bar" `withModules` ["Bar"] `withHsSrcDirs` ["src"]
+ , mkexe "bar2" `withModules` ["Bar"] `withHsSrcDirs` ["src"] ]
+ ]
+
-- non-exact case packages and components are ambiguous
reportSubCase "ambiguous: non-exact-case pkg names"
assertAmbiguous "Foo"
@@ -347,6 +399,19 @@ testTargetSelectorAmbiguous reportSubCase = do
, mkTargetComponent "bar" (CExeName "FOO") ]
[ mkpkg "bar" [mkexe "foo", mkexe "FOO"] ]
+ -- exact-case Module or File over non-exact case package or component
+ reportSubCase "unambiguous: module vs non-exact-case pkg, comp"
+ assertUnambiguous "Baz"
+ (mkTargetModule "other" (CExeName "other") "Baz")
+ [ mkpkg "baz" [mkexe "BAZ"]
+ , mkpkg "other" [ mkexe "other" `withModules` ["Baz"] ]
+ ]
+ reportSubCase "unambiguous: file vs non-exact-case pkg, comp"
+ assertUnambiguous "Baz"
+ (mkTargetFile "other" (CExeName "other") "Baz")
+ [ mkpkg "baz" [mkexe "BAZ"]
+ , mkpkg "other" [ mkexe "other" `withCFiles` ["Baz"] ]
+ ]
where
assertAmbiguous :: String
-> [TargetSelector]
@@ -423,13 +488,26 @@ testTargetSelectorAmbiguous reportSubCase = do
withCFiles exe files =
exe { buildInfo = (buildInfo exe) { cSources = files } }
+ withHsSrcDirs :: Executable -> [FilePath] -> Executable
+ withHsSrcDirs exe srcDirs =
+ exe { buildInfo = (buildInfo exe) { hsSourceDirs = map unsafeMakeSymbolicPath srcDirs }}
+
+
mkTargetPackage :: PackageId -> TargetSelector
mkTargetPackage pkgid =
TargetPackage TargetExplicitNamed [pkgid] Nothing
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector
mkTargetComponent pkgid cname =
- TargetComponent pkgid cname
+ TargetComponent pkgid cname WholeComponent
+
+mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector
+mkTargetModule pkgid cname mname =
+ TargetComponent pkgid cname (ModuleTarget mname)
+
+mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector
+mkTargetFile pkgid cname fname =
+ TargetComponent pkgid cname (FileTarget fname)
mkTargetAllPackages :: TargetSelector
mkTargetAllPackages = TargetAllPackages Nothing
@@ -527,23 +605,23 @@ testTargetProblemsCommon config0 = do
-- benchmarks from packages that are not local to the project
, ( \_ -> TargetComponentNotProjectLocal
(pkgIdMap Map.! "filepath") (CTestName "filepath-tests")
-
+ WholeComponent
, mkTargetComponent (pkgIdMap Map.! "filepath")
(CTestName "filepath-tests") )
-- Components can be explicitly @buildable: False@
- , ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false")
+ , ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent
, mkTargetComponent "q-0.1" (CExeName "buildable-false") )
-- Testsuites and benchmarks can be disabled by the solver if it
-- cannot satisfy deps
- , ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled")
+ , ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent
, mkTargetComponent "q-0.1" (CTestName "solver-disabled") )
-- Testsuites and benchmarks can be disabled explicitly by the
-- user via config
, ( \_ -> TargetOptionalStanzaDisabledByUser
- "q-0.1" (CBenchName "user-disabled")
+ "q-0.1" (CBenchName "user-disabled") WholeComponent
, mkTargetComponent "q-0.1" (CBenchName "user-disabled") )
-- An unknown package. The target selector resolution should only
@@ -1007,6 +1085,23 @@ testTargetProblemsTest config reportSubCase = do
, ( const (CmdTest.notTestProblem
"p-0.1" (CBenchName "a-benchmark"))
, mkTargetComponent "p-0.1" (CBenchName "a-benchmark") )
+ ] ++
+ [ ( const (CmdTest.isSubComponentProblem
+ "p-0.1" cname (ModuleTarget modname))
+ , mkTargetModule "p-0.1" cname modname )
+ | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule")
+ , (CBenchName "a-benchmark", "BenchModule")
+ , (CExeName "an-exe", "ExeModule")
+ , ((CLibName LMainLibName), "P")
+ ]
+ ] ++
+ [ ( const (CmdTest.isSubComponentProblem
+ "p-0.1" cname (FileTarget fname))
+ , mkTargetFile "p-0.1" cname fname)
+ | (cname, fname) <- [ (CTestName "a-testsuite", "Test.hs")
+ , (CBenchName "a-benchmark", "Bench.hs")
+ , (CExeName "an-exe", "Main.hs")
+ ]
]
@@ -1092,8 +1187,26 @@ testTargetProblemsBench config reportSubCase = do
, ( const (CmdBench.componentNotBenchmarkProblem
"p-0.1" (CTestName "a-testsuite"))
, mkTargetComponent "p-0.1" (CTestName "a-testsuite") )
+ ] ++
+ [ ( const (CmdBench.isSubComponentProblem
+ "p-0.1" cname (ModuleTarget modname))
+ , mkTargetModule "p-0.1" cname modname )
+ | (cname, modname) <- [ (CTestName "a-testsuite", "TestModule")
+ , (CBenchName "a-benchmark", "BenchModule")
+ , (CExeName "an-exe", "ExeModule")
+ , ((CLibName LMainLibName), "P")
+ ]
+ ] ++
+ [ ( const (CmdBench.isSubComponentProblem
+ "p-0.1" cname (FileTarget fname))
+ , mkTargetFile "p-0.1" cname fname)
+ | (cname, fname) <- [ (CTestName "a-testsuite", "Test.hs")
+ , (CBenchName "a-benchmark", "Bench.hs")
+ , (CExeName "an-exe", "Main.hs")
+ ]
]
+
testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion
testTargetProblemsHaddock config reportSubCase = do
@@ -1185,7 +1298,7 @@ assertProjectDistinctTargets
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])
- -> (forall k. AvailableTarget k -> Either (TargetProblem err) k )
+ -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k )
-> [TargetSelector]
-> [(UnitId, ComponentName)]
-> Assertion
@@ -1215,7 +1328,8 @@ assertProjectTargetProblems
-> (forall k. TargetSelector
-> [AvailableTarget k]
-> Either (TargetProblem err) [k])
- -> (forall k. AvailableTarget k
+ -> (forall k. SubComponentTarget
+ -> AvailableTarget k
-> Either (TargetProblem err) k )
-> [(TargetSelector -> TargetProblem err, TargetSelector)]
-> Assertion
@@ -1235,7 +1349,7 @@ assertTargetProblems
:: forall err. (Eq err, Show err) =>
ElaboratedInstallPlan
-> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])
- -> (forall k. AvailableTarget k -> Either (TargetProblem err) k )
+ -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k )
-> [(TargetSelector -> TargetProblem err, TargetSelector)]
-> Assertion
assertTargetProblems elaboratedPlan selectPackageTargets selectComponentTarget =
@@ -1620,7 +1734,7 @@ executePlan ((distDirLayout, cabalDirLayout, config, _, buildSettings),
let targets :: Map.Map UnitId [ComponentTarget]
targets =
Map.fromList
- [ (unitid, [ComponentTarget cname])
+ [ (unitid, [ComponentTarget cname WholeComponent])
| ts <- Map.elems (availableTargets elaboratedPlan)
, AvailableTarget {
availableTargetStatus = TargetBuildable (unitid, cname) _
diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs
index 82d44bb354eda1c8726d7f1fcf37b77e664f5249..8434f623e82084988e7b8e5d18b5dc9e966dc618 100644
--- a/cabal-install/tests/UnitTests.hs
+++ b/cabal-install/tests/UnitTests.hs
@@ -14,6 +14,7 @@ import qualified UnitTests.Distribution.Client.Init
import qualified UnitTests.Distribution.Client.InstallPlan
import qualified UnitTests.Distribution.Client.JobControl
import qualified UnitTests.Distribution.Client.ProjectConfig
+import qualified UnitTests.Distribution.Client.ProjectPlanning
import qualified UnitTests.Distribution.Client.Store
import qualified UnitTests.Distribution.Client.Tar
import qualified UnitTests.Distribution.Client.Targets
@@ -66,6 +67,9 @@ main = do
, testGroup
"UnitTests.Distribution.Client.ProjectConfig"
UnitTests.Distribution.Client.ProjectConfig.tests
+ , testGroup
+ "UnitTests.Distribution.Client.ProjectPlanning"
+ UnitTests.Distribution.Client.ProjectPlanning.tests
, testGroup
"Distribution.Client.Store"
UnitTests.Distribution.Client.Store.tests
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectPlanning.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectPlanning.hs
new file mode 100644
index 0000000000000000000000000000000000000000..184cfef5bdfaba7261a803442a405f610f99d01a
--- /dev/null
+++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectPlanning.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module UnitTests.Distribution.Client.ProjectPlanning (tests) where
+
+import Data.List.NonEmpty
+import Distribution.Client.ProjectPlanning (ComponentTarget (..), SubComponentTarget (..), nubComponentTargets)
+import Distribution.Types.ComponentName
+import Distribution.Types.LibraryName
+import Test.Tasty
+import Test.Tasty.HUnit
+
+tests :: [TestTree]
+tests =
+ [ testGroup "Build Target Tests" buildTargetTests
+ ]
+
+-- ----------------------------------------------------------------------------
+-- Build Target Tests
+-- ----------------------------------------------------------------------------
+
+buildTargetTests :: [TestTree]
+buildTargetTests =
+ [ testGroup "nubComponentTargets" nubComponentTargetsTests
+ ]
+
+nubComponentTargetsTests :: [TestTree]
+nubComponentTargetsTests =
+ [ testCase "Works on empty list" $
+ nubComponentTargets [] @?= ([] :: [(ComponentTarget, NonEmpty Int)])
+ , testCase "Merges targets to same component" $
+ nubComponentTargets
+ [ (mainLibModuleTarget, 1 :: Int)
+ , (mainLibFileTarget, 2)
+ ]
+ @?= [(mainLibWholeCompTarget, 1 :| [2])]
+ , testCase "Merges whole component targets" $
+ nubComponentTargets [(mainLibFileTarget, 2), (mainLibWholeCompTarget, 1 :: Int)]
+ @?= [(mainLibWholeCompTarget, 2 :| [1])]
+ , testCase "Don't merge unrelated targets" $
+ nubComponentTargets
+ [ (mainLibWholeCompTarget, 1 :: Int)
+ , (exeWholeCompTarget, 2)
+ ]
+ @?= [(mainLibWholeCompTarget, pure 1), (exeWholeCompTarget, pure 2)]
+ , testCase "Merge multiple related targets" $
+ nubComponentTargets
+ [ (mainLibWholeCompTarget, 1 :: Int)
+ , (mainLibModuleTarget, 4)
+ , (exeWholeCompTarget, 2)
+ , (exeFileTarget, 3)
+ ]
+ @?= [(mainLibWholeCompTarget, 1 :| [4]), (exeWholeCompTarget, 2 :| [3])]
+ , testCase "Merge related targets, don't merge unrelated ones" $
+ nubComponentTargets
+ [ (mainLibFileTarget, 1 :: Int)
+ , (mainLibModuleTarget, 4)
+ , (exeWholeCompTarget, 2)
+ , (exeFileTarget, 3)
+ , (exe2FileTarget, 5)
+ ]
+ @?= [ (mainLibWholeCompTarget, 1 :| [4])
+ , (exeWholeCompTarget, 2 :| [3])
+ , (exe2WholeCompTarget, 5 :| [])
+ ]
+ ]
+
+-- ----------------------------------------------------------------------------
+-- Utils
+-- ----------------------------------------------------------------------------
+
+mainLibWholeCompTarget :: ComponentTarget
+mainLibWholeCompTarget = ComponentTarget (CLibName LMainLibName) WholeComponent
+
+mainLibModuleTarget :: ComponentTarget
+mainLibModuleTarget = ComponentTarget (CLibName LMainLibName) (ModuleTarget "Lib")
+
+mainLibFileTarget :: ComponentTarget
+mainLibFileTarget = ComponentTarget (CLibName LMainLibName) (FileTarget "./Lib.hs")
+
+exeWholeCompTarget :: ComponentTarget
+exeWholeCompTarget = ComponentTarget (CExeName "exe") WholeComponent
+
+exeFileTarget :: ComponentTarget
+exeFileTarget = ComponentTarget (CExeName "exe") (FileTarget "./Main.hs")
+
+exe2WholeCompTarget :: ComponentTarget
+exe2WholeCompTarget = ComponentTarget (CExeName "exe2") WholeComponent
+
+exe2FileTarget :: ComponentTarget
+exe2FileTarget = ComponentTarget (CExeName "exe2") (FileTarget "./Main2.hs")
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs
new file mode 100644
index 0000000000000000000000000000000000000000..73566f6f203d62f83ca75e2b89abab90101d87c9
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs
@@ -0,0 +1 @@
+main = putStrLn "Hello World"
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..22a27144592c6d4c925a67d24d929fb9cd9ed881
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal
@@ -0,0 +1,9 @@
+name: RunMainBad
+version: 1.0
+build-type: Simple
+cabal-version: >= 1.10
+
+executable foo
+ main-is: Main.hs
+ build-depends: base
+ default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out
new file mode 100644
index 0000000000000000000000000000000000000000..25b71f37cced79e540a9f7a7e992d45b289ac698
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out
@@ -0,0 +1,4 @@
+# cabal v2-run
+Resolving dependencies...
+Error: [Cabal-7070]
+The run command can only run an executable as a whole, not files or modules within them, but the target 'Main.hs' refers to the file Main.hs in the executable foo.
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project
new file mode 100644
index 0000000000000000000000000000000000000000..e6fdbadb4398bc0e333947b5fb8021778310d943
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project
@@ -0,0 +1 @@
+packages: .
diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs
new file mode 100644
index 0000000000000000000000000000000000000000..88370b0fae4c9f328630121ae775e10e4b817a35
--- /dev/null
+++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs
@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+ void . fails $ cabal' "v2-run" ["./Main.hs"]
diff --git a/changelog.d/pr-8966 b/changelog.d/pr-8966
deleted file mode 100644
index cd3b4cb656a45157ba0dc8043e0e38af930132f6..0000000000000000000000000000000000000000
--- a/changelog.d/pr-8966
+++ /dev/null
@@ -1,20 +0,0 @@
-synopsis: Drop file and module targets
-packages: Cabal cabal-install
-prs: #8966
-
-description: {
-
-- The ability to specify a single file or a single module as a target has been
- removed since no versions of Cabal ever supported this feature; and cabal-install
- would always fallback to targeting (e.g. building) the whole component.
-
- If you were using a target syntax that includes a file or module name, you
- can remove them expecting no change in behaviour. In some cases this will
- cause the target to become ambiguous, and you will have to specify the
- component instead.
-
- Another minor change is that it is now possible to use `cabal run` against a
- source file which is part of a component. The file will be considered like
- any other and will need the metadata block.
-
-}