From 3f4c81fd7936fa6dcdcac833ae42cc4158b1823a Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Mon, 29 Jan 2024 16:24:51 +0800 Subject: [PATCH] Drop sub-component targets (#8966) This change removes support for building sub-component targets in cabal-install, since no versions of Cabal support this feature. The test RunMainBad is also dropped because without the concept of a file target, RunMainBad is the same test as ScriptBad. --- Cabal/src/Distribution/Simple/BuildTarget.hs | 400 ++---------- cabal-install/cabal-install.cabal | 1 - .../src/Distribution/Client/CmdBench.hs | 37 +- .../src/Distribution/Client/CmdBuild.hs | 3 +- .../Distribution/Client/CmdErrorMessages.hs | 31 +- .../src/Distribution/Client/CmdHaddock.hs | 3 +- .../src/Distribution/Client/CmdInstall.hs | 11 +- .../CmdInstall/ClientInstallTargetSelector.hs | 2 +- .../src/Distribution/Client/CmdListBin.hs | 36 +- .../src/Distribution/Client/CmdRepl.hs | 3 +- .../src/Distribution/Client/CmdRun.hs | 36 +- .../src/Distribution/Client/CmdSdist.hs | 4 +- .../src/Distribution/Client/CmdTest.hs | 37 +- .../ProjectBuilding/PackageFileMonitor.hs | 11 +- .../Client/ProjectBuilding/UnpackedPackage.hs | 2 +- .../Client/ProjectOrchestration.hs | 50 +- .../Distribution/Client/ProjectPlanning.hs | 32 +- .../Client/ProjectPlanning/Types.hs | 34 +- .../src/Distribution/Client/TargetProblem.hs | 6 +- .../src/Distribution/Client/TargetSelector.hs | 584 +----------------- cabal-install/tests/IntegrationTests2.hs | 136 +--- cabal-install/tests/UnitTests.hs | 4 - .../Distribution/Client/ProjectPlanning.hs | 90 --- .../NewBuild/CmdRun/RunMainBad/Main.hs | 1 - .../CmdRun/RunMainBad/RunMainBad.cabal | 9 - .../NewBuild/CmdRun/RunMainBad/cabal.out | 4 - .../NewBuild/CmdRun/RunMainBad/cabal.project | 1 - .../NewBuild/CmdRun/RunMainBad/cabal.test.hs | 4 - changelog.d/pr-8966 | 20 + 29 files changed, 183 insertions(+), 1409 deletions(-) delete mode 100644 cabal-install/tests/UnitTests/Distribution/Client/ProjectPlanning.hs delete mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs delete mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal delete mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out delete mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project delete mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs create mode 100644 changelog.d/pr-8966 diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs index 06b387c04ae..caaeb42eefe 100644 --- a/Cabal/src/Distribution/Simple/BuildTarget.hs +++ b/Cabal/src/Distribution/Simple/BuildTarget.hs @@ -25,7 +25,6 @@ module Distribution.Simple.BuildTarget , BuildTarget (..) , showBuildTarget , QualLevel (..) - , buildTargetComponentName -- * Parsing user build targets , UserBuildTarget @@ -62,19 +61,9 @@ import Distribution.Utils.Path import Distribution.Verbosity import Control.Arrow ((&&&)) -import Control.Monad (msum) -import Data.List (groupBy, stripPrefix) +import Data.List (groupBy) 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. @@ -91,27 +80,15 @@ readTargetInfos verbosity pkg_descr lbi args = do -- | Various ways that a user may specify a build target. data UserBuildTarget - = -- | A target specified by a single name. This could be a component - -- module or file. + = -- | A target specified by a component name. -- -- > cabal build foo - -- > cabal build Data.Foo - -- > cabal build Data/Foo.hs Data/Foo.hsc UserBuildTargetSingle String - | -- | 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. + | -- | A target specified by a component kind and a component name. -- - -- > cabal build lib:foo exe:foo - -- > cabal build foo:Data.Foo - -- > cabal build foo:Data/Foo.hs + -- > cabal build lib:foo + -- > cabal build test:foo-test 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) -- ------------------------------------------------------------ @@ -124,19 +101,10 @@ 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 @@ -146,29 +114,11 @@ readBuildTargets verbosity pkg targetStrs = do let (uproblems, utargets) = readUserBuildTargets targetStrs reportUserBuildTargetProblems verbosity uproblems - utargets' <- traverse checkTargetExistsAsFile utargets - - let (bproblems, btargets) = resolveBuildTargets pkg 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 @@ -190,8 +140,8 @@ readUserBuildTargets = partitionEithers . map readUserBuildTarget -- >>> readUserBuildTarget "lib:comp" -- Right (UserBuildTargetDouble "lib" "comp") -- --- >>> readUserBuildTarget "pkg:lib:comp" --- Right (UserBuildTargetTriple "pkg" "lib" "comp") +-- >>> readUserBuildTarget "else:comp" +-- Right (UserBuildTargetDouble "else" "comp") -- -- >>> readUserBuildTarget "\"comp\"" -- Right (UserBuildTargetSingle "comp") @@ -199,14 +149,8 @@ readUserBuildTargets = partitionEithers . map readUserBuildTarget -- >>> readUserBuildTarget "lib:\"comp\"" -- Right (UserBuildTargetDouble "lib" "comp") -- --- >>> 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 "one:two:three" +-- Left (UserBuildTargetUnrecognised "one:two:three") readUserBuildTarget :: String -> Either @@ -223,18 +167,15 @@ readUserBuildTarget targetstr = ts <- tokens return $ case ts of (a, Nothing) -> UserBuildTargetSingle a - (a, Just (b, Nothing)) -> UserBuildTargetDouble a b - (a, Just (b, Just c)) -> UserBuildTargetTriple a b c + (a, Just b) -> UserBuildTargetDouble a b - tokens :: CabalParsing m => m (String, Maybe (String, Maybe String)) + tokens :: CabalParsing m => m (String, Maybe String) tokens = - (\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)) + (\s -> (s, Nothing)) + <$> parsecHaskellString + <|> (,) + <$> token + <*> P.optional (P.char ':' *> (parsecHaskellString <|> token)) token :: CabalParsing m => m String token = P.munch1 (\x -> not (isSpace x) && x /= ':') @@ -256,22 +197,12 @@ 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 = - showBuildTarget' (qlBuildTarget t) pkgid t - where - qlBuildTarget BuildTargetComponent{} = QL2 - qlBuildTarget _ = QL3 + showUserBuildTarget (renderBuildTarget QL2 t pkgid) -- ------------------------------------------------------------ @@ -297,19 +228,18 @@ Just ex_pkgid = simpleParse "thelib" -- refer to. resolveBuildTargets :: PackageDescription - -> [(UserBuildTarget, Bool)] + -> [UserBuildTarget] -> ([BuildTargetProblem], [BuildTarget]) resolveBuildTargets pkg = partitionEithers - . map (uncurry (resolveBuildTarget pkg)) + . map (resolveBuildTarget pkg) resolveBuildTarget :: PackageDescription -> UserBuildTarget - -> Bool -> Either BuildTargetProblem BuildTarget -resolveBuildTarget pkg userTarget fexists = - case findMatch (matchBuildTarget pkg userTarget fexists) of +resolveBuildTarget pkg userTarget = + case findMatch (matchBuildTarget pkg userTarget) of Unambiguous target -> Right target Ambiguous targets -> Left (BuildTargetAmbiguous userTarget targets') where @@ -355,7 +285,6 @@ disambiguateBuildTargets pkgid original = userTargetQualLevel (UserBuildTargetSingle _) = QL1 userTargetQualLevel (UserBuildTargetDouble _ _) = QL2 - userTargetQualLevel (UserBuildTargetTriple _ _ _) = QL3 step :: QualLevel @@ -368,7 +297,7 @@ disambiguateBuildTargets pkgid original = . sortBy (comparing fst) . map (\t -> (renderBuildTarget ql t pkgid, t)) -data QualLevel = QL1 | QL2 | QL3 +data QualLevel = QL1 | QL2 deriving (Enum, Show) renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget @@ -376,19 +305,10 @@ 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 @@ -423,8 +343,6 @@ reportBuildTargetProblems verbosity problems = do targets where showBuildTargetKind (BuildTargetComponent _) = "component" - showBuildTargetKind (BuildTargetModule _ _) = "module" - showBuildTargetKind (BuildTargetFile _ _) = "file" ---------------------------------- -- Top level BuildTarget matcher @@ -433,47 +351,16 @@ reportBuildTargetProblems verbosity problems = do matchBuildTarget :: PackageDescription -> UserBuildTarget - -> Bool -> Match BuildTarget -matchBuildTarget pkg = \utarget fexists -> +matchBuildTarget pkg utarget = case utarget of UserBuildTargetSingle str1 -> - matchBuildTarget1 cinfo str1 fexists + matchComponent1 cinfo str1 UserBuildTargetDouble str1 str2 -> - matchBuildTarget2 cinfo str1 str2 fexists - UserBuildTargetTriple str1 str2 str3 -> - matchBuildTarget3 cinfo str1 str2 str3 fexists + matchComponent2 cinfo str1 str2 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 @@ -628,11 +515,7 @@ guardComponentName s | otherwise = matchErrorExpected "component name" s where validComponentChar c = - isAlphaNum c - || c == '.' - || c == '_' - || c == '-' - || c == '\'' + isAlphaNum c || c `elem` "._-'" matchComponentName :: [ComponentInfo] -> String -> Match ComponentInfo matchComponentName cs str = @@ -656,180 +539,6 @@ 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 -- @@ -883,13 +592,6 @@ 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) @@ -907,8 +609,9 @@ 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 @@ -927,10 +630,6 @@ 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 @@ -941,26 +640,15 @@ 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, inexactMatches :: [a] -> Match a +exactMatches :: [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 -- @@ -1051,10 +739,9 @@ checkBuildTargets let (enabled, disabled) = partitionEithers [ case componentDisabledReason enabledComps comp of - Nothing -> Left target' + Nothing -> Left cname Just reason -> Right (cname, reason) - | target <- targets - , let target'@(cname, _) = swizzleTarget target + | (BuildTargetComponent cname) <- targets , let comp = getComponent pkg_descr cname ] @@ -1062,28 +749,13 @@ 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 - enabled' <- for enabled $ \(cname, _) -> do + 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 f842d4d3157..f36c1162b13 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -310,7 +310,6 @@ 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 b39aa9d6755..db8b50f4b55 100644 --- a/cabal-install/src/Distribution/Client/CmdBench.hs +++ b/cabal-install/src/Distribution/Client/CmdBench.hs @@ -8,7 +8,6 @@ module Distribution.Client.CmdBench -- * Internals exposed for testing , componentNotBenchmarkProblem - , isSubComponentProblem , noBenchmarksProblem , selectPackageTargets , selectComponentTarget @@ -197,25 +196,17 @@ 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 - :: SubComponentTarget - -> AvailableTarget k + :: AvailableTarget k -> Either BenchTargetProblem k -selectComponentTarget subtarget@WholeComponent t +selectComponentTarget t | CBenchName _ <- availableTargetComponentName t = - selectComponentTargetBasic subtarget t + selectComponentTargetBasic 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. @@ -224,8 +215,6 @@ 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 @@ -238,15 +227,6 @@ 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 @@ -283,13 +263,4 @@ renderBenchProblem (TargetProblemComponentNotBenchmark pkgid cname) = ++ prettyShow pkgid ++ "." where - 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 + targetSelector = TargetComponent pkgid cname diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index be4b26b0038..575e0d95d0b 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -226,8 +226,7 @@ selectPackageTargets targetSelector targets -- -- For the @build@ command we just need the basic checks on being buildable etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: 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 8345d9ed59a..0a4b326c9f0 100644 --- a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs @@ -24,7 +24,6 @@ import Distribution.Client.TargetProblem import Distribution.Client.TargetSelector ( ComponentKind (..) , ComponentKindFilter - , SubComponentTarget (..) , TargetSelector (..) , componentKind , showTargetSelector @@ -142,28 +141,18 @@ renderTargetSelector (TargetAllPackages (Just kfilter)) = "all the " ++ renderComponentKind Plural kfilter ++ " in the project" -renderTargetSelector (TargetComponent pkgid cname subtarget) = - renderSubComponentTarget subtarget - ++ "the " +renderTargetSelector (TargetComponent pkgid cname) = + "the " ++ renderComponentName (packageName pkgid) cname -renderTargetSelector (TargetComponentUnknown pkgname (Left ucname) subtarget) = - renderSubComponentTarget subtarget - ++ "the component " +renderTargetSelector (TargetComponentUnknown pkgname (Left ucname)) = + "the component " ++ prettyShow ucname ++ " in the package " ++ prettyShow pkgname -renderTargetSelector (TargetComponentUnknown pkgname (Right cname) subtarget) = - renderSubComponentTarget subtarget - ++ "the " +renderTargetSelector (TargetComponentUnknown pkgname (Right cname)) = + "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" @@ -260,7 +249,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 " @@ -273,7 +262,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 " @@ -286,7 +275,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 " @@ -305,7 +294,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 b67bda4bcec..0dabb2a745f 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs @@ -268,8 +268,7 @@ selectPackageTargets haddockFlags targetSelector targets -- For the @haddock@ command we just need the basic checks on being buildable -- etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: 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 4e0a84bda51..0adeca99446 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,8 +1262,7 @@ selectPackageTargets targetSelector targets -- -- For the @build@ command we just need the basic checks on being buildable etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: 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 c6939729f61..2573635f880 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) WholeComponent + TargetComponentUnknown (pkgName pid) (Right cn) woPackageTargets (WoURI _) = TargetAllPackages (Just ExeKind) diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs index 1fefd3a7375..6c4c112c44d 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -290,10 +290,9 @@ selectPackageTargets targetSelector targets -- (an executable, a test, or a benchmark), in addition -- to the basic checks on being buildable etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: AvailableTarget k -> Either ListBinTargetProblem k -selectComponentTarget subtarget@WholeComponent t = +selectComponentTarget t = case availableTargetComponentName t of CExeName _ -> component CTestName _ -> component @@ -303,14 +302,7 @@ selectComponentTarget subtarget@WholeComponent t = where pkgid = availableTargetPackageId t cname = availableTargetComponentName t - component = selectComponentTargetBasic subtarget t -selectComponentTarget subtarget t = - Left - ( isSubComponentProblem - (availableTargetPackageId t) - (availableTargetComponentName t) - subtarget - ) + component = selectComponentTargetBasic t -- | The various error conditions that can occur when matching a -- 'TargetSelector' against 'AvailableTarget's for the @run@ command. @@ -323,8 +315,6 @@ 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 @@ -345,15 +335,6 @@ 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 @@ -404,16 +385,7 @@ renderListBinProblem (TargetProblemComponentNotRightKind pkgid cname) = ++ prettyShow pkgid ++ "." where - 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 + targetSelector = TargetComponent pkgid cname 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 e243eb82974..bed2cdc6ee8 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -734,8 +734,7 @@ selectPackageTargetsSingle decision targetSelector targets -- -- For the @repl@ command we just need the basic checks on being buildable etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: 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 b390dacb22e..a2a9cebd637 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -439,10 +439,9 @@ selectPackageTargets targetSelector targets -- (an executable, a test, or a benchmark), in addition -- to the basic checks on being buildable etc. selectComponentTarget - :: SubComponentTarget - -> AvailableTarget k + :: AvailableTarget k -> Either RunTargetProblem k -selectComponentTarget subtarget@WholeComponent t = +selectComponentTarget t = case availableTargetComponentName t of CExeName _ -> component CTestName _ -> component @@ -451,14 +450,7 @@ selectComponentTarget subtarget@WholeComponent t = where pkgid = availableTargetPackageId t cname = availableTargetComponentName t - component = selectComponentTargetBasic subtarget t -selectComponentTarget subtarget t = - Left - ( isSubComponentProblem - (availableTargetPackageId t) - (availableTargetComponentName t) - subtarget - ) + component = selectComponentTargetBasic t -- | The various error conditions that can occur when matching a -- 'TargetSelector' against 'AvailableTarget's for the @run@ command. @@ -471,8 +463,6 @@ 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 @@ -493,15 +483,6 @@ 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 @@ -555,16 +536,7 @@ renderRunProblem (TargetProblemComponentNotExe pkgid cname) = ++ prettyShow pkgid ++ "." where - 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 + targetSelector = TargetComponent pkgid cname 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 c77c1eae910..01ab558e655 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 74fcc3a78b2..bb5ed9d124f 100644 --- a/cabal-install/src/Distribution/Client/CmdTest.hs +++ b/cabal-install/src/Distribution/Client/CmdTest.hs @@ -7,7 +7,6 @@ module Distribution.Client.CmdTest , testAction -- * Internals exposed for testing - , isSubComponentProblem , notTestProblem , noTestsProblem , selectPackageTargets @@ -206,26 +205,18 @@ 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 - :: SubComponentTarget - -> AvailableTarget k + :: AvailableTarget k -> Either TestTargetProblem k -selectComponentTarget subtarget@WholeComponent t +selectComponentTarget t | CTestName _ <- availableTargetComponentName t = either Left return $ - selectComponentTargetBasic subtarget t + selectComponentTargetBasic 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. @@ -234,8 +225,6 @@ 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 @@ -246,15 +235,6 @@ 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 @@ -309,13 +289,4 @@ renderTestProblem (TargetProblemComponentNotTest pkgid cname) = ++ prettyShow pkgid ++ "." where - 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 + targetSelector = TargetComponent pkgid cname diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs index b93064ea7be..eef99b280c3 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/PackageFileMonitor.hs @@ -92,19 +92,20 @@ packageFileMonitorKeyValues packageFileMonitorKeyValues elab = (elab_config, buildComponents) where - -- The first part is the value used to guard (re)configuring the package. + -- The first part, 'elab_config', 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 @@ -127,7 +128,7 @@ packageFileMonitorKeyValues elab = -- what targets we're going to build. -- buildComponents :: Set ComponentName - buildComponents = elabBuildTargetWholeComponents elab + buildComponents = Set.fromList [cn | ComponentTarget cn <- elabBuildTargets 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 157d0fa09a4..c5020941e4c 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs @@ -884,7 +884,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 db99b2576b9..4f5c9faeed8 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -71,7 +71,6 @@ module Distribution.Client.ProjectOrchestration , ComponentName (..) , ComponentKind (..) , ComponentTarget (..) - , SubComponentTarget (..) , selectComponentTargetBasic , distinctTargetComponents @@ -608,8 +607,7 @@ resolveTargets -> Either (TargetProblem err) [k] ) -> ( forall k - . SubComponentTarget - -> AvailableTarget k + . AvailableTarget k -> Either (TargetProblem err) k ) -> ElaboratedInstallPlan @@ -647,7 +645,7 @@ resolveTargets | Just ats <- fmap (maybe id filterTargetsKind mkfilter) $ Map.lookup pkgid availableTargetsByPackageId = - fmap (componentTargets WholeComponent) $ + fmap componentTargets $ selectPackageTargets bt ats | otherwise = Left (TargetProblemNoSuchPackage pkgid) @@ -665,23 +663,23 @@ resolveTargets -- .cabal files for a single package? checkTarget bt@(TargetAllPackages mkfilter) = - fmap (componentTargets WholeComponent) + fmap componentTargets . selectPackageTargets bt . maybe id filterTargetsKind mkfilter . filter availableTargetLocalToProject $ concat (Map.elems availableTargetsByPackageId) - checkTarget (TargetComponent pkgid cname subtarget) + checkTarget (TargetComponent pkgid cname) | Just ats <- Map.lookup (pkgid, cname) availableTargetsByPackageIdAndComponentName = - fmap (componentTargets subtarget) $ - selectComponentTargets subtarget ats + fmap componentTargets $ + selectComponentTargets ats | Map.member pkgid availableTargetsByPackageId = Left (TargetProblemNoSuchComponent pkgid cname) | otherwise = Left (TargetProblemNoSuchPackage pkgid) - checkTarget (TargetComponentUnknown pkgname ecname subtarget) + checkTarget (TargetComponentUnknown pkgname ecname) | Just ats <- case ecname of Left ucname -> Map.lookup @@ -691,8 +689,8 @@ resolveTargets Map.lookup (pkgname, cname) availableTargetsByPackageNameAndComponentName = - fmap (componentTargets subtarget) $ - selectComponentTargets subtarget ats + fmap componentTargets $ + selectComponentTargets ats | Map.member pkgname availableTargetsByPackageName = Left (TargetProblemUnknownComponent pkgname ecname) | otherwise = @@ -701,7 +699,7 @@ resolveTargets | Just ats <- fmap (maybe id filterTargetsKind mkfilter) $ Map.lookup pkgname availableTargetsByPackageName = - fmap (componentTargets WholeComponent) + fmap componentTargets . selectPackageTargets bt $ ats | Just SourcePackageDb{packageIndex} <- mPkgDb @@ -712,20 +710,18 @@ resolveTargets Left (TargetNotInProject pkgname) componentTargets - :: SubComponentTarget - -> [(b, ComponentName)] + :: [(b, ComponentName)] -> [(b, ComponentTarget)] - componentTargets subtarget = - map (fmap (\cname -> ComponentTarget cname subtarget)) + componentTargets = + map (fmap (\cname -> ComponentTarget cname)) selectComponentTargets - :: SubComponentTarget - -> [AvailableTarget k] + :: [AvailableTarget k] -> Either (TargetProblem err) [k] - selectComponentTargets subtarget = + selectComponentTargets = either (Left . NE.head) Right . checkErrors - . map (selectComponentTarget subtarget) + . map selectComponentTarget checkErrors :: [Either e a] -> Either (NonEmpty e) [a] checkErrors = @@ -881,11 +877,9 @@ 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 - :: SubComponentTarget - -> AvailableTarget k + :: AvailableTarget k -> Either (TargetProblem a) k selectComponentTargetBasic - subtarget AvailableTarget { availableTargetPackageId = pkgid , availableTargetComponentName = cname @@ -893,13 +887,13 @@ selectComponentTargetBasic } = case availableTargetStatus of TargetDisabledByUser -> - Left (TargetOptionalStanzaDisabledByUser pkgid cname subtarget) + Left (TargetOptionalStanzaDisabledByUser pkgid cname) TargetDisabledBySolver -> - Left (TargetOptionalStanzaDisabledBySolver pkgid cname subtarget) + Left (TargetOptionalStanzaDisabledBySolver pkgid cname) TargetNotLocal -> - Left (TargetComponentNotProjectLocal pkgid cname subtarget) + Left (TargetComponentNotProjectLocal pkgid cname) TargetNotBuildable -> - Left (TargetComponentNotBuildable pkgid cname subtarget) + Left (TargetComponentNotBuildable pkgid cname) TargetBuildable targetKey _ -> Right targetKey @@ -924,7 +918,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 ad9e507ae5c..deff1f38bf0 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -57,7 +57,6 @@ module Distribution.Client.ProjectPlanning , AvailableTargetStatus (..) , TargetRequested (..) , ComponentTarget (..) - , SubComponentTarget (..) , showComponentTarget , nubComponentTargets @@ -69,7 +68,6 @@ module Distribution.Client.ProjectPlanning -- * Utils required for building , pkgHasEphemeralBuildTargets - , elabBuildTargetWholeComponents , configureCompiler -- * Setup.hs CLI flags for building @@ -3053,7 +3051,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 @@ -3062,7 +3060,7 @@ nubComponentTargets = :: [(ComponentTarget, a)] -> [(ComponentTarget, NonEmpty a)] wholeComponentOverrides ts = - case [ta | ta@(ComponentTarget _ WholeComponent, _) <- ts] of + case [ta | ta@(ComponentTarget _, _) <- ts] of ((t, x) : _) -> let -- Delete tuple (t, x) from original list to avoid duplicates. @@ -3075,9 +3073,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 _subtarget, x) + compatSubComponentTargets target@(ComponentTarget cname, x) | not setupHsSupportsSubComponentTargets = - (ComponentTarget cname WholeComponent, x) + (ComponentTarget cname, x) | otherwise = target -- Actually the reality is that no current version of Cabal's Setup.hs @@ -3093,19 +3091,6 @@ 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] ------------------------------------------------------------------------------ @@ -3279,7 +3264,7 @@ pruneInstallPlanPass1 pkgs add_repl_target ecp | elabUnitId ecp `Set.member` all_desired_repl_targets = ecp - { elabReplTarget = maybeToList (ComponentTarget <$> (elabComponentName ecp) <*> pure WholeComponent) + { elabReplTarget = maybeToList (ComponentTarget <$> elabComponentName ecp) , elabBuildStyle = BuildInplaceOnly InMemory } | otherwise = ecp @@ -3417,7 +3402,7 @@ pruneInstallPlanPass1 pkgs optionalStanzasRequiredByTargets pkg = optStanzaSetFromList [ stanza - | ComponentTarget cname _ <- + | ComponentTarget cname <- elabBuildTargets pkg ++ elabTestTargets pkg ++ elabBenchTargets pkg @@ -3577,7 +3562,7 @@ pruneInstallPlanPass2 pkgs = libTargetsRequiredForRevDeps = [ c | installedUnitId elab `Set.member` hasReverseLibDeps - , let c = ComponentTarget (CLibName Cabal.defaultLibName) WholeComponent + , let c = ComponentTarget (CLibName Cabal.defaultLibName) , -- Don't enable building for anything which is being build in memory elabBuildStyle elab /= BuildInplaceOnly InMemory ] @@ -3590,7 +3575,6 @@ pruneInstallPlanPass2 pkgs = packageName $ elabPkgSourceId elab ) - WholeComponent | installedUnitId elab `Set.member` hasReverseExeDeps ] @@ -4006,7 +3990,7 @@ setupHsConfigureArgs -> [String] setupHsConfigureArgs (ElaboratedConfiguredPackage{elabPkgOrComp = ElabPackage _}) = [] setupHsConfigureArgs elab@(ElaboratedConfiguredPackage{elabPkgOrComp = ElabComponent comp}) = - [showComponentTarget (packageId elab) (ComponentTarget cname WholeComponent)] + [showComponentTarget (packageId elab) (ComponentTarget cname)] where cname = fromMaybe diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs index 96de8adea45..1a5ace436ae 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs @@ -48,7 +48,6 @@ module Distribution.Client.ProjectPlanning.Types , showComponentTarget , showTestComponentTarget , showBenchComponentTarget - , SubComponentTarget (..) , isSubLibComponentTarget , isForeignLibComponentTarget , isExeComponentTarget @@ -64,9 +63,6 @@ import Distribution.Client.Compat.Prelude import Prelude () import Distribution.Client.PackageHash -import Distribution.Client.TargetSelector - ( SubComponentTarget (..) - ) import Distribution.Client.DistDirLayout import Distribution.Client.InstallPlan @@ -397,7 +393,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 @@ -412,10 +408,11 @@ 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 WholeComponent) = is_lib cn - is_lib_target _ = False + is_lib_target (ComponentTarget cn) = is_lib cn + is_lib (CLibName _) = True is_lib _ = False @@ -800,7 +797,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 SubComponentTarget +data ComponentTarget = ComponentTarget ComponentName deriving (Eq, Ord, Show, Generic) instance Binary ComponentTarget @@ -813,38 +810,35 @@ showComponentTarget pkgid = Cabal.showBuildTarget pkgid . toBuildTarget where toBuildTarget :: ComponentTarget -> Cabal.BuildTarget - toBuildTarget (ComponentTarget cname subtarget) = - case subtarget of - WholeComponent -> Cabal.BuildTargetComponent cname - ModuleTarget mname -> Cabal.BuildTargetModule cname mname - FileTarget fname -> Cabal.BuildTargetFile cname fname + toBuildTarget (ComponentTarget cname) = + Cabal.BuildTargetComponent cname 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 680250273c0..1292c490968 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 (SubComponentTarget, TargetSelector) +import Distribution.Client.TargetSelector (TargetSelector) import Distribution.Package (PackageId, PackageName) import Distribution.Simple.LocalBuildInfo (ComponentName (..)) import Distribution.Types.UnqualComponentName (UnqualComponentName) @@ -21,19 +21,15 @@ 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 d29413642de..4932f07361f 100644 --- a/cabal-install/src/Distribution/Client/TargetSelector.hs +++ b/cabal-install/src/Distribution/Client/TargetSelector.hs @@ -25,7 +25,6 @@ module Distribution.Client.TargetSelector , TargetImplicitCwd (..) , ComponentKind (..) , ComponentKindFilter - , SubComponentTarget (..) , QualLevel (..) , componentKind @@ -66,7 +65,6 @@ import Distribution.Types.UnqualComponentName import Distribution.ModuleName ( ModuleName - , toFilePath ) import Distribution.PackageDescription ( Benchmark (..) @@ -101,9 +99,6 @@ 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 @@ -135,15 +130,11 @@ import qualified System.Directory as IO import System.FilePath ( dropTrailingPathSeparator , equalFilePath - , normalise , (<.>) , () ) import System.FilePath as FilePath - ( dropExtension - , joinPath - , splitDirectories - , splitPath + ( splitPath , takeExtension ) import Text.EditDistance @@ -192,14 +183,13 @@ 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 SubComponentTarget + TargetComponent PackageId ComponentName | -- | 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 @@ -214,21 +204,6 @@ 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 @@ -414,12 +389,8 @@ showTargetSelectorKind bt = case bt of TargetPackageNamed _ (Just _) -> "named-package:filter" TargetAllPackages Nothing -> "package *" TargetAllPackages (Just _) -> "package *:filter" - TargetComponent _ _ WholeComponent -> "component" - TargetComponent _ _ ModuleTarget{} -> "module" - TargetComponent _ _ FileTarget{} -> "file" - TargetComponentUnknown _ _ WholeComponent -> "unknown-component" - TargetComponentUnknown _ _ ModuleTarget{} -> "unknown-module" - TargetComponentUnknown _ _ FileTarget{} -> "unknown-file" + TargetComponent _ _ -> "component" + TargetComponentUnknown _ _ -> "unknown-component" -- ------------------------------------------------------------ @@ -636,7 +607,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 @@ -965,8 +936,6 @@ syntaxForms ] ] , syntaxForm1Component ocinfo - , syntaxForm1Module cinfo - , syntaxForm1File pinfo ] , -- two-component partially qualified forms -- fully qualified form for 'all' @@ -976,24 +945,8 @@ 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 @@ -1003,8 +956,6 @@ syntaxForms , syntaxForm4MetaNamespacePackageFilter pinfo , -- fully-qualified forms for component, module and file syntaxForm5MetaNamespacePackageKindComponent pinfo - , syntaxForm7MetaNamespacePackageKindComponentNamespaceModule pinfo - , syntaxForm7MetaNamespacePackageKindComponentNamespaceFile pinfo ] where ambiguousAlternatives = Prelude.foldr1 AmbiguousAlternatives @@ -1066,49 +1017,12 @@ syntaxForm1Component cs = syntaxForm1 render $ \str1 _fstatus1 -> do guardComponentName str1 c <- matchComponentName cs str1 - return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent) + return (TargetComponent (cinfoPackageId c) (cinfoName c)) where - render (TargetComponent p c WholeComponent) = + render (TargetComponent p c) = [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 @@ -1196,16 +1110,16 @@ syntaxForm2PackageComponent ps = KnownPackage{pinfoId, pinfoComponents} -> orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do c <- matchComponentName pinfoComponents str2 - return (TargetComponent pinfoId (cinfoName c) WholeComponent) + return (TargetComponent pinfoId (cinfoName c)) -- 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) WholeComponent) + in return (TargetComponentUnknown pn (Left cn)) where - render (TargetComponent p c WholeComponent) = + render (TargetComponent p c) = [TargetStringFileStatus2 (dispP p) noFileStatus (dispC p c)] - render (TargetComponentUnknown pn (Left cn) WholeComponent) = + render (TargetComponentUnknown pn (Left cn)) = [TargetStringFileStatus2 (dispPN pn) noFileStatus (prettyShow cn)] render _ = [] @@ -1218,108 +1132,12 @@ syntaxForm2KindComponent cs = ckind <- matchComponentKind str1 guardComponentName str2 c <- matchComponentKindAndName cs ckind str2 - return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent) + return (TargetComponent (cinfoPackageId c) (cinfoName c)) where - render (TargetComponent p c WholeComponent) = + render (TargetComponent p c) = [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 @@ -1386,123 +1204,17 @@ syntaxForm3PackageKindComponent ps = KnownPackage{pinfoId, pinfoComponents} -> orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do c <- matchComponentKindAndName pinfoComponents ckind str3 - return (TargetComponent pinfoId (cinfoName c) WholeComponent) + return (TargetComponent pinfoId (cinfoName c)) KnownPackageName pn -> let cn = mkComponentName pn ckind (mkUnqualComponentName str3) - in return (TargetComponentUnknown pn (Right cn) WholeComponent) + in return (TargetComponentUnknown pn (Right cn)) where - render (TargetComponent p c WholeComponent) = + render (TargetComponent p c) = [TargetStringFileStatus3 (dispP p) noFileStatus (dispCK c) (dispC p c)] - render (TargetComponentUnknown pn (Right c) WholeComponent) = + render (TargetComponentUnknown pn (Right c)) = [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 @@ -1560,114 +1272,17 @@ syntaxForm5MetaNamespacePackageKindComponent ps = KnownPackage{pinfoId, pinfoComponents} -> orNoThingIn "package" (prettyShow (packageName pinfoId)) $ do c <- matchComponentKindAndName pinfoComponents ckind str5 - return (TargetComponent pinfoId (cinfoName c) WholeComponent) + return (TargetComponent pinfoId (cinfoName c)) KnownPackageName pn -> let cn = mkComponentName pn ckind (mkUnqualComponentName str5) - in return (TargetComponentUnknown pn (Right cn) WholeComponent) + in return (TargetComponentUnknown pn (Right cn)) where - render (TargetComponent p c WholeComponent) = + render (TargetComponent p c) = [TargetStringFileStatus5 "" "pkg" (dispP p) (dispCK c) (dispC p c)] - render (TargetComponentUnknown pn (Right c) WholeComponent) = + render (TargetComponentUnknown pn (Right c)) = [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 -- @@ -1697,40 +1312,29 @@ 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 @@ -1738,6 +1342,7 @@ syntaxForm4 render f = f str1 str2 str3 str4 match _ = mzero +syntaxForm5 :: Renderer -> Match5 -> Syntax syntaxForm5 render f = Syntax QLFull match render where @@ -1745,13 +1350,6 @@ 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 @@ -1764,9 +1362,6 @@ dispC = componentStringName . packageName dispC' :: PackageName -> ComponentName -> String dispC' = componentStringName -dispCN :: UnqualComponentName -> String -dispCN = prettyShow - dispK :: ComponentKind -> String dispK = showComponentKindShort @@ -1776,9 +1371,6 @@ dispCK = dispK . componentKind dispF :: ComponentKind -> String dispF = showComponentKindFilterShort -dispM :: ModuleName -> String -dispM = prettyShow - ------------------------------- -- Package and component info -- @@ -1969,12 +1561,6 @@ 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 @@ -2186,97 +1772,7 @@ matchComponentKindAndName cs ckind str = render c = showComponentKindShort (cinfoKind c) ++ ":" ++ cinfoStrName c ------------------------------ --- 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 +-- Utils -- | Compare two filepaths for equality using DirActions' canonicalizePath -- to normalize AND canonicalize filepaths before comparison. @@ -2293,25 +1789,6 @@ 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 -- @@ -2423,10 +1900,6 @@ 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 @@ -2456,9 +1929,6 @@ 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 -- @@ -2589,7 +2059,7 @@ ex1pinfo = -} {- stargets = - [ TargetComponent (CExeName "foo") WholeComponent + [ TargetComponent (CExeName "foo") , 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 55ea3747b9f..ef40f64a8a6 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -57,9 +57,7 @@ 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) @@ -234,40 +232,8 @@ 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) 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. + ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName)) + ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName)) cleanProject testdir where @@ -370,24 +336,6 @@ 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" @@ -399,19 +347,6 @@ 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] @@ -488,26 +423,13 @@ 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 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) + TargetComponent pkgid cname mkTargetAllPackages :: TargetSelector mkTargetAllPackages = TargetAllPackages Nothing @@ -605,23 +527,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") WholeComponent + , ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") , 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") WholeComponent + , ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") , 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") WholeComponent + "q-0.1" (CBenchName "user-disabled") , mkTargetComponent "q-0.1" (CBenchName "user-disabled") ) -- An unknown package. The target selector resolution should only @@ -1085,23 +1007,6 @@ 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") - ] ] @@ -1187,26 +1092,8 @@ 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 @@ -1298,7 +1185,7 @@ assertProjectDistinctTargets :: forall err. (Eq err, Show err) => ElaboratedInstallPlan -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) - -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k ) + -> (forall k. AvailableTarget k -> Either (TargetProblem err) k ) -> [TargetSelector] -> [(UnitId, ComponentName)] -> Assertion @@ -1328,8 +1215,7 @@ assertProjectTargetProblems -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) - -> (forall k. SubComponentTarget - -> AvailableTarget k + -> (forall k. AvailableTarget k -> Either (TargetProblem err) k ) -> [(TargetSelector -> TargetProblem err, TargetSelector)] -> Assertion @@ -1349,7 +1235,7 @@ assertTargetProblems :: forall err. (Eq err, Show err) => ElaboratedInstallPlan -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) - -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k ) + -> (forall k. AvailableTarget k -> Either (TargetProblem err) k ) -> [(TargetSelector -> TargetProblem err, TargetSelector)] -> Assertion assertTargetProblems elaboratedPlan selectPackageTargets selectComponentTarget = @@ -1734,7 +1620,7 @@ executePlan ((distDirLayout, cabalDirLayout, config, _, buildSettings), let targets :: Map.Map UnitId [ComponentTarget] targets = Map.fromList - [ (unitid, [ComponentTarget cname WholeComponent]) + [ (unitid, [ComponentTarget cname]) | 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 8434f623e82..82d44bb354e 100644 --- a/cabal-install/tests/UnitTests.hs +++ b/cabal-install/tests/UnitTests.hs @@ -14,7 +14,6 @@ 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 @@ -67,9 +66,6 @@ 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 deleted file mode 100644 index 184cfef5bdf..00000000000 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectPlanning.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# 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 deleted file mode 100644 index 73566f6f203..00000000000 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs +++ /dev/null @@ -1 +0,0 @@ -main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal deleted file mode 100644 index 22a27144592..00000000000 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal +++ /dev/null @@ -1,9 +0,0 @@ -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 deleted file mode 100644 index 25b71f37cce..00000000000 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out +++ /dev/null @@ -1,4 +0,0 @@ -# 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 deleted file mode 100644 index e6fdbadb439..00000000000 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: . diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs deleted file mode 100644 index 88370b0fae4..00000000000 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs +++ /dev/null @@ -1,4 +0,0 @@ -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 new file mode 100644 index 00000000000..cd3b4cb656a --- /dev/null +++ b/changelog.d/pr-8966 @@ -0,0 +1,20 @@ +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. + +}