Merge pull request #2197 from ezyang/ezyang-exposed-modules

Consolidate exposed-modules and reexported-modules in InstalledPackageInfo

Cabal/Distribution/InstalledPackageInfo.hs

@@ -28,7 +28,7 @@
 
 module Distribution.InstalledPackageInfo (
         InstalledPackageInfo_(..), InstalledPackageInfo,
-        ModuleReexport(..),
+        OriginalModule(..), ExposedModule(..),
         ParseResult(..), PError(..), PWarning,
         emptyInstalledPackageInfo,
         parseInstalledPackageInfo,
@@ -45,7 +45,7 @@ import Distribution.ParseUtils
          , parseFieldsFlat
          , parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
          , showFilePath, showToken, boolField, parseOptVersion
-         , parseFreeText, showFreeText )
+         , parseFreeText, showFreeText, parseOptCommaList )
 import Distribution.License     ( License(..) )
 import Distribution.Package
          ( PackageName(..), PackageIdentifier(..)
@@ -86,8 +86,7 @@ data InstalledPackageInfo_ m
         category          :: String,
         -- these parts are required by an installed package only:
         exposed           :: Bool,
-        exposedModules    :: [m],
-        reexportedModules :: [ModuleReexport],
+        exposedModules    :: [ExposedModule],
         hiddenModules     :: [m],
         trusted           :: Bool,
         importDirs        :: [FilePath],
@@ -137,7 +136,6 @@ emptyInstalledPackageInfo
         category          = "",
         exposed           = False,
         exposedModules    = [],
-        reexportedModules = [],
         hiddenModules     = [],
         trusted           = False,
         importDirs        = [],
@@ -160,31 +158,75 @@ noVersion :: Version
 noVersion = Version [] []
 
 -- -----------------------------------------------------------------------------
--- Module re-exports
+-- Exposed modules
 
-data ModuleReexport = ModuleReexport {
-       moduleReexportDefiningPackage :: InstalledPackageId,
-       moduleReexportDefiningName    :: ModuleName,
-       moduleReexportName            :: ModuleName
-    }
-    deriving (Generic, Read, Show)
+data OriginalModule
+   = OriginalModule {
+       originalPackageId :: InstalledPackageId,
+       originalModuleName :: ModuleName
+     }
+  deriving (Generic, Eq, Read, Show)
 
-instance Binary ModuleReexport
+data ExposedModule
+   = ExposedModule {
+       exposedName      :: ModuleName,
+       exposedReexport  :: Maybe OriginalModule,
+       exposedSignature :: Maybe OriginalModule
+     }
+  deriving (Generic, Read, Show)
 
-instance Text ModuleReexport where
-    disp (ModuleReexport pkgid origname newname) =
-          disp pkgid <> Disp.char ':' <> disp origname
-      <+> Disp.text "as" <+> disp newname
+instance Text OriginalModule where
+    disp (OriginalModule ipi m) =
+        disp ipi <> Disp.char ':' <> disp m
+    parse = do
+        ipi <- parse
+        _ <- Parse.char ':'
+        m <- parse
+        return (OriginalModule ipi m)
 
+instance Text ExposedModule where
+    disp (ExposedModule m reexport signature) =
+        Disp.sep [ disp m
+                 , case reexport of
+                    Just m' -> Disp.sep [Disp.text "from", disp m']
+                    Nothing -> Disp.empty
+                 , case signature of
+                    Just m' -> Disp.sep [Disp.text "is", disp m']
+                    Nothing -> Disp.empty
+                 ]
     parse = do
-      pkgid    <- parse
-      _ <- Parse.char ':'
-      origname <- parse
-      Parse.skipSpaces
-      _ <- Parse.string "as"
-      Parse.skipSpaces
-      newname  <- parse
-      return (ModuleReexport pkgid origname newname)
+        m <- parseModuleNameQ
+        Parse.skipSpaces
+        reexport <- Parse.option Nothing $ do
+            _ <- Parse.string "from"
+            Parse.skipSpaces
+            fmap Just parse
+        Parse.skipSpaces
+        signature <- Parse.option Nothing $ do
+            _ <- Parse.string "is"
+            Parse.skipSpaces
+            fmap Just parse
+        return (ExposedModule m reexport signature)
+
+
+instance Binary OriginalModule
+
+instance Binary ExposedModule
+
+-- To maintain backwards-compatibility, we accept both comma/non-comma
+-- separated variants of this field.  You SHOULD use the comma syntax if you
+-- use any new functions, although actually it's unambiguous due to a quirk
+-- of the fact that modules must start with capital letters.
+
+showExposedModules :: [ExposedModule] -> Disp.Doc
+showExposedModules xs
+    | all isExposedModule xs = fsep (map disp xs)
+    | otherwise = fsep (Disp.punctuate comma (map disp xs))
+    where isExposedModule (ExposedModule _ Nothing Nothing) = True
+          isExposedModule _ = False
+
+parseExposedModules :: Parse.ReadP r [ExposedModule]
+parseExposedModules = parseOptCommaList parse
 
 -- -----------------------------------------------------------------------------
 -- Parsing
