diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 51a62056c43..441e0d4e79c 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -119,6 +119,14 @@ extra-source-files: tests/PackageTests/HaddockNewline/A.hs tests/PackageTests/HaddockNewline/HaddockNewline.cabal tests/PackageTests/HaddockNewline/Setup.hs + tests/PackageTests/MultipleLibraries/p.cabal + tests/PackageTests/MultipleLibraries/p/P.hs + tests/PackageTests/MultipleLibraries/p/Foo.hs + tests/PackageTests/MultipleLibraries/p/p.cabal + tests/PackageTests/MultipleLibraries/p/p/P.hs + tests/PackageTests/MultipleLibraries/p/q/Q.hs + tests/PackageTests/MultipleLibraries/q/Q.hs + tests/PackageTests/MultipleLibraries/q/q.cabal tests/PackageTests/Options.hs tests/PackageTests/OrderFlags/Foo.hs tests/PackageTests/OrderFlags/my.cabal diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 20cb29b1224..a792d5d7283 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -189,7 +189,7 @@ data PackageDescription buildType :: Maybe BuildType, setupBuildInfo :: Maybe SetupBuildInfo, -- components - library :: Maybe Library, + libraries :: [Library], executables :: [Executable], testSuites :: [TestSuite], benchmarks :: [Benchmark], @@ -256,7 +256,7 @@ emptyPackageDescription category = "", customFieldsPD = [], setupBuildInfo = Nothing, - library = Nothing, + libraries = [], executables = [], testSuites = [], benchmarks = [], @@ -387,6 +387,7 @@ instance Text ModuleRenaming where -- The Library type data Library = Library { + libName :: String, exposedModules :: [ModuleName], reexportedModules :: [ModuleReexport], requiredSignatures:: [ModuleName], -- ^ What sigs need implementations? @@ -400,6 +401,7 @@ instance Binary Library instance Monoid Library where mempty = Library { + libName = mempty, exposedModules = mempty, reexportedModules = mempty, requiredSignatures = mempty, @@ -411,6 +413,7 @@ instance Monoid Library where instance Semigroup Library where a <> b = Library { + libName = combine' libName, exposedModules = combine exposedModules, reexportedModules = combine reexportedModules, requiredSignatures = combine requiredSignatures, @@ -419,20 +422,26 @@ instance Semigroup Library where libBuildInfo = combine libBuildInfo } where combine field = field a `mappend` field b + combine' field = case (field a, field b) of + ("","") -> "" + ("", x) -> x + (x, "") -> x + (x, y) -> error $ "Ambiguous values for library field: '" + ++ x ++ "' and '" ++ y ++ "'" emptyLibrary :: Library emptyLibrary = mempty -- |does this package have any libraries? hasLibs :: PackageDescription -> Bool -hasLibs p = maybe False (buildable . libBuildInfo) (library p) +hasLibs p = any (buildable . libBuildInfo) (libraries p) -- |'Maybe' version of 'hasLibs' -maybeHasLibs :: PackageDescription -> Maybe Library +maybeHasLibs :: PackageDescription -> [Library] maybeHasLibs p = - library p >>= \lib -> if buildable (libBuildInfo lib) - then Just lib - else Nothing + libraries p >>= \lib -> if buildable (libBuildInfo lib) + then return lib + else [] -- |If the package description has a library section, call the given -- function with the library build info as argument. @@ -915,7 +924,7 @@ emptyBuildInfo = mempty -- all buildable executables, test suites and benchmarks. Useful for gathering -- dependencies. allBuildInfo :: PackageDescription -> [BuildInfo] -allBuildInfo pkg_descr = [ bi | Just lib <- [library pkg_descr] +allBuildInfo pkg_descr = [ bi | lib <- libraries pkg_descr , let bi = libBuildInfo lib , buildable bi ] ++ [ bi | exe <- executables pkg_descr @@ -950,10 +959,10 @@ usedExtensions :: BuildInfo -> [Extension] usedExtensions bi = oldExtensions bi ++ defaultExtensions bi -type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)]) +type HookedBuildInfo = ([(String, BuildInfo)], [(String, BuildInfo)]) emptyHookedBuildInfo :: HookedBuildInfo -emptyHookedBuildInfo = (Nothing, []) +emptyHookedBuildInfo = ([], []) -- |Select options for a particular Haskell compiler. hcOptions :: CompilerFlavor -> BuildInfo -> [String] @@ -1109,28 +1118,30 @@ lowercase = map Char.toLower -- ------------------------------------------------------------ updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription -updatePackageDescription (mb_lib_bi, exe_bi) p - = p{ executables = updateExecutables exe_bi (executables p) - , library = updateLibrary mb_lib_bi (library p) +updatePackageDescription (lib_bi, exe_bi) p + = p{ executables = updateMany exeName updateExecutable exe_bi (executables p) + , libraries = updateMany libName updateLibrary lib_bi (libraries p) } where - updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library - updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = bi `mappend` libBuildInfo lib}) - updateLibrary Nothing mb_lib = mb_lib - updateLibrary (Just _) Nothing = Nothing - - updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)] - -> [Executable] -- ^list of executables to update - -> [Executable] -- ^list with exeNames updated - updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi' - - updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo) - -> [Executable] -- ^list of executables to update - -> [Executable] -- ^list with exeName updated - updateExecutable _ [] = [] - updateExecutable exe_bi'@(name,bi) (exe:exes) - | exeName exe == name = exe{buildInfo = bi `mappend` buildInfo exe} : exes - | otherwise = exe : updateExecutable exe_bi' exes + updateMany :: (a -> String) -- ^ @exeName@ or @libName@ + -> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@ + -> [(String, BuildInfo)] -- ^[(name, new buildinfo)] + -> [a] -- ^list of components to update + -> [a] -- ^list with updated components + updateMany name update hooked_bi' cs' = foldr (updateOne name update) cs' hooked_bi' + + updateOne :: (a -> String) -- ^ @exeName@ or @libName@ + -> (BuildInfo -> a -> a) -- ^ @updateExecutable@ or @updateLibrary@ + -> (String, BuildInfo) -- ^(name, new buildinfo) + -> [a] -- ^list of components to update + -> [a] -- ^list with name component updated + updateOne _ _ _ [] = [] + updateOne name_sel update hooked_bi'@(name,bi) (c:cs) + | name_sel c == name = update bi c : cs + | otherwise = c : updateOne name_sel update hooked_bi' cs + + updateExecutable bi exe = exe{buildInfo = bi `mappend` buildInfo exe} + updateLibrary bi lib = lib{libBuildInfo = bi `mappend` libBuildInfo lib} -- --------------------------------------------------------------------------- -- The GenericPackageDescription type @@ -1139,7 +1150,7 @@ data GenericPackageDescription = GenericPackageDescription { packageDescription :: PackageDescription, genPackageFlags :: [Flag], - condLibrary :: Maybe (CondTree ConfVar [Dependency] Library), + condLibraries :: [(String, CondTree ConfVar [Dependency] Library)], condExecutables :: [(String, CondTree ConfVar [Dependency] Executable)], condTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)], condBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)] diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 192ebf31120..5da731487e4 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -46,7 +46,7 @@ import Distribution.Text import Language.Haskell.Extension import Data.Maybe - ( isNothing, isJust, catMaybes, mapMaybe, maybeToList, fromMaybe ) + ( isNothing, isJust, catMaybes, mapMaybe, fromMaybe ) import Data.List (sort, group, isPrefixOf, nub, find) import Control.Monad ( filterM, liftM ) @@ -173,7 +173,7 @@ checkSanity pkg = , check (all ($ pkg) [ null . executables , null . testSuites , null . benchmarks - , isNothing . library ]) $ + , null . libraries ]) $ PackageBuildImpossible "No executables, libraries, tests, or benchmarks found. Nothing to do." @@ -185,7 +185,7 @@ checkSanity pkg = --TODO: check for name clashes case insensitively: windows file systems cannot --cope. - ++ maybe [] (checkLibrary pkg) (library pkg) + ++ concatMap (checkLibrary pkg) (libraries pkg) ++ concatMap (checkExecutable pkg) (executables pkg) ++ concatMap (checkTestSuite pkg) (testSuites pkg) ++ concatMap (checkBenchmark pkg) (benchmarks pkg) @@ -681,7 +681,7 @@ checkGhcOptions pkg = where all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg) - lib_ghc_options = maybe [] (get_ghc_options . libBuildInfo) (library pkg) + lib_ghc_options = concatMap (get_ghc_options . libBuildInfo) (libraries pkg) get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi ++ hcSharedOptions GHC bi @@ -904,9 +904,18 @@ checkCabalVersion pkg = ++ "different modules then list the other ones in the " ++ "'other-languages' field." + , checkVersion [1,23] + (case libraries pkg of + [lib] -> libName lib /= unPackageName (packageName pkg) + [] -> False + _ -> True) $ + PackageDistInexcusable $ + "To use multiple 'library' sections or a named library section " + ++ "the package needs to specify at least 'cabal-version >= 1.23'." + -- check use of reexported-modules sections , checkVersion [1,21] - (maybe False (not.null.reexportedModules) (library pkg)) $ + (any (not.null.reexportedModules) (libraries pkg)) $ PackageDistInexcusable $ "To use the 'reexported-module' field the package needs to specify " ++ "at least 'cabal-version: >= 1.21'." @@ -1312,7 +1321,7 @@ checkConditionals pkg = unknownOSs = [ os | OS (OtherOS os) <- conditions ] unknownArches = [ arch | Arch (OtherArch arch) <- conditions ] unknownImpls = [ impl | Impl (OtherCompiler impl) _ <- conditions ] - conditions = maybe [] fvs (condLibrary pkg) + conditions = concatMap (fvs . snd) (condLibraries pkg) ++ concatMap (fvs . snd) (condExecutables pkg) fvs (CondNode _ _ ifs) = concatMap compfv ifs -- free variables compfv (c, ct, mct) = condfv c ++ fvs ct ++ maybe [] fvs mct @@ -1416,8 +1425,8 @@ checkDevelopmentOnlyFlags pkg = allConditionalBuildInfo :: [([Condition ConfVar], BuildInfo)] allConditionalBuildInfo = - concatMap (collectCondTreePaths libBuildInfo) - (maybeToList (condLibrary pkg)) + concatMap (collectCondTreePaths libBuildInfo . snd) + (condLibraries pkg) ++ concatMap (collectCondTreePaths buildInfo . snd) (condExecutables pkg) diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 9b98d29068d..70fee237bfa 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -274,7 +274,7 @@ resolveWithFlags dom os arch impl constrs trees checkDeps = env flags flag = (maybe (Left flag) Right . lookup flag) flags pdTaggedBuildInfo :: PDTagged -> BuildInfo - pdTaggedBuildInfo (Lib l) = libBuildInfo l + pdTaggedBuildInfo (Lib _ l) = libBuildInfo l pdTaggedBuildInfo (Exe _ e) = buildInfo e pdTaggedBuildInfo (Test _ t) = testBuildInfo t pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b @@ -410,7 +410,7 @@ overallDependencies (TargetSet targets) = mconcat depss where (depss, _) = unzip $ filter (removeDisabledSections . snd) targets removeDisabledSections :: PDTagged -> Bool - removeDisabledSections (Lib l) = buildable (libBuildInfo l) + removeDisabledSections (Lib _ l) = buildable (libBuildInfo l) removeDisabledSections (Exe _ e) = buildable (buildInfo e) removeDisabledSections (Test _ t) = testEnabled t && buildable (testBuildInfo t) removeDisabledSections (Bench _ b) = benchmarkEnabled b && buildable (benchmarkBuildInfo b) @@ -435,50 +435,53 @@ constrainBy left extra = -- | Collect up the targets in a TargetSet of tagged targets, storing the -- dependencies as we go. flattenTaggedTargets :: TargetSet PDTagged -> - (Maybe Library, [(String, Executable)], [(String, TestSuite)] + ([(String, Library)], [(String, Executable)], [(String, TestSuite)] , [(String, Benchmark)]) -flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) targets +flattenTaggedTargets (TargetSet targets) = foldr untag ([], [], [], []) targets where - untag (_, Lib _) (Just _, _, _, _) = userBug "Only one library expected" - untag (deps, Lib l) (Nothing, exes, tests, bms) = - (Just l', exes, tests, bms) + untag (deps, Lib n l) (libs, exes, tests, bms) + | any ((== n) . fst) libs = + userBug $ "There exist several libs with the same name: '" ++ n ++ "'" + -- NB: libraries live in a different namespace than everything else + -- TODO: no, (new-style) TESTS live in same namespace!! + | otherwise = ((n, l'):libs, exes, tests, bms) where l' = l { libBuildInfo = (libBuildInfo l) { targetBuildDepends = fromDepMap deps } } - untag (deps, Exe n e) (mlib, exes, tests, bms) + untag (deps, Exe n e) (libs, exes, tests, bms) | any ((== n) . fst) exes = userBug $ "There exist several exes with the same name: '" ++ n ++ "'" | any ((== n) . fst) tests = userBug $ "There exists a test with the same name as an exe: '" ++ n ++ "'" | any ((== n) . fst) bms = userBug $ "There exists a benchmark with the same name as an exe: '" ++ n ++ "'" - | otherwise = (mlib, (n, e'):exes, tests, bms) + | otherwise = (libs, (n, e'):exes, tests, bms) where e' = e { buildInfo = (buildInfo e) { targetBuildDepends = fromDepMap deps } } - untag (deps, Test n t) (mlib, exes, tests, bms) + untag (deps, Test n t) (libs, exes, tests, bms) | any ((== n) . fst) tests = userBug $ "There exist several tests with the same name: '" ++ n ++ "'" | any ((== n) . fst) exes = userBug $ "There exists an exe with the same name as the test: '" ++ n ++ "'" | any ((== n) . fst) bms = userBug $ "There exists a benchmark with the same name as the test: '" ++ n ++ "'" - | otherwise = (mlib, exes, (n, t'):tests, bms) + | otherwise = (libs, exes, (n, t'):tests, bms) where t' = t { testBuildInfo = (testBuildInfo t) { targetBuildDepends = fromDepMap deps } } - untag (deps, Bench n b) (mlib, exes, tests, bms) + untag (deps, Bench n b) (libs, exes, tests, bms) | any ((== n) . fst) bms = userBug $ "There exist several benchmarks with the same name: '" ++ n ++ "'" | any ((== n) . fst) exes = userBug $ "There exists an exe with the same name as the benchmark: '" ++ n ++ "'" | any ((== n) . fst) tests = userBug $ "There exists a test with the same name as the benchmark: '" ++ n ++ "'" - | otherwise = (mlib, exes, tests, (n, b'):bms) + | otherwise = (libs, exes, tests, (n, b'):bms) where b' = b { benchmarkBuildInfo = (benchmarkBuildInfo b) @@ -491,7 +494,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, [], [], []) tar -- Convert GenericPackageDescription to PackageDescription -- -data PDTagged = Lib Library +data PDTagged = Lib String Library | Exe String Executable | Test String TestSuite | Bench String Benchmark @@ -505,7 +508,7 @@ instance Monoid PDTagged where instance Semigroup PDTagged where PDNull <> x = x x <> PDNull = x - Lib l <> Lib l' = Lib (l <> l') + Lib n l <> Lib n' l' | n == n' = Lib n (l <> l') Exe n e <> Exe n' e' | n == n' = Exe n (e <> e') Test n t <> Test n' t' | n == n' = Test n (t <> t') Bench n b <> Bench n' b' | n == n' = Bench n (b <> b') @@ -548,10 +551,10 @@ finalizePackageDescription :: -- description along with the flag assignments chosen. finalizePackageDescription userflags satisfyDep (Platform arch os) impl constraints - (GenericPackageDescription pkg flags mlib0 exes0 tests0 bms0) = + (GenericPackageDescription pkg flags libs0 exes0 tests0 bms0) = case resolveFlags of - Right ((mlib, exes', tests', bms'), targetSet, flagVals) -> - Right ( pkg { library = mlib + Right ((libs', exes', tests', bms'), targetSet, flagVals) -> + Right ( pkg { libraries = libs' , executables = exes' , testSuites = tests' , benchmarks = bms' @@ -562,7 +565,7 @@ finalizePackageDescription userflags satisfyDep Left missing -> Left missing where -- Combine lib, exes, and tests into one list of @CondTree@s with tagged data - condTrees = maybeToList (fmap (mapTreeData Lib) mlib0 ) + condTrees = map (\(name,tree) -> mapTreeData (Lib name) tree) libs0 ++ map (\(name,tree) -> mapTreeData (Exe name) tree) exes0 ++ map (\(name,tree) -> mapTreeData (Test name) tree) tests0 ++ map (\(name,tree) -> mapTreeData (Bench name) tree) bms0 @@ -570,8 +573,8 @@ finalizePackageDescription userflags satisfyDep resolveFlags = case resolveWithFlags flagChoices os arch impl constraints condTrees check of Right (targetSet, fs) -> - let (mlib, exes, tests, bms) = flattenTaggedTargets targetSet in - Right ( (fmap libFillInDefaults mlib, + let (libs, exes, tests, bms) = flattenTaggedTargets targetSet in + Right ( (map (\(n,l) -> (libFillInDefaults l) { libName = n }) libs, map (\(n,e) -> (exeFillInDefaults e) { exeName = n }) exes, map (\(n,t) -> (testFillInDefaults t) { testName = n }) tests, map (\(n,b) -> (benchFillInDefaults b) { benchmarkName = n }) bms), @@ -614,21 +617,21 @@ resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribu -- default path will be missing from the package description returned by this -- function. flattenPackageDescription :: GenericPackageDescription -> PackageDescription -flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0 tests0 bms0) = - pkg { library = mlib +flattenPackageDescription (GenericPackageDescription pkg _ libs0 exes0 tests0 bms0) = + pkg { libraries = reverse libs , executables = reverse exes , testSuites = reverse tests , benchmarks = reverse bms - , buildDepends = ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps + , buildDepends = reverse ldeps ++ reverse edeps ++ reverse tdeps ++ reverse bdeps } where - (mlib, ldeps) = case mlib0 of - Just lib -> let (l,ds) = ignoreConditions lib in - (Just (libFillInDefaults l), ds) - Nothing -> (Nothing, []) + (libs, ldeps) = foldr flattenLib ([],[]) libs0 (exes, edeps) = foldr flattenExe ([],[]) exes0 (tests, tdeps) = foldr flattenTst ([],[]) tests0 (bms, bdeps) = foldr flattenBm ([],[]) bms0 + flattenLib (n, t) (es, ds) = + let (e, ds') = ignoreConditions t in + ( (libFillInDefaults $ e { libName = n }) : es, ds' ++ ds ) flattenExe (n, t) (es, ds) = let (e, ds') = ignoreConditions t in ( (exeFillInDefaults $ e { exeName = n }) : es, ds' ++ ds ) @@ -684,7 +687,7 @@ transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd' pd = packageDescription gpd pd' = pd { - library = fmap onLibrary (library pd), + libraries = map onLibrary (libraries pd), executables = map onExecutable (executables pd), testSuites = map onTestSuite (testSuites pd), benchmarks = map onBenchmark (benchmarks pd), @@ -724,18 +727,18 @@ transformAllCondTrees onLibrary onExecutable onTestSuite onBenchmark onDepends gpd = gpd' where gpd' = gpd { - condLibrary = condLib', + condLibraries = condLibs', condExecutables = condExes', condTestSuites = condTests', condBenchmarks = condBenchs' } - condLib = condLibrary gpd + condLibs = condLibraries gpd condExes = condExecutables gpd condTests = condTestSuites gpd condBenchs = condBenchmarks gpd - condLib' = fmap (onCondTree onLibrary) condLib + condLibs' = map (mapSnd $ onCondTree onLibrary) condLibs condExes' = map (mapSnd $ onCondTree onExecutable) condExes condTests' = map (mapSnd $ onCondTree onTestSuite) condTests condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 39fa1f0c0ee..b72216545ce 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -55,7 +55,6 @@ import Distribution.Text import Distribution.Compat.ReadP hiding (get) import Data.Char (isSpace) -import Data.Foldable (traverse_) import Data.Maybe (listToMaybe, isJust) import Data.List (nub, unfoldr, partition, (\\)) import Control.Monad (liftM, foldM, when, unless, ap) @@ -741,14 +740,14 @@ parsePackageDescription file = do -- 'getBody' assumes that the remaining fields only consist of -- flags, lib and exe sections. - (repos, flags, mcsetup, mlib, exes, tests, bms) <- getBody + (repos, flags, mcsetup, libs, exes, tests, bms) <- getBody pkg warnIfRest -- warn if getBody did not parse up to the last field. -- warn about using old/new syntax with wrong cabal-version: maybeWarnCabalVersion (not $ oldSyntax fields0) pkg - checkForUndefinedFlags flags mlib exes tests + checkForUndefinedFlags flags libs exes tests return $ GenericPackageDescription pkg { sourceRepos = repos, setupBuildInfo = mcsetup } - flags mlib exes tests bms + flags libs exes tests bms where oldSyntax = all isSimpleField @@ -848,17 +847,18 @@ parsePackageDescription file = do _ -> return (reverse acc) -- - -- body ::= { repo | flag | library | executable | test }+ -- at most one lib + -- body ::= { repo | flag | library | executable | test }+ -- -- The body consists of an optional sequence of declarations of flags and - -- an arbitrary number of executables and at most one library. - getBody :: PM ([SourceRepo], [Flag] + -- an arbitrary number of libraries/executables/tests. + getBody :: PackageDescription + -> PM ([SourceRepo], [Flag] ,Maybe SetupBuildInfo - ,Maybe (CondTree ConfVar [Dependency] Library) + ,[(String, CondTree ConfVar [Dependency] Library)] ,[(String, CondTree ConfVar [Dependency] Executable)] ,[(String, CondTree ConfVar [Dependency] TestSuite)] ,[(String, CondTree ConfVar [Dependency] Benchmark)]) - getBody = peekField >>= \mf -> case mf of + getBody pkg = peekField >>= \mf -> case mf of Just (Section line_no sec_type sec_label sec_fields) | sec_type == "executable" -> do when (null sec_label) $ lift $ syntaxError line_no @@ -866,7 +866,7 @@ parsePackageDescription file = do exename <- lift $ runP line_no "executable" parseTokenQ sec_label flds <- collectFields parseExeFields sec_fields skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody + (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg return (repos, flags, csetup, lib, (exename, flds): exes, tests, bms) | sec_type == "test-suite" -> do @@ -907,7 +907,7 @@ parsePackageDescription file = do if checkTestType emptyTestSuite flds then do skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody + (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg return (repos, flags, csetup, lib, exes, (testname, flds) : tests, bms) else lift $ syntaxError line_no $ @@ -955,7 +955,7 @@ parsePackageDescription file = do if checkBenchmarkType emptyBenchmark flds then do skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody + (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg return (repos, flags, csetup, lib, exes, tests, (benchname, flds) : bms) else lift $ syntaxError line_no $ @@ -966,14 +966,15 @@ parsePackageDescription file = do ++ intercalate ", " (map display knownBenchmarkTypes) | sec_type == "library" -> do - unless (null sec_label) $ lift $ - syntaxError line_no "'library' expects no argument" + libname <- if null sec_label + then return (unPackageName (packageName pkg)) + -- TODO: relax this parsing so that scoping is handled + -- correctly + else lift $ runP line_no "library" parseTokenQ sec_label flds <- collectFields parseLibFields sec_fields skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody - when (isJust lib) $ lift $ syntaxError line_no - "There can only be one library section in a package description." - return (repos, flags, csetup, Just flds, exes, tests, bms) + (repos, flags, csetup, libs, exes, tests, bms) <- getBody pkg + return (repos, flags, csetup, (libname, flds) : libs, exes, tests, bms) | sec_type == "flag" -> do when (null sec_label) $ lift $ @@ -984,7 +985,7 @@ parsePackageDescription file = do (MkFlag (FlagName (lowercase sec_label)) "" True False) sec_fields skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody + (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg return (repos, flag:flags, csetup, lib, exes, tests, bms) | sec_type == "source-repository" -> do @@ -1009,7 +1010,7 @@ parsePackageDescription file = do } sec_fields skipField - (repos, flags, csetup, lib, exes, tests, bms) <- getBody + (repos, flags, csetup, lib, exes, tests, bms) <- getBody pkg return (repo:repos, flags, csetup, lib, exes, tests, bms) | sec_type == "custom-setup" -> do @@ -1021,7 +1022,7 @@ parsePackageDescription file = do mempty sec_fields skipField - (repos, flags, csetup0, lib, exes, tests, bms) <- getBody + (repos, flags, csetup0, lib, exes, tests, bms) <- getBody pkg when (isJust csetup0) $ lift $ syntaxError line_no "There can only be one 'custom-setup' section in a package description." return (repos, flags, Just flds, lib, exes, tests, bms) @@ -1029,18 +1030,18 @@ parsePackageDescription file = do | otherwise -> do lift $ warning $ "Ignoring unknown section type: " ++ sec_type skipField - getBody + getBody pkg Just f@(F {}) -> do _ <- lift $ syntaxError (lineNo f) $ "Plain fields are not allowed in between stanzas: " ++ show f skipField - getBody + getBody pkg Just f@(IfBlock {}) -> do _ <- lift $ syntaxError (lineNo f) $ "If-blocks are not allowed in between stanzas: " ++ show f skipField - getBody - Nothing -> return ([], [], Nothing, Nothing, [], [], []) + getBody pkg + Nothing -> return ([], [], Nothing, [], [], [], []) -- Extracts all fields in a block and returns a 'CondTree'. -- @@ -1117,13 +1118,13 @@ parsePackageDescription file = do checkForUndefinedFlags :: [Flag] -> - Maybe (CondTree ConfVar [Dependency] Library) -> + [(String, CondTree ConfVar [Dependency] Library)] -> [(String, CondTree ConfVar [Dependency] Executable)] -> [(String, CondTree ConfVar [Dependency] TestSuite)] -> PM () - checkForUndefinedFlags flags mlib exes tests = do + checkForUndefinedFlags flags libs exes tests = do let definedFlags = map flagName flags - traverse_ (checkCondTreeFlags definedFlags) mlib + mapM_ (checkCondTreeFlags definedFlags . snd) libs mapM_ (checkCondTreeFlags definedFlags . snd) exes mapM_ (checkCondTreeFlags definedFlags . snd) tests @@ -1200,24 +1201,20 @@ deprecField _ = cabalBug "'deprecField' called on a non-field" parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo parseHookedBuildInfo inp = do fields <- readFields inp - let ss@(mLibFields:exes) = stanzas fields - mLib <- parseLib mLibFields - biExes <- mapM parseExe (maybe ss (const exes) mLib) - return (mLib, biExes) + foldM parseStanza ([], []) (stanzas fields) where - parseLib :: [Field] -> ParseResult (Maybe BuildInfo) - parseLib (bi@(F _ inFieldName _:_)) - | lowercase inFieldName /= "executable" = liftM Just (parseBI bi) - parseLib _ = return Nothing - - parseExe :: [Field] -> ParseResult (String, BuildInfo) - parseExe (F line inFieldName mName:bi) + parseStanza :: HookedBuildInfo -> [Field] -> ParseResult HookedBuildInfo + parseStanza (lib_bis, exe_bis) (F line inFieldName mName:bi) | lowercase inFieldName == "executable" = do bis <- parseBI bi - return (mName, bis) - | otherwise = syntaxError line "expecting 'executable' at top of stanza" - parseExe (_:_) = cabalBug "`parseExe' called on a non-field" - parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza" + return (lib_bis, (mName, bis):exe_bis) + | lowercase inFieldName == "library" + = do bis <- parseBI bi + return ((mName, bis):lib_bis, exe_bis) + | otherwise + = syntaxError line "expecting 'executable' or 'library' at top of stanza" + parseStanza _ (_:_) = cabalBug "`parseStanza' called on a non-field" + parseStanza _ [] = syntaxError 0 "error in parsing buildinfo file. Expected stanza" parseBI st = parseFields binfoFieldDescrs storeXFieldsBI emptyBuildInfo st @@ -1233,9 +1230,7 @@ showPackageDescription :: PackageDescription -> String showPackageDescription pkg = render $ ppPackage pkg $$ ppCustomFields (customFieldsPD pkg) - $$ (case library pkg of - Nothing -> empty - Just lib -> ppLibrary lib) + $$ vcat [ space $$ ppLibrary lib | lib <- libraries pkg ] $$ vcat [ space $$ ppExecutable exe | exe <- executables pkg ] where ppPackage = ppFields pkgDescrFieldDescrs @@ -1253,10 +1248,11 @@ writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack . showHookedBuildInfo showHookedBuildInfo :: HookedBuildInfo -> String -showHookedBuildInfo (mb_lib_bi, ex_bis) = render $ - (case mb_lib_bi of - Nothing -> empty - Just bi -> ppBuildInfo bi) +showHookedBuildInfo (lib_bis, ex_bis) = render $ + vcat [ space + $$ text "library:" <+> text name + $$ ppBuildInfo bi + | (name, bi) <- lib_bis ] $$ vcat [ space $$ text "executable:" <+> text name $$ ppBuildInfo bi diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index 3d31b06a70b..297219769a1 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -46,7 +46,8 @@ ppGenericPackageDescription :: GenericPackageDescription -> Doc ppGenericPackageDescription gpd = ppPackageDescription (packageDescription gpd) $+$ ppGenPackageFlags (genPackageFlags gpd) - $+$ ppLibrary (condLibrary gpd) + $+$ ppLibraries (unPackageName (packageName (packageDescription gpd))) + (condLibraries gpd) $+$ ppExecutables (condExecutables gpd) $+$ ppTestSuites (condTestSuites gpd) $+$ ppBenchmarks (condBenchmarks gpd) @@ -106,10 +107,10 @@ ppFlag flag@(MkFlag name _ _ _) = where fields = ppFieldsFiltered flagDefaults flagFieldDescrs flag -ppLibrary :: (Maybe (CondTree ConfVar [Dependency] Library)) -> Doc -ppLibrary Nothing = empty -ppLibrary (Just condTree) = - emptyLine $ text "library" $+$ nest indentWith (ppCondTree condTree Nothing ppLib) +ppLibraries :: String -> [(String, CondTree ConfVar [Dependency] Library)] -> Doc +ppLibraries pn libs = + vcat [emptyLine $ text (if n == pn then "library" else "library " ++ n) + $+$ nest indentWith (ppCondTree condTree Nothing ppLib)| (n,condTree) <- libs] where ppLib lib Nothing = ppFieldsFiltered libDefaults libFieldDescrs lib $$ ppCustomFields (customFieldsBI (libBuildInfo lib)) diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 4571ef6d686..891c8c122e0 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -407,19 +407,23 @@ hookedActionWithArgs pre_hook cmd_hook post_hook get_build_config hooks flags ar post_hook hooks args flags pkg_descr localbuildinfo sanityCheckHookedBuildInfo :: PackageDescription -> HookedBuildInfo -> IO () -sanityCheckHookedBuildInfo PackageDescription { library = Nothing } (Just _,_) - = die $ "The buildinfo contains info for a library, " - ++ "but the package does not have a library." - -sanityCheckHookedBuildInfo pkg_descr (_, hookExes) - | not (null nonExistant) +sanityCheckHookedBuildInfo pkg_descr (hookLibs, hookExes) + | not (null nonExistantLibs) + = die $ "The buildinfo contains info for an library called '" + ++ head nonExistantLibs ++ "' but the package does not have a " + ++ "library with that name." + | not (null nonExistantExes) = die $ "The buildinfo contains info for an executable called '" - ++ head nonExistant ++ "' but the package does not have a " + ++ head nonExistantExes ++ "' but the package does not have a " ++ "executable with that name." where pkgExeNames = nub (map exeName (executables pkg_descr)) hookExeNames = nub (map fst hookExes) - nonExistant = hookExeNames \\ pkgExeNames + nonExistantExes = hookExeNames \\ pkgExeNames + + pkgLibNames = nub (map libName (libraries pkg_descr)) + hookLibNames = nub (map fst hookLibs) + nonExistantLibs = hookLibNames \\ pkgLibNames sanityCheckHookedBuildInfo _ _ = return () diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index e287ead3520..2ebb6c11b49 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -175,7 +175,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes comp@(CLib lib) clbi distPref = do preprocessComponent pkg_descr comp lbi False verbosity suffixes extras <- preprocessExtras comp lbi - info verbosity "Building library..." + info verbosity $ "Building library " ++ libName lib ++ "..." let libbi = libBuildInfo lib lib' = lib { libBuildInfo = addExtraCSources libbi extras } buildLib verbosity numJobs pkg_descr lbi lib' clbi @@ -187,7 +187,7 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr (AbiHash "") lib' lbi clbi - registerPackage verbosity (compiler lbi) (withPrograms lbi) False + registerPackage verbosity (compiler lbi) (withPrograms lbi) True (withPackageDB lbi) installedPkgInfo buildComponent verbosity numJobs pkg_descr lbi suffixes @@ -376,6 +376,7 @@ testSuiteLibV09AsLibAndExe pkg_descr where bi = testBuildInfo test lib = Library { + libName = testName test, exposedModules = [ m ], reexportedModules = [], requiredSignatures = [], @@ -384,28 +385,30 @@ testSuiteLibV09AsLibAndExe pkg_descr libBuildInfo = bi } -- NB: temporary hack; I have a refactor which solves this - cid = computeComponentId (package pkg_descr) + cid = computeComponentId NoFlag + (package pkg_descr) (CTestName (testName test)) (map ((\(SimpleUnitId cid0) -> cid0) . fst) (componentPackageDeps clbi)) (flagAssignment lbi) uid = SimpleUnitId cid - (pkg_name, compat_key) = computeCompatPackageKey + (compat_name, compat_key) = computeCompatPackageKey (compiler lbi) (package pkg_descr) (CTestName (testName test)) uid libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi , componentPackageRenaming = componentPackageRenaming clbi , componentUnitId = uid + , componentCompatPackageName = compat_name , componentCompatPackageKey = compat_key , componentExposedModules = [IPI.ExposedModule m Nothing] } pkg = pkg_descr { - package = (package pkg_descr) { pkgName = pkg_name } + package = (package pkg_descr) { pkgName = compat_name } , buildDepends = targetBuildDepends $ testBuildInfo test , executables = [] , testSuites = [] - , library = Just lib + , libraries = [lib] } ipi = inplaceInstalledPackageInfo pwd distPref pkg (AbiHash "") lib lbi libClbi testDir = buildDir lbi stubName test diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index 704ba1ba7e2..7c397404b46 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -31,7 +31,6 @@ module Distribution.Simple.BuildTarget ( reportBuildTargetProblems, ) where -import Distribution.Package import Distribution.PackageDescription import Distribution.ModuleName import Distribution.Simple.LocalBuildInfo @@ -228,9 +227,9 @@ showUserBuildTarget = intercalate ":" . getComponents getComponents (UserBuildTargetDouble s1 s2) = [s1,s2] getComponents (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3] -showBuildTarget :: QualLevel -> PackageId -> BuildTarget -> String -showBuildTarget ql pkgid bt = - showUserBuildTarget (renderBuildTarget ql bt pkgid) +showBuildTarget :: QualLevel -> BuildTarget -> String +showBuildTarget ql bt = + showUserBuildTarget (renderBuildTarget ql bt) -- ------------------------------------------------------------ @@ -267,7 +266,7 @@ resolveBuildTarget pkg userTarget fexists = Unambiguous target -> Right target Ambiguous targets -> Left (BuildTargetAmbiguous userTarget targets') where targets' = disambiguateBuildTargets - (packageId pkg) userTarget + userTarget targets None errs -> Left (classifyMatchErrors errs) @@ -291,9 +290,9 @@ data BuildTargetProblem deriving Show -disambiguateBuildTargets :: PackageId -> UserBuildTarget -> [BuildTarget] +disambiguateBuildTargets :: UserBuildTarget -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)] -disambiguateBuildTargets pkgid original = +disambiguateBuildTargets original = disambiguate (userTargetQualLevel original) where disambiguate ql ts @@ -312,13 +311,13 @@ disambiguateBuildTargets pkgid original = . partition (\g -> length g > 1) . groupBy (equating fst) . sortBy (comparing fst) - . map (\t -> (renderBuildTarget ql t pkgid, t)) + . map (\t -> (renderBuildTarget ql t, t)) data QualLevel = QL1 | QL2 | QL3 deriving (Enum, Show) -renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget -renderBuildTarget ql target pkgid = +renderBuildTarget :: QualLevel -> BuildTarget -> UserBuildTarget +renderBuildTarget ql target = case ql of QL1 -> UserBuildTargetSingle s1 where s1 = single target QL2 -> UserBuildTargetDouble s1 s2 where (s1, s2) = double target @@ -337,7 +336,7 @@ renderBuildTarget ql target pkgid = triple (BuildTargetModule cn m) = (dispKind cn, dispCName cn, display m) triple (BuildTargetFile cn f) = (dispKind cn, dispCName cn, f) - dispCName = componentStringName pkgid + dispCName = componentStringName dispKind = showComponentKindShort . componentKind reportBuildTargetProblems :: [BuildTargetProblem] -> IO () @@ -440,7 +439,7 @@ pkgComponentInfo :: PackageDescription -> [ComponentInfo] pkgComponentInfo pkg = [ ComponentInfo { cinfoName = componentName c, - cinfoStrName = componentStringName pkg (componentName c), + cinfoStrName = componentStringName (componentName c), cinfoSrcDirs = hsSourceDirs bi, cinfoModules = componentModules c, cinfoHsFiles = componentHsFiles c, @@ -450,11 +449,11 @@ pkgComponentInfo pkg = | c <- pkgComponents pkg , let bi = componentBuildInfo c ] -componentStringName :: Package pkg => pkg -> ComponentName -> ComponentStringName -componentStringName pkg CLibName = display (packageName pkg) -componentStringName _ (CExeName name) = name -componentStringName _ (CTestName name) = name -componentStringName _ (CBenchName name) = name +componentStringName :: ComponentName -> ComponentStringName +componentStringName (CLibName name) = name +componentStringName (CExeName name) = name +componentStringName (CTestName name) = name +componentStringName (CBenchName name) = name componentModules :: Component -> [ModuleName] componentModules (CLib lib) = libModules lib @@ -494,8 +493,8 @@ data ComponentKind = LibKind | ExeKind | TestKind | BenchKind deriving (Eq, Ord, Show) componentKind :: ComponentName -> ComponentKind -componentKind CLibName = LibKind -componentKind (CExeName _) = ExeKind +componentKind (CLibName _) = LibKind +componentKind (CExeName _) = ExeKind componentKind (CTestName _) = TestKind componentKind (CBenchName _) = BenchKind diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index c295c4f91c6..06276e634c3 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -752,17 +752,22 @@ checkExactConfiguration pkg_descr0 cfg = do getInternalPackages :: GenericPackageDescription -> InstalledPackageIndex getInternalPackages pkg_descr0 = - let pid :: PackageIdentifier -- e.g. foo-0.1 - pid = packageId pkg_descr0 - internalPackage = emptyInstalledPackageInfo { + let pkg_descr = flattenPackageDescription pkg_descr0 + mkInternalPackage lib = emptyInstalledPackageInfo { --TODO: should use a per-compiler method to map the source -- package ID into an installed package id we can use - -- for the internal package set. The use of - -- mkLegacyUnitId here is a hack. - Installed.installedUnitId = mkLegacyUnitId pid, - Installed.sourcePackageId = pid + -- for the internal package set. What we do here + -- is skeevy, but we're highly unlikely to accidentally + -- shadow something legitimate. + Installed.installedUnitId = mkUnitId (libName lib), + -- NB: we TEMPORARILY set the package name to be the + -- library name. When we actually register, it won't + -- look like this; this is just so that internal + -- build-depends get resolved correctly. + Installed.sourcePackageId = PackageIdentifier (PackageName (libName lib)) + (pkgVersion (package pkg_descr)) } - in PackageIndex.fromList [internalPackage] + in PackageIndex.fromList (map mkInternalPackage (libraries pkg_descr)) -- | Returns true if a dependency is satisfiable. This is to be passed @@ -796,7 +801,8 @@ dependencySatisfiable -- package index. not . null . PackageIndex.lookupDependency pkgs $ d where - pkgs = PackageIndex.merge internalPackageSet installedPackageSet + -- NB: Prefer the INTERNAL package set + pkgs = PackageIndex.merge installedPackageSet internalPackageSet isInternalDep = not . null $ PackageIndex.lookupDependency internalPackageSet d @@ -886,7 +892,7 @@ configureFinalizedPackage verbosity cfg `mappend` extraBi } modifyExecutable e = e{ buildInfo = buildInfo e `mappend` extraBi} - in pkg_descr{ library = modifyLib `fmap` library pkg_descr + in pkg_descr{ libraries = modifyLib `map` libraries pkg_descr , executables = modifyExecutable `map` executables pkg_descr} @@ -901,7 +907,7 @@ checkCompilerProblems comp pkg_descr = do ++ "package flags. To use this feature you probably must use " ++ "GHC 7.9 or later." - when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr) + when (any (not.null.PD.reexportedModules) (PD.libraries pkg_descr) && not (reexportedModulesSupported comp)) $ do die $ "Your compiler does not support module re-exports. To use " ++ "this feature you probably must use GHC 7.9 or later." @@ -1229,11 +1235,11 @@ configurePkgconfigPackages verbosity pkg_descr conf (lessVerbose verbosity) pkgConfigProgram (orLaterVersion $ Version [0,9,0] []) conf mapM_ requirePkg allpkgs - lib' <- mapM addPkgConfigBILib (library pkg_descr) + libs' <- mapM addPkgConfigBILib (libraries pkg_descr) exes' <- mapM addPkgConfigBIExe (executables pkg_descr) tests' <- mapM addPkgConfigBITest (testSuites pkg_descr) benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr) - let pkg_descr' = pkg_descr { library = lib', executables = exes', + let pkg_descr' = pkg_descr { libraries = libs', executables = exes', testSuites = tests', benchmarks = benches' } return (pkg_descr', conf') @@ -1387,7 +1393,8 @@ mkComponentsGraph pkg_descr internalPkgDeps = , toolname `elem` map exeName (executables pkg_descr) ] - ++ [ CLibName | Dependency pkgname _ <- targetBuildDepends bi + ++ [ CLibName toolname | Dependency pkgname@(PackageName toolname) _ + <- targetBuildDepends bi , pkgname `elem` map packageName internalPkgDeps ] where bi = componentBuildInfo component @@ -1402,13 +1409,15 @@ reportComponentCycle cnames = -- | This method computes a default, "good enough" 'ComponentId' -- for a package. The intent is that cabal-install (or the user) will -- specify a more detailed IPID via the @--ipid@ flag if necessary. -computeComponentId :: PackageIdentifier - -> ComponentName - -- TODO: careful here! - -> [ComponentId] -- IPIDs of the component dependencies - -> FlagAssignment - -> ComponentId -computeComponentId pid cname dep_ipids flagAssignment = do +computeComponentId + :: Flag String + -> PackageIdentifier + -> ComponentName + -- TODO: careful here! + -> [ComponentId] -- IPIDs of the component dependencies + -> FlagAssignment + -> ComponentId +computeComponentId mb_explicit pid cname dep_ipids flagAssignment = do -- show is found to be faster than intercalate and then replacement of -- special character used in intercalating. We cannot simply hash by -- doubly concating list, as it just flatten out the nested list, so @@ -1417,16 +1426,25 @@ computeComponentId pid cname dep_ipids flagAssignment = do -- For safety, include the package + version here -- for GHC 7.10, where just the hash is used as -- the package key - (display pid) - ++ (show $ dep_ipids) + display pid + ++ show dep_ipids ++ show flagAssignment - ComponentId $ - display pid - ++ "-" ++ hash + generated_base = display pid ++ "-" ++ hash + explicit_base cid0 = fromPathTemplate (InstallDirs.substPathTemplate env + (toPathTemplate cid0)) + -- Hack to reuse install dirs machinery + -- NB: no real IPID available at this point + where env = packageTemplateEnv pid (mkUnitId "") + actual_base = case mb_explicit of + Flag cid0 -> explicit_base cid0 + NoFlag -> generated_base + ComponentId $ actual_base ++ (case cname of - CLibName -> "" -- TODO: these could result in non-parseable IPIDs -- since the component name format is very flexible + CLibName s + | s == display (pkgName pid) -> "" + | otherwise -> "-" ++ s ++ ".lib" CExeName s -> "-" ++ s ++ ".exe" CTestName s -> "-" ++ s ++ ".test" CBenchName s -> "-" ++ s ++ ".bench") @@ -1512,17 +1530,17 @@ computeCompatPackageKey comp pid cname uid@(SimpleUnitId (ComponentId str)) go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r) go (c:z) _ r = go z Nothing (c:r) cname_str = case cname of - CLibName -> error "computeCompatPackageKey" + CLibName n -> "-z-lib-" ++ zdashcode n CTestName n -> "-z-test-" ++ zdashcode n CBenchName n -> "-z-bench-" ++ zdashcode n CExeName n -> "-z-exe-" ++ zdashcode n package_name - | cname == CLibName = pkgName pid + | cname == defaultLibName pid = pkgName pid | otherwise = PackageName $ "z-" ++ zdashcode (display (pkgName pid)) ++ zdashcode cname_str old_style_key - | cname == CLibName = display pid + | cname == defaultLibName pid = display pid | otherwise = display package_name ++ "-" ++ display (pkgVersion pid) in (package_name, old_style_key) @@ -1544,6 +1562,19 @@ computeCompatPackageKey comp pid cname uid@(SimpleUnitId (ComponentId str)) (mb_verbatim_key `mplus` mb_truncated_key)) | otherwise = (pkgName pid, display uid) +{- +mkComponentIds :: PackageDescription + -> [InstalledPackageInfo] + -> FlagAssignment + -> [(Component, [ComponentName])] + -> [(Component, ComponentId, [ComponentName])] + +mkComponentIds pkg_descr externalPkgDeps flagAssignment graph0 = go graph0 [] + where + pid = package pkg_descr + go ((comp, cdeps):graph) r = go ((comp, mkComponentId comp r, cdeps):r) +-} + mkComponentsLocalBuildInfo :: ConfigFlags -> Compiler -> InstalledPackageIndex @@ -1556,48 +1587,24 @@ mkComponentsLocalBuildInfo :: ConfigFlags [ComponentName])] mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr internalPkgDeps externalPkgDeps - graph flagAssignment = do - -- Pre-compute library hash so we can setup internal deps - -- TODO configIPID should have name changed - let cid = case configIPID cfg of - Flag cid0 -> - -- Hack to reuse install dirs machinery - -- NB: no real IPID available at this point - let env = packageTemplateEnv (package pkg_descr) - (mkUnitId "") - str = fromPathTemplate - (InstallDirs.substPathTemplate env - (toPathTemplate cid0)) - in ComponentId str - _ -> - computeComponentId (package pkg_descr) CLibName - (getDeps CLibName) flagAssignment - uid = SimpleUnitId cid - (_, compat_key) = computeCompatPackageKey comp - (package pkg_descr) CLibName uid - sequence - [ do clbi <- componentLocalBuildInfo uid compat_key c - return (componentName c, clbi, cdeps) - | (c, cdeps) <- graph ] + graph flagAssignment = + foldM (wrap componentLocalBuildInfo) [] graph where - getDeps cname = - let externalPkgs = maybe [] (\lib -> selectSubset - (componentBuildInfo lib) - externalPkgDeps) - (lookupComponent pkg_descr cname) - in map Installed.installedComponentId externalPkgs + wrap f z (component, cdeps) = do + clbi <- f z component + return ((componentName component, clbi, cdeps):z) -- The allPkgDeps contains all the package deps for the whole package -- but we need to select the subset for this specific component. -- we just take the subset for the package names this component -- needs. Note, this only works because we cannot yet depend on two -- versions of the same package. - componentLocalBuildInfo uid compat_key component = + componentLocalBuildInfo internalComps component = case component of CLib lib -> do let exports = map (\n -> Installed.ExposedModule n Nothing) (PD.exposedModules lib) - let mb_reexports = resolveModuleReexports installedPackages + mb_reexports = resolveModuleReexports installedPackages (packageId pkg_descr) uid externalPkgDeps lib @@ -1609,6 +1616,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr componentPackageDeps = cpds, componentUnitId = uid, componentCompatPackageKey = compat_key, + componentCompatPackageName = compat_name, componentPackageRenaming = cprns, componentExposedModules = exports ++ reexports } @@ -1628,26 +1636,45 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr componentPackageRenaming = cprns } where + -- TODO: this should include internal deps too + getDeps cname = + let externalPkgs + = maybe [] (\lib -> selectSubset (componentBuildInfo lib) + externalPkgDeps) + (lookupComponent pkg_descr cname) + in map Installed.installedComponentId externalPkgs + + -- TODO configIPID should have name changed + cid = computeComponentId (configIPID cfg) (package pkg_descr) + (componentName component) + (getDeps (componentName component)) + flagAssignment + uid = SimpleUnitId cid + (compat_name, compat_key) + = computeCompatPackageKey comp + (package pkg_descr) (componentName component) uid + bi = componentBuildInfo component dedup = Map.toList . Map.fromList + lookupInternalPkg pkgid = do + let matcher (CLibName str, clbi, _) + | str == display (pkgName pkgid) + = Just (componentUnitId clbi) + matcher _ = Nothing + case catMaybes (map matcher internalComps) of + [x] -> x + _ -> error "lookupInternalPkg" cpds = if newPackageDepsBehaviour pkg_descr then dedup $ [ (Installed.installedUnitId pkg, packageId pkg) | pkg <- selectSubset bi externalPkgDeps ] - ++ [ (uid, pkgid) + ++ [ (lookupInternalPkg pkgid, pkgid) | pkgid <- selectSubset bi internalPkgDeps ] else [ (Installed.installedUnitId pkg, packageId pkg) | pkg <- externalPkgDeps ] cprns = if newPackageDepsBehaviour pkg_descr then targetBuildRenaming bi - -- Hack: if we have old package-deps behavior, it's impossible - -- for non-default renamings to be used, because the Cabal - -- version is too early. This is a good, because while all the - -- deps were bundled up in buildDepends, we didn't do this for - -- renamings, so it's not even clear how to get the merged - -- version. So just assume that all of them are the default.. - else Map.fromList (map (\(_,pid) -> - (packageName pid, defaultRenaming)) cpds) + else Map.empty selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg] selectSubset bi pkgs = diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 1091ee4bdff..07061f9f115 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -474,10 +474,8 @@ buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do - let libName = componentUnitId clbi - libTargetDir - | componentUnitId clbi == localUnitId lbi = buildDir lbi - | otherwise = buildDir lbi display libName + let uid = componentUnitId clbi + libTargetDir = libBuildDir lbi clbi whenVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi) whenProfLib = when (withProfLib lbi) @@ -506,13 +504,15 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do -- Determine if program coverage should be enabled and if so, what -- '-hpcdir' should be. let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi - -- Component name. Not 'libName' because that has the "HS" prefix - -- that GHC gives Haskell libraries. - cname = display $ PD.package $ localPkgDescr lbi + -- TODO: Historically HPC files have been put into a directory which + -- has the package name. I'm going to avoid changing this for + -- now, but it would probably be better for this to be the + -- component ID instead... + pkg_name = display $ PD.package $ localPkgDescr lbi distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way | forRepl = Mon.mempty -- HPC is not supported in ghci - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name | otherwise = mempty createDirectoryIfMissingVerbose verbosity True libTargetDir @@ -646,13 +646,13 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do (cSources libBi) cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi) - cid = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName libName - profileLibFilePath = libTargetDir mkProfLibName libName - sharedLibFilePath = libTargetDir mkSharedLibName cid libName - ghciLibFilePath = libTargetDir Internal.mkGHCiLibName libName + compiler_id = compilerId (compiler lbi) + vanillaLibFilePath = libTargetDir mkLibName uid + profileLibFilePath = libTargetDir mkProfLibName uid + sharedLibFilePath = libTargetDir mkSharedLibName compiler_id uid + ghciLibFilePath = libTargetDir Internal.mkGHCiLibName uid libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest - sharedLibInstallPath = libInstallPath mkSharedLibName cid libName + sharedLibInstallPath = libInstallPath mkSharedLibName compiler_id uid stubObjs <- catMaybes <$> sequence [ findFileWithExtension [objExtension] [libTargetDir] @@ -1038,7 +1038,7 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do comp = compiler lbi platform = hostPlatform lbi vanillaArgs = - (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi)) + (componentGhcOptions verbosity lbi libBi clbi (libBuildDir lbi clbi)) `mappend` mempty { ghcOptMode = toFlag GhcModeAbiHash, ghcOptInputModules = toNubListR $ exposedModules lib @@ -1121,7 +1121,7 @@ installLib :: Verbosity -> Library -> ComponentLocalBuildInfo -> IO () -installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do +installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do -- copy .hi files over: whenVanilla $ copyModuleFiles "hi" whenProf $ copyModuleFiles "p_hi" @@ -1134,6 +1134,8 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do whenShared $ installShared builtDir dynlibTargetDir sharedLibName where + builtDir = libBuildDir lbi clbi + install isShared srcDir dstDir name = do let src = srcDir name dst = dstDir name @@ -1153,12 +1155,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do findModuleFiles [builtDir] [ext] (libModules lib) >>= installOrdinaryFiles verbosity targetDir - cid = compilerId (compiler lbi) - libName = componentUnitId clbi - vanillaLibName = mkLibName libName - profileLibName = mkProfLibName libName - ghciLibName = Internal.mkGHCiLibName libName - sharedLibName = (mkSharedLibName cid) libName + compiler_id = compilerId (compiler lbi) + uid = componentUnitId clbi + vanillaLibName = mkLibName uid + profileLibName = mkProfLibName uid + ghciLibName = Internal.mkGHCiLibName uid + sharedLibName = (mkSharedLibName compiler_id) uid hasLib = not $ null (libModules lib) && null (cSources (libBuildInfo lib)) diff --git a/Cabal/Distribution/Simple/GHCJS.hs b/Cabal/Distribution/Simple/GHCJS.hs index b7ec20190f8..da7a5fcbdf9 100644 --- a/Cabal/Distribution/Simple/GHCJS.hs +++ b/Cabal/Distribution/Simple/GHCJS.hs @@ -266,7 +266,7 @@ buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int) -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do - let libName = componentUnitId clbi + let uid = componentUnitId clbi libTargetDir = buildDir lbi whenVanillaLib forceVanilla = when (not forRepl && (forceVanilla || withVanillaLib lbi)) @@ -293,12 +293,10 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do -- Determine if program coverage should be enabled and if so, what -- '-hpcdir' should be. let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi - -- Component name. Not 'libName' because that has the "HS" prefix - -- that GHC gives Haskell libraries. - cname = display $ PD.package $ localPkgDescr lbi + pkg_name = display $ PD.package $ localPkgDescr lbi distPref = fromFlag $ configDistPref $ configFlags lbi hpcdir way - | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname + | isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name | otherwise = Mon.mempty createDirectoryIfMissingVerbose verbosity True libTargetDir @@ -309,7 +307,7 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir linkJsLibOpts = mempty { ghcOptExtra = toNubListR $ - [ "-link-js-lib" , getHSLibraryName libName + [ "-link-js-lib" , getHSLibraryName uid , "-js-lib-outputdir", libTargetDir ] ++ concatMap (\x -> ["-js-lib-src",x]) jsSrcs } @@ -423,11 +421,11 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do (cSources libBi) cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi) - cid = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName libName - profileLibFilePath = libTargetDir mkProfLibName libName - sharedLibFilePath = libTargetDir mkSharedLibName cid libName - ghciLibFilePath = libTargetDir Internal.mkGHCiLibName libName + compiler_id = compilerId (compiler lbi) + vanillaLibFilePath = libTargetDir mkLibName uid + profileLibFilePath = libTargetDir mkProfLibName uid + sharedLibFilePath = libTargetDir mkSharedLibName compiler_id uid + ghciLibFilePath = libTargetDir Internal.mkGHCiLibName uid hObjs <- Internal.getHaskellObjects implInfo lib lbi libTargetDir objExtension True @@ -724,12 +722,12 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do findModuleFiles [builtDir] [ext] (libModules lib) >>= installOrdinaryFiles verbosity targetDir - cid = compilerId (compiler lbi) - libName = componentUnitId clbi - vanillaLibName = mkLibName libName - profileLibName = mkProfLibName libName - ghciLibName = Internal.mkGHCiLibName libName - sharedLibName = (mkSharedLibName cid) libName + compiler_id = compilerId (compiler lbi) + uid = componentUnitId clbi + vanillaLibName = mkLibName uid + profileLibName = mkProfLibName uid + ghciLibName = Internal.mkGHCiLibName uid + sharedLibName = (mkSharedLibName compiler_id) uid hasLib = not $ null (libModules lib) && null (cSources (libBuildInfo lib)) diff --git a/Cabal/Distribution/Simple/Install.hs b/Cabal/Distribution/Simple/Install.hs index b3d5bcbfc6d..20ba705307a 100644 --- a/Cabal/Distribution/Simple/Install.hs +++ b/Cabal/Distribution/Simple/Install.hs @@ -169,23 +169,21 @@ installDataFiles verbosity pkg_descr destDataDir = -- | Install the files listed in install-includes -- installIncludeFiles :: Verbosity -> PackageDescription -> FilePath -> IO () -installIncludeFiles verbosity - PackageDescription { library = Just lib } destIncludeDir = do - - incs <- mapM (findInc relincdirs) (installIncludes lbi) - sequence_ - [ do createDirectoryIfMissingVerbose verbosity True destDir - installOrdinaryFile verbosity srcFile destFile - | (relFile, srcFile) <- incs - , let destFile = destIncludeDir relFile - destDir = takeDirectory destFile ] +installIncludeFiles verbosity pkg destIncludeDir = do + withLib pkg $ \lib -> do + let relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi) + lbi = libBuildInfo lib + incs <- mapM (findInc relincdirs) (installIncludes lbi) + sequence_ + [ do createDirectoryIfMissingVerbose verbosity True destDir + installOrdinaryFile verbosity srcFile destFile + | (relFile, srcFile) <- incs + , let destFile = destIncludeDir relFile + destDir = takeDirectory destFile ] where - relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi) - lbi = libBuildInfo lib findInc [] file = die ("can't find include file " ++ file) findInc (dir:dirs) file = do let path = dir file exists <- doesFileExist path if exists then return (file, path) else findInc dirs file -installIncludeFiles _ _ _ = die "installIncludeFiles: Can't happen?" diff --git a/Cabal/Distribution/Simple/JHC.hs b/Cabal/Distribution/Simple/JHC.hs index f19255c4cae..3c6e8b4c2eb 100644 --- a/Cabal/Distribution/Simple/JHC.hs +++ b/Cabal/Distribution/Simple/JHC.hs @@ -40,7 +40,6 @@ import Distribution.System ( Platform ) import Data.List ( nub ) import Data.Char ( isSpace ) import qualified Data.Map as M ( empty ) -import Data.Maybe ( fromMaybe ) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -155,7 +154,10 @@ constructJHCCmdLine lbi bi clbi _odir verbosity = jhcPkgConf :: PackageDescription -> String jhcPkgConf pd = let sline name sel = name ++ ": "++sel pd - lib = fromMaybe (error "no library available") . library + lib pd' = case libraries pd' of + [lib'] -> lib' + [] -> error "no library available" + _ -> error "JHC does not support multiple libraries (yet)" comma = intercalate "," . map display in unlines [sline "name" (display . pkgName . packageId) ,sline "version" (display . pkgVersion . packageId) diff --git a/Cabal/Distribution/Simple/LHC.hs b/Cabal/Distribution/Simple/LHC.hs index 4e31a0f6012..fe988988583 100644 --- a/Cabal/Distribution/Simple/LHC.hs +++ b/Cabal/Distribution/Simple/LHC.hs @@ -119,13 +119,13 @@ configureToolchain lhcProg = programPostConf = configureGcc } . addKnownProgram ldProgram { - programFindLocation = findProg ldProgram (libDir "ld.exe"), + programFindLocation = findProg ldProgram (gccLibDir "ld.exe"), programPostConf = configureLd } where compilerDir = takeDirectory (programPath lhcProg) baseDir = takeDirectory compilerDir - libDir = baseDir "gcc-lib" + gccLibDir = baseDir "gcc-lib" includeDir = baseDir "include" "mingw" isWindows = case buildOS of Windows -> True; _ -> False @@ -148,7 +148,7 @@ configureToolchain lhcProg = -- that means we should add this extra flag to tell ghc's gcc -- where it lives and thus where gcc can find its various files: FoundOnSystem {} -> return gccProg { - programDefaultArgs = ["-B" ++ libDir, + programDefaultArgs = ["-B" ++ gccLibDir, "-I" ++ includeDir] } UserSpecified {} -> return gccProg @@ -289,8 +289,8 @@ substTopDir topDir ipo buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> ComponentLocalBuildInfo -> IO () buildLib verbosity pkg_descr lbi lib clbi = do - let libName = componentUnitId clbi - pref = buildDir lbi + let lib_name = componentUnitId clbi + pref = libBuildDir lbi clbi pkgid = packageId pkg_descr runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi) ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi) @@ -344,10 +344,10 @@ buildLib verbosity pkg_descr lbi lib clbi = do let cObjs = map (`replaceExtension` objExtension) (cSources libBi) cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension)) (cSources libBi) cid = compilerId (compiler lbi) - vanillaLibFilePath = libTargetDir mkLibName libName - profileLibFilePath = libTargetDir mkProfLibName libName - sharedLibFilePath = libTargetDir mkSharedLibName cid libName - ghciLibFilePath = libTargetDir mkGHCiLibName libName + vanillaLibFilePath = libTargetDir mkLibName lib_name + profileLibFilePath = libTargetDir mkProfLibName lib_name + sharedLibFilePath = libTargetDir mkSharedLibName cid lib_name + ghciLibFilePath = libTargetDir mkGHCiLibName lib_name stubObjs <- fmap catMaybes $ sequence [ findFileWithExtension [objExtension] [libTargetDir] @@ -426,7 +426,7 @@ buildLib verbosity pkg_descr lbi lib clbi = do -- This method is called iteratively by xargs. The -- output goes to .tmp, and any existing file -- named is included when linking. The - -- output is renamed to . + -- output is renamed to . rawSystemProgramConf verbosity ldProgram (withPrograms lbi) (args ++ if exists then [ldLibName] else []) renameFile (ldLibName <.> "tmp") ldLibName @@ -496,7 +496,7 @@ buildExe verbosity _pkg_descr lbi ++ [srcMainFile] ++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi] ++ ["-l"++lib | lib <- extraLibs exeBi] - ++ ["-L"++libDir | libDir <- extraLibDirs exeBi] + ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs exeBi] ++ concat [["-framework", f] | f <- PD.frameworks exeBi] ++ if profExe then ["-prof", @@ -728,11 +728,11 @@ installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do where cid = compilerId (compiler lbi) - libName = componentUnitId clbi - vanillaLibName = mkLibName libName - profileLibName = mkProfLibName libName - ghciLibName = mkGHCiLibName libName - sharedLibName = mkSharedLibName cid libName + lib_name = componentUnitId clbi + vanillaLibName = mkLibName lib_name + profileLibName = mkProfLibName lib_name + ghciLibName = mkGHCiLibName lib_name + sharedLibName = mkSharedLibName cid lib_name hasLib = not $ null (libModules lib) && null (cSources (libBuildInfo lib)) diff --git a/Cabal/Distribution/Simple/LocalBuildInfo.hs b/Cabal/Distribution/Simple/LocalBuildInfo.hs index 43efe8663a8..665a913be33 100644 --- a/Cabal/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/Distribution/Simple/LocalBuildInfo.hs @@ -27,8 +27,10 @@ module Distribution.Simple.LocalBuildInfo ( -- * Buildable package components Component(..), ComponentName(..), + defaultLibName, showComponentName, ComponentLocalBuildInfo(..), + libBuildDir, foldComponent, componentName, componentBuildInfo, @@ -39,6 +41,8 @@ module Distribution.Simple.LocalBuildInfo ( pkgEnabledComponents, lookupComponent, getComponent, + maybeGetDefaultLibraryLocalBuildInfo, + maybeGetComponentLocalBuildInfo, getComponentLocalBuildInfo, allComponentsInBuildOrder, componentsInBuildOrder, @@ -82,6 +86,7 @@ import Data.Maybe import Data.Tree (flatten) import GHC.Generics (Generic) import Data.Map (Map) +import System.FilePath import System.Directory (doesDirectoryExist, canonicalizePath) @@ -151,21 +156,21 @@ localComponentId lbi -- 'LocalBuildInfo' if it exists, or make a fake unit ID based on -- the package ID. localUnitId :: LocalBuildInfo -> UnitId -localUnitId lbi = - foldr go (mkLegacyUnitId (package (localPkgDescr lbi))) (componentsConfigs lbi) - where go (_, clbi, _) old_uid = case clbi of - LibComponentLocalBuildInfo { componentUnitId = uid } -> uid - _ -> old_uid +localUnitId lbi + = case maybeGetDefaultLibraryLocalBuildInfo lbi of + Just LibComponentLocalBuildInfo { componentUnitId = uid } -> uid + -- Something fake: + _ -> mkLegacyUnitId (package (localPkgDescr lbi)) -- | Extract the compatibility 'ComponentId' from the library component of a -- 'LocalBuildInfo' if it exists, or make a fake compatibility package -- key based on the package ID. localCompatPackageKey :: LocalBuildInfo -> String localCompatPackageKey lbi = - foldr go (display (package (localPkgDescr lbi))) (componentsConfigs lbi) - where go (_, clbi, _) old_pk = case clbi of - LibComponentLocalBuildInfo { componentCompatPackageKey = pk } -> pk - _ -> old_pk + case maybeGetDefaultLibraryLocalBuildInfo lbi of + Just LibComponentLocalBuildInfo { componentCompatPackageKey = pk } -> pk + -- Something fake: + _ -> display (package (localPkgDescr lbi)) -- | External package dependencies for the package as a whole. This is the -- union of the individual 'componentPackageDeps', less any internal deps. @@ -190,16 +195,20 @@ data Component = CLib Library | CBench Benchmark deriving (Show, Eq, Read) -data ComponentName = CLibName -- currently only a single lib +-- Libraries live in a separate namespace, so must distinguish +data ComponentName = CLibName String | CExeName String | CTestName String | CBenchName String deriving (Eq, Generic, Ord, Read, Show) +defaultLibName :: PackageIdentifier -> ComponentName +defaultLibName pid = CLibName (display (pkgName pid)) + instance Binary ComponentName showComponentName :: ComponentName -> String -showComponentName CLibName = "library" +showComponentName (CLibName name) = "library '" ++ name ++ "'" showComponentName (CExeName name) = "executable '" ++ name ++ "'" showComponentName (CTestName name) = "test suite '" ++ name ++ "'" showComponentName (CBenchName name) = "benchmark '" ++ name ++ "'" @@ -213,6 +222,7 @@ data ComponentLocalBuildInfo componentPackageDeps :: [(UnitId, PackageId)], componentUnitId :: UnitId, componentCompatPackageKey :: String, + componentCompatPackageName :: PackageName, componentExposedModules :: [Installed.ExposedModule], componentPackageRenaming :: Map PackageName ModuleRenaming } @@ -232,6 +242,11 @@ data ComponentLocalBuildInfo instance Binary ComponentLocalBuildInfo +libBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath +libBuildDir lbi clbi + | componentUnitId clbi == localUnitId lbi = buildDir lbi + | otherwise = buildDir lbi display (componentUnitId clbi) + foldComponent :: (Library -> a) -> (Executable -> a) -> (TestSuite -> a) @@ -249,7 +264,7 @@ componentBuildInfo = componentName :: Component -> ComponentName componentName = - foldComponent (const CLibName) + foldComponent (CLibName . libName) (CExeName . exeName) (CTestName . testName) (CBenchName . benchmarkName) @@ -258,7 +273,7 @@ componentName = -- pkgComponents :: PackageDescription -> [Component] pkgComponents pkg = - [ CLib lib | Just lib <- [library pkg] ] + [ CLib lib | lib <- libraries pkg ] ++ [ CExe exe | exe <- executables pkg ] ++ [ CTest tst | tst <- testSuites pkg ] ++ [ CBench bm | bm <- benchmarks pkg ] @@ -291,8 +306,8 @@ componentDisabledReason (CBench bm) componentDisabledReason _ = Nothing lookupComponent :: PackageDescription -> ComponentName -> Maybe Component -lookupComponent pkg CLibName = - fmap CLib $ library pkg +lookupComponent pkg (CLibName name) = + fmap CLib $ find ((name ==) . libName) (libraries pkg) lookupComponent pkg (CExeName name) = fmap CExe $ find ((name ==) . exeName) (executables pkg) lookupComponent pkg (CTestName name) = @@ -314,16 +329,28 @@ getComponent pkg cname = getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo getComponentLocalBuildInfo lbi cname = + case maybeGetComponentLocalBuildInfo lbi cname of + Just clbi -> clbi + Nothing -> + error $ "internal error: there is no configuration data " + ++ "for component " ++ show cname + +maybeGetComponentLocalBuildInfo + :: LocalBuildInfo -> ComponentName -> Maybe ComponentLocalBuildInfo +maybeGetComponentLocalBuildInfo lbi cname = case [ clbi | (cname', clbi, _) <- componentsConfigs lbi , cname == cname' ] of - [clbi] -> clbi - _ -> missingComponent + [clbi] -> Just clbi + _ -> Nothing + +maybeGetDefaultLibraryLocalBuildInfo + :: LocalBuildInfo + -> Maybe ComponentLocalBuildInfo +maybeGetDefaultLibraryLocalBuildInfo lbi = + maybeGetComponentLocalBuildInfo lbi (CLibName pkg_name) where - missingComponent = - error $ "internal error: there is no configuration data " - ++ "for component " ++ show cname - + pkg_name = display (pkgName (package (localPkgDescr lbi))) -- |If the package description has a library section, call the given -- function with the library build info as argument. Extended version of @@ -332,7 +359,7 @@ withLibLBI :: PackageDescription -> LocalBuildInfo -> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO () withLibLBI pkg_descr lbi f = withLib pkg_descr $ \lib -> - f lib (getComponentLocalBuildInfo lbi CLibName) + f lib (getComponentLocalBuildInfo lbi (CLibName (libName lib))) -- | Perform the action on each buildable 'Executable' in the package -- description. Extended version of 'withExe' that also gives corresponding diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index d1bd0abcdbc..01e27b693cd 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -82,11 +82,17 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8 register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () -register pkg@PackageDescription { library = Just lib } lbi regFlags +register pkg lbi regFlags = withLib pkg (registerOne pkg lbi regFlags) + +registerOne :: PackageDescription -> LocalBuildInfo -> RegisterFlags + -> Library + -> IO () +registerOne pkg lbi regFlags lib = do - let clbi = getComponentLocalBuildInfo lbi CLibName + let clbi = getComponentLocalBuildInfo lbi (CLibName (libName lib)) absPackageDBs <- absolutePackageDBPaths packageDbs + -- TODO: registration info named base on LIBNAME!!! installedPkgInfo <- generateRegistrationInfo verbosity pkg lib lbi clbi inplace reloc distPref (registrationPackageDB absPackageDBs) @@ -133,10 +139,6 @@ register pkg@PackageDescription { library = Just lib } lbi regFlags (compiler lbi) (withPrograms lbi) (writeHcPkgRegisterScript verbosity installedPkgInfo packageDbs) -register _ _ regFlags = notice verbosity "No package to register" - where - verbosity = fromFlag (regVerbosity regFlags) - generateRegistrationInfo :: Verbosity -> PackageDescription @@ -302,7 +304,9 @@ generalInstalledPackageInfo -> InstalledPackageInfo generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDirs = IPI.InstalledPackageInfo { - IPI.sourcePackageId = packageId pkg, + IPI.sourcePackageId = (packageId pkg) { + pkgName = componentCompatPackageName clbi + }, IPI.installedUnitId = componentUnitId clbi, IPI.compatPackageKey = componentCompatPackageKey clbi, IPI.license = license pkg, @@ -371,9 +375,7 @@ inplaceInstalledPackageInfo inplaceDir distPref pkg abi_hash lib lbi clbi = pkg abi_hash lib lbi clbi installDirs where adjustRelativeIncludeDirs = map (inplaceDir ) - libTargetDir - | componentUnitId clbi == localUnitId lbi = buildDir lbi - | otherwise = buildDir lbi display (componentUnitId clbi) + libTargetDir = libBuildDir lbi clbi installDirs = (absoluteInstallDirs pkg lbi NoCopyDest) { libdir = inplaceDir libTargetDir, diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs index a2feafd9b1f..9e13cac7d59 100644 --- a/Cabal/Distribution/Simple/SrcDist.hs +++ b/Cabal/Distribution/Simple/SrcDist.hs @@ -153,7 +153,8 @@ listPackageSourcesOrdinary verbosity pkg_descr pps = fmap concat . sequence $ [ -- Library sources. - withAllLib $ \Library { exposedModules = modules, libBuildInfo = libBi } -> + fmap concat + . withAllLib $ \Library { exposedModules = modules, libBuildInfo = libBi } -> allSourcesBuildInfo libBi pps modules -- Executables sources. @@ -213,7 +214,8 @@ listPackageSourcesOrdinary verbosity pkg_descr pps = , return (licenseFiles pkg_descr) -- Install-include files. - , withAllLib $ \ l -> do + , fmap concat + . withAllLib $ \ l -> do let lbi = libBuildInfo l relincdirs = "." : filter (not.isAbsolute) (includeDirs lbi) mapM (fmap snd . findIncludeFile relincdirs) (installIncludes lbi) @@ -228,7 +230,7 @@ listPackageSourcesOrdinary verbosity pkg_descr pps = where -- We have to deal with all libs and executables, so we have local -- versions of these functions that ignore the 'buildable' attribute: - withAllLib action = maybe (return []) action (library pkg_descr) + withAllLib action = mapM action (libraries pkg_descr) withAllExe action = mapM action (executables pkg_descr) withAllTest action = mapM action (testSuites pkg_descr) withAllBenchmark action = mapM action (benchmarks pkg_descr) @@ -309,7 +311,7 @@ filterAutogenModule :: PackageDescription -> PackageDescription filterAutogenModule pkg_descr0 = mapLib filterAutogenModuleLib $ mapAllBuildInfo filterAutogenModuleBI pkg_descr0 where - mapLib f pkg = pkg { library = fmap f (library pkg) } + mapLib f pkg = pkg { libraries = map f (libraries pkg) } filterAutogenModuleLib lib = lib { exposedModules = filter (/=autogenModule) (exposedModules lib) } @@ -465,7 +467,7 @@ tarBallName = display . packageId mapAllBuildInfo :: (BuildInfo -> BuildInfo) -> (PackageDescription -> PackageDescription) mapAllBuildInfo f pkg = pkg { - library = fmap mapLibBi (library pkg), + libraries = fmap mapLibBi (libraries pkg), executables = fmap mapExeBi (executables pkg), testSuites = fmap mapTestBi (testSuites pkg), benchmarks = fmap mapBenchBi (benchmarks pkg) diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown index ae158fee737..291a7eca55d 100644 --- a/Cabal/doc/developing-packages.markdown +++ b/Cabal/doc/developing-packages.markdown @@ -966,6 +966,43 @@ The library section should contain the following fields: The library section may also contain build information fields (see the section on [build information](#build-information)). +Cabal 1.23 and later support "internal libraries", which are extra named +libraries (as opposed to the usual unnamed library section). For +example, suppose that your test suite needs access to some internal +modules in your library, which you do not otherwise want to export. You +could put these modules in an internal library, which the main library +and the test suite `build-depends` upon. Then your Cabal file might +look something like this: + +~~~~~~~~~~~~~~~~ +name: foo +version: 1.0 +license: BSD3 +cabal-version: >= 1.23 +build-type: Simple + +library foo-internal + exposed-modules: Foo.Internal + build-depends: base + +library + exposed-modules: Foo.Public + build-depends: foo-internal, base + +test-suite test-foo + type: exitcode-stdio-1.0 + main-is: test-foo.hs + build-depends: foo-internal, base +~~~~~~~~~~~~~~~~ + +Internal libraries are also useful for packages that define multiple +executables, but do not define a publically accessible library. +Internal libraries are only visible internally in the package (so they +can only be added to the `build-depends` of same-package libraries, +executables, test suites, etc.) Internal libraries locally shadow any +packages which have the same name (so don't name an internal library +with the same name as an external dependency.) + #### Opening an interpreter session #### While developing a package, it is often useful to make its code available inside diff --git a/Cabal/tests/PackageTests/MultipleLibraries/p/Foo.hs b/Cabal/tests/PackageTests/MultipleLibraries/p/Foo.hs new file mode 100644 index 00000000000..a03c8743b85 --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/p/Foo.hs @@ -0,0 +1,2 @@ +import Q +main = putStrLn q diff --git a/Cabal/tests/PackageTests/MultipleLibraries/p/p.cabal b/Cabal/tests/PackageTests/MultipleLibraries/p/p.cabal new file mode 100644 index 00000000000..849c5be693b --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/p/p.cabal @@ -0,0 +1,23 @@ +name: p +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.23 + +library q + build-depends: base + exposed-modules: Q + hs-source-dirs: q + default-language: Haskell2010 + +library + build-depends: base, q + exposed-modules: P + hs-source-dirs: p + default-language: Haskell2010 + +executable foo + build-depends: base, q + main-is: Foo.hs diff --git a/Cabal/tests/PackageTests/MultipleLibraries/p/p/P.hs b/Cabal/tests/PackageTests/MultipleLibraries/p/p/P.hs new file mode 100644 index 00000000000..6b87b672e6a --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/p/p/P.hs @@ -0,0 +1,2 @@ +module P where +import Q diff --git a/Cabal/tests/PackageTests/MultipleLibraries/p/q/Q.hs b/Cabal/tests/PackageTests/MultipleLibraries/p/q/Q.hs new file mode 100644 index 00000000000..eeb2056f6fb --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/p/q/Q.hs @@ -0,0 +1,2 @@ +module Q where +q = "I AM THE ONE" diff --git a/Cabal/tests/PackageTests/MultipleLibraries/q/Q.hs b/Cabal/tests/PackageTests/MultipleLibraries/q/Q.hs new file mode 100644 index 00000000000..f44c49ac234 --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/q/Q.hs @@ -0,0 +1,2 @@ +module Q where +q = "DO NOT SEE ME" diff --git a/Cabal/tests/PackageTests/MultipleLibraries/q/q.cabal b/Cabal/tests/PackageTests/MultipleLibraries/q/q.cabal new file mode 100644 index 00000000000..872bb1ef992 --- /dev/null +++ b/Cabal/tests/PackageTests/MultipleLibraries/q/q.cabal @@ -0,0 +1,12 @@ +name: q +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Q + build-depends: base + default-language: Haskell2010 diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 91b71bdd071..1d6135059f7 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -267,6 +267,14 @@ tests config = do tc "GhcPkgGuess/SymlinkVersion" $ ghc_pkg_guess "ghc" tc "GhcPkgGuess/SymlinkGhcVersion" $ ghc_pkg_guess "ghc" + tc "MultipleLibraries" $ do + withPackageDb $ do + withPackage "q" $ cabal_install [] + withPackage "p" $ do + cabal_install [] + r <- runExe' "foo" [] + assertOutputContains "I AM THE ONE" r + where ghc_pkg_guess bin_name = do cwd <- packageDir diff --git a/Cabal/tests/Setup.log b/Cabal/tests/Setup.log new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-install/Distribution/Client/ComponentDeps.hs b/cabal-install/Distribution/Client/ComponentDeps.hs index 85451024c20..91a3cfc8ab0 100644 --- a/cabal-install/Distribution/Client/ComponentDeps.hs +++ b/cabal-install/Distribution/Client/ComponentDeps.hs @@ -53,7 +53,7 @@ import Data.Traversable (Traversable(traverse)) -- | Component of a package. data Component = - ComponentLib + ComponentLib String | ComponentExe String | ComponentTest String | ComponentBench String @@ -113,8 +113,8 @@ filterDeps :: (Component -> a -> Bool) -> ComponentDeps a -> ComponentDeps a filterDeps p = ComponentDeps . Map.filterWithKey p . unComponentDeps -- | ComponentDeps containing library dependencies only -fromLibraryDeps :: a -> ComponentDeps a -fromLibraryDeps = singleton ComponentLib +fromLibraryDeps :: String -> a -> ComponentDeps a +fromLibraryDeps n = singleton (ComponentLib n) -- | ComponentDeps containing setup dependencies only. fromSetupDeps :: a -> ComponentDeps a @@ -123,7 +123,7 @@ fromSetupDeps = singleton ComponentSetup -- | ComponentDeps for installed packages. -- -- We assume that installed packages only record their library dependencies. -fromInstalled :: a -> ComponentDeps a +fromInstalled :: String -> a -> ComponentDeps a fromInstalled = fromLibraryDeps {------------------------------------------------------------------------------- @@ -150,7 +150,8 @@ nonSetupDeps = select (/= ComponentSetup) -- | Library dependencies proper only. libraryDeps :: Monoid a => ComponentDeps a -> a -libraryDeps = select (== ComponentLib) +libraryDeps = select (\c -> case c of ComponentLib _ -> True + _ -> False) -- | Setup dependencies. setupDeps :: Monoid a => ComponentDeps a -> a diff --git a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs index 8648f876a6c..21b7efedde5 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs @@ -60,15 +60,15 @@ convIPI' sip idx = -- | Convert a single installed package into the solver-specific format. convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo) convIP idx ipi = - let ipid = IPI.installedUnitId ipi - i = I (pkgVersion (sourcePackageId ipi)) (Inst ipid) - pn = pkgName (sourcePackageId ipi) - in case mapM (convIPId pn idx) (IPI.depends ipi) of + case mapM (convIPId pn idx) (IPI.depends ipi) of Nothing -> (pn, i, PInfo [] M.empty (Just Broken)) Just fds -> (pn, i, PInfo (setComp fds) M.empty Nothing) where -- We assume that all dependencies of installed packages are _library_ deps - setComp = setCompFlaggedDeps ComponentLib + ipid = IPI.installedUnitId ipi + i = I (pkgVersion (sourcePackageId ipi)) (Inst ipid) + pn = pkgName (sourcePackageId ipi) + setComp = setCompFlaggedDeps (ComponentLib (unPackageName pn)) -- TODO: Installed packages should also store their encapsulations! -- | Convert dependencies specified by an installed package id into @@ -115,7 +115,7 @@ convGPD os arch cinfo strfl pi PDC.addBuildableCondition getInfo in PInfo - (maybe [] (conv ComponentLib libBuildInfo ) libs ++ + (concatMap (\(nm, ds) -> conv (ComponentLib nm) libBuildInfo ds) libs ++ maybe [] (convSetupBuildInfo pi) (setupBuildInfo pkg) ++ concatMap (\(nm, ds) -> conv (ComponentExe nm) buildInfo ds) exes ++ prefix (Stanza (SN pi TestStanzas)) diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs index 3d451d8e29f..b3b8fbb1c5e 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs @@ -617,7 +617,8 @@ finaliseSelectedPackages pref selected constraints = -- We cheat in the cabal solver, and classify all dependencies as -- library dependencies. deps' :: ComponentDeps [ConfiguredId] - deps' = CD.fromLibraryDeps $ map (confId . pickRemaining mipkg) deps + deps' = CD.fromLibraryDeps (unPackageName (packageName pkg)) + (map (confId . pickRemaining mipkg) deps) -- InstalledOrSource indicates that we either have a source package -- available, or an installed one, or both. In the case that we have both diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 9bff74f658f..3e3279be45b 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -1413,7 +1413,9 @@ installUnpackedPackage verbosity buildLimit installLock numJobs -- Compute the IPID let flags (ReadyPackage (ConfiguredPackage _ x _ _) _) = x - cid = Configure.computeComponentId (PackageDescription.package pkg) CLibName + pkg_name = pkgName (PackageDescription.package pkg) + cid = Configure.computeComponentId Cabal.NoFlag + (PackageDescription.package pkg) (CLibName (display pkg_name)) (map (\(SimpleUnitId cid0) -> cid0) (CD.libraryDeps (depends rpkg))) (flags rpkg) ipid = SimpleUnitId cid diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index c7cc04149cf..a52398c0456 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -457,13 +457,13 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = flags = maybe [] Source.genPackageFlags sourceGeneric, hasLib = isJust installed || fromMaybe False - (fmap (isJust . Source.condLibrary) sourceGeneric), + (fmap (not . null . Source.condLibraries) sourceGeneric), hasExe = fromMaybe False (fmap (not . null . Source.condExecutables) sourceGeneric), executables = map fst (maybe [] Source.condExecutables sourceGeneric), modules = combine (map Installed.exposedName . Installed.exposedModules) installed - (maybe [] getListOfExposedModules . Source.library) + (concatMap getListOfExposedModules . Source.libraries) source, dependencies = combine (map (SourceDependency . simplifyDependency) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 4760404679e..1ba1fd6e4f0 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1601,7 +1601,7 @@ pruneInstallPlanPass2 pkgs = keepNeeded _ _ = True targetsRequiredForRevDeps = - [ ComponentTarget CLibName WholeComponent + [ ComponentTarget (Cabal.defaultLibName (pkgSourceId pkg)) WholeComponent -- if anything needs this pkg, build the library component | installedPackageId pkg `Set.member` hasReverseLibDeps ] @@ -2087,11 +2087,11 @@ setupHsBuildArgs pkg = showComponentTarget :: ElaboratedConfiguredPackage -> ComponentTarget -> String -showComponentTarget pkg = +showComponentTarget _pkg = showBuildTarget . toBuildTarget where showBuildTarget t = - Cabal.showBuildTarget (qlBuildTarget t) (packageId pkg) t + Cabal.showBuildTarget (qlBuildTarget t) t qlBuildTarget Cabal.BuildTargetComponent{} = Cabal.QL2 qlBuildTarget _ = Cabal.QL3 @@ -2259,7 +2259,7 @@ packageHashInputs } where -- Obviously the main deps are relevant - relevantDeps CD.ComponentLib = True + relevantDeps (CD.ComponentLib _) = True relevantDeps (CD.ComponentExe _) = True -- Setup deps can affect the Setup.hs behaviour and thus what is built relevantDeps CD.ComponentSetup = True diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 230d8adf351..658e6a824a1 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -20,7 +20,7 @@ module Distribution.Client.Types where import Distribution.Package ( PackageName, PackageId, Package(..) - , UnitId(..), mkUnitId + , UnitId(..), mkUnitId, pkgName , HasUnitId(..), PackageInstalled(..) ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) @@ -91,7 +91,8 @@ class Package pkg => PackageFixedDeps pkg where depends :: pkg -> ComponentDeps [UnitId] instance PackageFixedDeps InstalledPackageInfo where - depends = CD.fromInstalled . installedDepends + depends pkg = CD.fromInstalled (display (pkgName (packageId pkg))) + (installedDepends pkg) -- | In order to reuse the implementation of PackageIndex which relies on diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index a9c53cf1545..0611681bd89 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -139,7 +139,7 @@ data ExampleAvailable = ExAv { exAv :: ExamplePkgName -> ExamplePkgVersion -> [ExampleDependency] -> ExampleAvailable exAv n v ds = ExAv { exAvName = n, exAvVersion = v - , exAvDeps = CD.fromLibraryDeps ds } + , exAvDeps = CD.fromLibraryDeps n ds } withSetupDeps :: ExampleAvailable -> [ExampleDependency] -> ExampleAvailable withSetupDeps ex setupDeps = ex { @@ -180,7 +180,7 @@ exAvSrcPkg ex = , packageDescription = C.GenericPackageDescription { C.packageDescription = C.emptyPackageDescription { C.package = exAvPkgId ex - , C.library = error "not yet configured: library" + , C.libraries = error "not yet configured: library" , C.executables = error "not yet configured: executables" , C.testSuites = error "not yet configured: testSuites" , C.benchmarks = error "not yet configured: benchmarks" @@ -191,9 +191,9 @@ exAvSrcPkg ex = } , C.genPackageFlags = nub $ concatMap extractFlags (CD.libraryDeps (exAvDeps ex)) - , C.condLibrary = Just $ mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs) + , C.condLibraries = [(exAvName ex, mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs) disableLib - (Buildable libraryDeps) + (Buildable libraryDeps))] , C.condExecutables = [] , C.condTestSuites = let mkTree = mkCondTree mempty disableTest . Buildable diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs index c6f38cd784e..a5a3113cb09 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs @@ -237,15 +237,15 @@ instance Arbitrary Solver where shrink TopDown = [Modular] instance Arbitrary Component where - arbitrary = oneof [ return ComponentLib + arbitrary = oneof [ ComponentLib <$> arbitraryComponentName , ComponentExe <$> arbitraryComponentName , ComponentTest <$> arbitraryComponentName , ComponentBench <$> arbitraryComponentName , return ComponentSetup ] - shrink ComponentLib = [] - shrink _ = [ComponentLib] + shrink (ComponentLib "") = [] + shrink _ = [ComponentLib ""] instance Arbitrary ExampleInstalled where arbitrary = error "arbitrary not implemented: ExampleInstalled"