Implement "convenience libraries", fixes haskell#269.

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 <[email protected]>

Author: ezyang

Cabal/Cabal.cabal

@@ -97,6 +97,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/OrderFlags/Foo.hs
   tests/PackageTests/OrderFlags/my.cabal
   tests/PackageTests/PathsModule/Executable/Main.hs

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   = [],
@@ -390,6 +390,7 @@ instance Text ModuleRenaming where
 -- The Library type
 
 data Library = Library {
+        libName :: String,
         exposedModules    :: [ModuleName],
         reexportedModules :: [ModuleReexport],
         requiredSignatures:: [ModuleName], -- ^ What sigs need implementations?
@@ -403,6 +404,7 @@ instance Binary Library
 
 instance Monoid Library where
   mempty = Library {
+    libName = mempty,
     exposedModules = mempty,
     reexportedModules = mempty,
     requiredSignatures = mempty,
@@ -414,6 +416,7 @@ instance Monoid Library where
 
 instance Semigroup Library where
   a <> b = Library {
+    libName = combine' libName,
     exposedModules = combine exposedModules,
     reexportedModules = combine reexportedModules,
     requiredSignatures = combine requiredSignatures,
@@ -422,20 +425,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.
@@ -919,7 +928,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
@@ -954,10 +963,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]
@@ -1113,28 +1122,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
@@ -1143,7 +1154,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)]

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)
@@ -673,7 +673,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
 
     checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
@@ -895,9 +895,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'."
@@ -1296,7 +1305,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
@@ -1399,8 +1408,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)