@@ -262,12 +304,9 @@ installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
 installedFieldDescrs = [
    boolField "exposed"
         exposed            (\val pkg -> pkg{exposed=val})
- , listField   "exposed-modules"
-        disp               parseModuleNameQ
+ , simpleField "exposed-modules"
+        showExposedModules parseExposedModules
         exposedModules     (\xs    pkg -> pkg{exposedModules=xs})
- , listField   "reexported-modules"
-        disp               parse
-        reexportedModules  (\xs    pkg -> pkg{reexportedModules=xs})
  , listField   "hidden-modules"
         disp               parseModuleNameQ
         hiddenModules      (\xs    pkg -> pkg{hiddenModules=xs})

Cabal/Distribution/Simple/Build.hs

@@ -367,7 +367,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
                 { componentPackageDeps = componentPackageDeps clbi
                 , componentPackageRenaming = componentPackageRenaming clbi
                 , componentLibraries = [LibraryName (testName test)]
-                , componentModuleReexports = []
+                , componentExposedModules = [IPI.ExposedModule m Nothing Nothing]
                 }
     pkg = pkg_descr {
             package      = (package pkg_descr) {

Cabal/Distribution/Simple/Configure.hs

@@ -61,7 +61,6 @@ import Distribution.InstalledPackageInfo as Installed
     ( InstalledPackageInfo, InstalledPackageInfo_(..)
     , emptyInstalledPackageInfo )
 import qualified Distribution.InstalledPackageInfo as Installed
-    ( ModuleReexport(..) )
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import Distribution.PackageDescription as PD
@@ -1129,6 +1128,7 @@ mkComponentsLocalBuildInfo installedPackages pkg_descr
     componentLocalBuildInfo component =
       case component of
       CLib lib -> do
+        let exports = map (\n -> Installed.ExposedModule n Nothing Nothing) (PD.exposedModules lib)
         reexports <- resolveModuleReexports installedPackages
                                             (packageId pkg_descr)
                                             externalPkgDeps lib
@@ -1136,7 +1136,7 @@ mkComponentsLocalBuildInfo installedPackages pkg_descr
           componentPackageDeps = cpds,
           componentLibraries   = [LibraryName ("HS" ++ display pkg_key)],
           componentPackageRenaming = cprns,
-          componentModuleReexports = reexports
+          componentExposedModules = exports ++ reexports
         }
       CExe _ ->
         return ExeComponentLocalBuildInfo {
@@ -1190,32 +1190,30 @@ resolveModuleReexports :: InstalledPackageIndex
                        -> [InstalledPackageInfo]
                        -> Library
                        -> Either [(ModuleReexport, String)] -- errors
-                                 [Installed.ModuleReexport] -- ok
+                                 [Installed.ExposedModule] -- ok
 resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
     case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of
       ([],  ok) -> Right ok
       (errs, _) -> Left  errs
   where
     -- A mapping from visible module names to their original defining
-    -- module name and package.
-    visibleModules :: Map ModuleName [(PackageName, ModuleName, InstalledPackageId)]
+    -- module name.  We also record the package name of the package which
+    -- *immediately* provided the module (not the original) to handle if the
+    -- user explicitly says which build-depends they want to reexport from.
+    visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)]
     visibleModules =
       Map.fromListWith (++) $
-        [ (visibleModuleName, [(exportingPackageName,
-                                definingModuleName,
-                                definingPackageId)])
+        [ (Installed.exposedName exposedModule, [(exportingPackageName,
+                                                  exposedModule)])
           -- The package index here contains all the indirect deps of the
           -- package we're configuring, but we want just the direct deps
         | let directDeps = Set.fromList (map installedPackageId externalPkgDeps)
         , pkg <- PackageIndex.allPackages installedPackages
         , installedPackageId pkg `Set.member` directDeps
         , let exportingPackageName = packageName pkg
-        , (visibleModuleName, definingModuleName, definingPackageId)
-             <- visibleModuleDetails pkg
+        , exposedModule <- visibleModuleDetails pkg
         ]
-     ++ [ (visibleModuleName, [(exportingPackageName,
-                                definingModuleName,
-                                definingPackageId)])
+     ++ [ (visibleModuleName, [(exportingPackageName, exposedModule)])
         | visibleModuleName <- PD.exposedModules lib
                             ++ otherModules (libBuildInfo lib)
         , let exportingPackageName = packageName srcpkgid
@@ -1223,33 +1221,31 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
               -- we don't know the InstalledPackageId of this package yet
               -- we will fill it in later, before registration.
               definingPackageId    = InstalledPackageId ""
+              originalModule = Installed.OriginalModule definingPackageId
+                                                        definingModuleName
+              exposedModule  = Installed.ExposedModule visibleModuleName
+                                                       (Just originalModule)
+                                                             Nothing
         ]
 
     -- All the modules exported from this package and their defining name and
     -- package (either defined here in this package or re-exported from some
-    -- other package)
-    visibleModuleDetails :: InstalledPackageInfo
-                         -> [(ModuleName, ModuleName, InstalledPackageId)]
-    visibleModuleDetails pkg =
+    -- other package).  Return an ExposedModule because we want to hold onto
+    -- signature information.
+    visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule]
+    visibleModuleDetails pkg = do
+        exposedModule <- Installed.exposedModules pkg
+        case Installed.exposedReexport exposedModule of
         -- The first case is the modules actually defined in this package.
-        -- In this case the visible and original names are the same, and the
-        -- defining package is this one.
-        [ (visibleModuleName, definingModuleName, definingPackageId)
-        | visibleModuleName <- Installed.exposedModules pkg
-        , let definingModuleName = visibleModuleName
-              definingPackageId  = installedPackageId pkg
-        ]
+        -- In this case the reexport will point to this package.
+            Nothing -> return exposedModule { Installed.exposedReexport =
+                            Just (Installed.OriginalModule (installedPackageId pkg)
+                                                 (Installed.exposedName exposedModule)) }
         -- On the other hand, a visible module might actually be itself
         -- a re-export! In this case, the re-export info for the package
         -- doing the re-export will point us to the original defining
-        -- module name and package.
-     ++ [ (visibleModuleName, definingModuleName, definingPackageId)
-        | Installed.ModuleReexport {
-            Installed.moduleReexportName            = visibleModuleName,
-            Installed.moduleReexportDefiningName    = definingModuleName,
-            Installed.moduleReexportDefiningPackage = definingPackageId
-          } <- Installed.reexportedModules pkg
-        ]
+        -- module name and package, so we can reuse the entry.
+            Just _ -> return exposedModule
 
     resolveModuleReexport reexport@ModuleReexport {
          moduleReexportOriginalPackage = moriginalPackageName,
@@ -1261,19 +1257,17 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
             case moriginalPackageName of
               Nothing                  -> id
               Just originalPackageName ->
-                filter (\(pkgname, _, _) -> pkgname == originalPackageName)
+                filter (\(pkgname, _) -> pkgname == originalPackageName)
 
           matches = filterForSpecificPackage
                       (Map.findWithDefault [] originalName visibleModules)
       in
       case (matches, moriginalPackageName) of
-        ((_, definingModuleName, definingPackageId):rest, _)
-          | all (\(_, n, p) -> n == definingModuleName && p == definingPackageId) rest
-           -> Right Installed.ModuleReexport {
-                 Installed.moduleReexportDefiningName    = definingModuleName,
-                 Installed.moduleReexportDefiningPackage = definingPackageId,
-                 Installed.moduleReexportName            = newName
-              }
+        ((_, exposedModule):rest, _)
+          -- TODO: Refine this check for signatures
+          | all (\(_, exposedModule') -> Installed.exposedReexport exposedModule
+                                      == Installed.exposedReexport exposedModule') rest
+           -> Right exposedModule { Installed.exposedName = newName }
 
         ([], Just originalPackageName)
            -> Left $ (,) reexport
@@ -1290,7 +1284,7 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
            -> Left $ (,) reexport
                    $ "The module " ++ display originalName ++ " is exported "
                   ++ "by more than one package ("
-                  ++ intercalate ", " [ display pkgname | (pkgname,_,_) <- ms ]
+                  ++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ]
                   ++ ") and so the re-export is ambiguous. The ambiguity can "
                   ++ "be resolved by qualifying by the package name. The "
                   ++ "syntax is 'packagename:moduleName [as newname]'."

Cabal/Distribution/Simple/GHC/IPI641.hs

@@ -67,6 +67,7 @@ mkInstalledPackageId = Current.InstalledPackageId . display
 toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
 toCurrent ipi@InstalledPackageInfo{} =
   let pid = convertPackageId (package ipi)
+      mkExposedModule m = Current.ExposedModule m Nothing Nothing
   in Current.InstalledPackageInfo {
     Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
     Current.sourcePackageId    = pid,
@@ -82,8 +83,7 @@ toCurrent ipi@InstalledPackageInfo{} =
     Current.description        = description ipi,
     Current.category           = category ipi,
     Current.exposed            = exposed ipi,
-    Current.exposedModules     = map convertModuleName (exposedModules ipi),
-    Current.reexportedModules  = [],
+    Current.exposedModules     = map (mkExposedModule . convertModuleName) (exposedModules ipi),
     Current.hiddenModules      = map convertModuleName (hiddenModules ipi),
     Current.trusted            = Current.trusted Current.emptyInstalledPackageInfo,
     Current.importDirs         = importDirs ipi,

Cabal/Distribution/Simple/GHC/IPI642.hs

@@ -102,6 +102,7 @@ convertLicense OtherLicense = Current.OtherLicense
 toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
 toCurrent ipi@InstalledPackageInfo{} =
   let pid = convertPackageId (package ipi)
+      mkExposedModule m = Current.ExposedModule m Nothing Nothing
   in Current.InstalledPackageInfo {
     Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
     Current.sourcePackageId    = pid,
@@ -117,8 +118,7 @@ toCurrent ipi@InstalledPackageInfo{} =
     Current.description        = description ipi,
     Current.category           = category ipi,
     Current.exposed            = exposed ipi,
-    Current.exposedModules     = map convertModuleName (exposedModules ipi),
-    Current.reexportedModules  = [],
+    Current.exposedModules     = map (mkExposedModule . convertModuleName) (exposedModules ipi),
     Current.hiddenModules      = map convertModuleName (hiddenModules ipi),
     Current.trusted            = Current.trusted Current.emptyInstalledPackageInfo,
     Current.importDirs         = importDirs ipi,

Cabal/Distribution/Simple/LocalBuildInfo.hs

@@ -67,7 +67,6 @@ import Distribution.PackageDescription
          , Executable(exeName, buildInfo), withTest, TestSuite(..)
          , BuildInfo(buildable), Benchmark(..), ModuleRenaming(..) )
 import qualified Distribution.InstalledPackageInfo as Installed
-    ( ModuleReexport(..) )
 import Distribution.Package
          ( PackageId, Package(..), InstalledPackageId(..), PackageKey
          , PackageName )
@@ -192,7 +191,7 @@ data ComponentLocalBuildInfo
     -- satisfied in terms of version ranges. This field fixes those dependencies
     -- to the specific versions available on this machine for this compiler.
     componentPackageDeps :: [(InstalledPackageId, PackageId)],
-    componentModuleReexports :: [Installed.ModuleReexport],
+    componentExposedModules :: [Installed.ExposedModule],
     componentPackageRenaming :: Map PackageName ModuleRenaming,
     componentLibraries :: [LibraryName]
   }

Cabal/Distribution/Simple/PackageIndex.hs

@@ -678,16 +678,15 @@ fakeInstalledDepends fakeMap = map (\pid -> Map.findWithDefault pid pid fakeMap)
 -- initialize the @build-deps@ field in @cabal init@.
 moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo]
 moduleNameIndex index =
-  Map.fromListWith (++) . concat $
-    [ [(m,  [pkg]) | m <- IPI.exposedModules pkg ] ++
-      [(m', [pkg]) | IPI.ModuleReexport {
-                       IPI.moduleReexportDefiningName = m,
-                       IPI.moduleReexportName         = m'
-                     } <- IPI.reexportedModules pkg
-                   , m /= m' ]
+  Map.fromListWith (++) $ do
+    pkg <- allPackages index
+    IPI.ExposedModule m reexport _ <- IPI.exposedModules pkg
+    case reexport of
+        Nothing -> return (m, [pkg])
+        Just (IPI.OriginalModule _ m') | m == m'   -> []
+                                       | otherwise -> return (m', [pkg])
         -- The heuristic is this: we want to prefer the original package
         -- which originally exported a module.  However, if a reexport
         -- also *renamed* the module (m /= m'), then we have to use the
         -- downstream package, since the upstream package has the wrong
         -- module name!
-    | pkg        <- allPackages index ]

Cabal/Distribution/Simple/Register.hs

@@ -65,7 +65,7 @@ import Distribution.Package
          ( Package(..), packageName, InstalledPackageId(..) )
 import Distribution.InstalledPackageInfo
          ( InstalledPackageInfo, InstalledPackageInfo_(InstalledPackageInfo)
-         , showInstalledPackageInfo, ModuleReexport(..) )
+         , showInstalledPackageInfo )
 import qualified Distribution.InstalledPackageInfo as IPI
 import Distribution.Simple.Utils
          ( writeUTF8File, writeFileAtomic, setFileExecutable
@@ -272,8 +272,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs =
     IPI.description        = description pkg,
     IPI.category           = category    pkg,
     IPI.exposed            = libExposed  lib,
-    IPI.exposedModules     = exposedModules lib,
-    IPI.reexportedModules  = map fixupSelfReexport (componentModuleReexports clbi),
+    IPI.exposedModules     = map fixupSelf (componentExposedModules clbi),
     IPI.hiddenModules      = otherModules bi,
     IPI.trusted            = IPI.trusted IPI.emptyInstalledPackageInfo,
     IPI.importDirs         = [ libdir installDirs | hasModules ],
@@ -305,16 +304,15 @@ generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs =
     hasLibrary = hasModules || not (null (cSources bi))
     -- Since we currently don't decide the InstalledPackageId of our package
     -- until just before we register, we didn't have one for the re-exports
-    -- of modules definied within this package, so we used an empty one that
+    -- of modules defined within this package, so we used an empty one that
     -- we fill in here now that we know what it is. It's a bit of a hack,
     -- we ought really to decide the InstalledPackageId ahead of time.
-    fixupSelfReexport mre@ModuleReexport {
-                        moduleReexportDefiningPackage = InstalledPackageId []
-                      }
-                    = mre {
-                        moduleReexportDefiningPackage = ipid
-                      }
-    fixupSelfReexport mre = mre
+    fixupSelf (IPI.ExposedModule n o o') =
+        IPI.ExposedModule n (fmap fixupOriginalModule o)
+                            (fmap fixupOriginalModule o')
+    fixupOriginalModule (IPI.OriginalModule i m) = IPI.OriginalModule (fixupIpid i) m
+    fixupIpid (InstalledPackageId []) = ipid
+    fixupIpid x = x
 
 -- | Construct 'InstalledPackageInfo' for a library that is in place in the
 -- build tree.

cabal-install/Distribution/Client/List.hs

@@ -450,9 +450,10 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
     hasExe       = fromMaybe False
                    (fmap (not . null . Source.condExecutables) sourceGeneric),
     executables  = map fst (maybe [] Source.condExecutables sourceGeneric),
-    modules      = combine Installed.exposedModules installed
-                           (maybe [] Source.exposedModules
-                                   . Source.library) source,
+    modules      = combine (map Installed.exposedName . Installed.exposedModules)
+                           installed
+                           (maybe [] getListOfExposedModules . Source.library)
+                           source,
     dependencies =
       combine (map (SourceDependency . simplifyDependency)
                . Source.buildDepends) source
@@ -467,6 +468,10 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
     installed :: Maybe Installed.InstalledPackageInfo
     installed = latestWithPref versionPref installedPkgs
 
+    getListOfExposedModules lib = Source.exposedModules lib
+                               ++ map Source.moduleReexportName
+                                      (Source.reexportedModules lib)
+
     sourceSelected
       | isJust selectedPkg = selectedPkg
       | otherwise          = latestWithPref versionPref sourcePkgs