Skip to content

Commit

Permalink
Implement "convenience libraries", fixes haskell#269.
Browse files Browse the repository at this point in the history
Convenience libraries are package-private libraries
that can be used as part of executables, libraries, etc
without being exposed to the external world.  Private
libraries are signified using the

    library foo

stanza.  Within a Cabal package, the name convenience library
shadows the conventional meaning of package name in
build-depends, so that references to "foo" do not indicate
foo in Hackage, but the convenience library defined in the
same package. (So, don't shadow Hackage packages!)

This commit implements convenience libraries such that they
ARE installed the package database (this prevents us from
having to special case dynamically linked executables);
in GHC 7.10 and later they are installed under the same
package name as the package that contained them, but have
a distinct "component ID" (one pay off of making the distinction
between component IDs and installed package IDs.)

There is a "default" library which is identified by the fact
that its library name coincides with the package name.  There
are some new convenience functions to permit referencing this.

There are a few latent bugs in this commit which are fixed
in later commits in this patchset.  (Those bugfixes required
a bit of refactoring, so it's clearer if they're not
with this patch.)

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
  • Loading branch information
ezyang committed Mar 16, 2016
1 parent fa0c33e commit 4b721d7
Show file tree
Hide file tree
Showing 39 changed files with 1,865 additions and 357 deletions.
8 changes: 8 additions & 0 deletions Cabal/Cabal.cabal
Expand Up @@ -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
Expand Down
73 changes: 42 additions & 31 deletions Cabal/Distribution/PackageDescription.hs
Expand Up @@ -189,7 +189,7 @@ data PackageDescription
buildType :: Maybe BuildType,
setupBuildInfo :: Maybe SetupBuildInfo,
-- components
library :: Maybe Library,
libraries :: [Library],
executables :: [Executable],
testSuites :: [TestSuite],
benchmarks :: [Benchmark],
Expand Down Expand Up @@ -256,7 +256,7 @@ emptyPackageDescription
category = "",
customFieldsPD = [],
setupBuildInfo = Nothing,
library = Nothing,
libraries = [],
executables = [],
testSuites = [],
benchmarks = [],
Expand Down Expand Up @@ -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?
Expand All @@ -400,6 +401,7 @@ instance Binary Library

instance Monoid Library where
mempty = Library {
libName = mempty,
exposedModules = mempty,
reexportedModules = mempty,
requiredSignatures = mempty,
Expand All @@ -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,
Expand All @@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]
Expand Down Expand Up @@ -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 compnoents 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
Expand All @@ -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)]
Expand Down
25 changes: 17 additions & 8 deletions Cabal/Distribution/PackageDescription/Check.hs
Expand Up @@ -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 )
Expand Down Expand Up @@ -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."

Expand All @@ -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)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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'."
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 4b721d7

Please sign in to comment.