Merge http://code.haskell.org/~thielema/haddock/ into ghc-7.4

5 files changed, 48 insertions, 27 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index fc94e7d6..94ca6d10 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -468,9 +468,9 @@ ppHtmlModule odir doctitle themes
   maybe_contents_url maybe_index_url unicode qual debug iface = do
   let
       mdl = ifaceMod iface
-      abbrevs = ifaceModuleAbbrevs iface
+      aliases = ifaceModuleAliases iface
       mdl_str = moduleString mdl
-      real_qual = makeModuleQual qual abbrevs mdl
+      real_qual = makeModuleQual qual aliases mdl
       html =
         headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
         bodyHtml doctitle (Just iface)
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 88ba14dc..48d0f7f1 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -79,10 +79,10 @@ ppQualifyName qual name mdl =
         Just _       -> ppFullQualName mdl name
         -- some other module, D.x -> D.x
         Nothing      -> ppFullQualName mdl name
-    AbbreviateQual abbrevs localmdl ->
+    AliasedQual aliases localmdl ->
       case (moduleString mdl == moduleString localmdl,
-            M.lookup (moduleName mdl) abbrevs) of
-        (False, Just abbrev) -> ppQualName abbrev name
+            M.lookup mdl aliases) of
+        (False, Just alias) -> ppQualName alias name
         _ -> ppName name
 
 
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 80b5a970..ea4636fe 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -30,6 +30,8 @@ import Control.Applicative
 import Control.Monad
 import qualified Data.Traversable as T
 
+import qualified Packages
+import qualified Module
 import qualified SrcLoc
 import GHC hiding (flags)
 import HscTypes
@@ -108,17 +110,8 @@ createInterface tm flags modMap instIfaceMap = do
         | OptPrune `elem` opts = prunedExportItems0
         | otherwise = exportItems
 
-  let abbrevs =
-        case tm_renamed_source tm of
-          Nothing -> M.empty
-          Just (_,impDecls,_,_) ->
-            M.fromList $
-            mapMaybe (\(SrcLoc.L _ impDecl) -> do
-              abbrev <- ideclAs impDecl
-              return
-                (case ideclName impDecl of SrcLoc.L _ name -> name,
-                 abbrev))
-              impDecls
+  let aliases =
+        mkAliasMap dflags $ tm_renamed_source tm
 
   return Interface {
     ifaceMod             = mdl,
@@ -137,11 +130,39 @@ createInterface tm flags modMap instIfaceMap = do
     ifaceVisibleExports  = visibleNames,
     ifaceDeclMap         = declMap,
     ifaceSubMap          = subMap,
-    ifaceModuleAbbrevs   = abbrevs,
+    ifaceModuleAliases   = aliases,
     ifaceInstances       = instances,
     ifaceHaddockCoverage = coverage
   }
 
+mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName
+mkAliasMap dflags mRenamedSource =
+  case mRenamedSource of
+    Nothing -> M.empty
+    Just (_,impDecls,_,_) ->
+      M.fromList $
+      mapMaybe (\(SrcLoc.L _ impDecl) -> do
+        alias <- ideclAs impDecl
+        return $
+          (lookupModuleDyn dflags
+             (fmap Module.fsToPackageId $
+              ideclPkgQual impDecl)
+             (case ideclName impDecl of SrcLoc.L _ name -> name),
+           alias))
+        impDecls
+
+-- similar to GHC.lookupModule
+lookupModuleDyn ::
+  DynFlags -> Maybe PackageId -> ModuleName -> Module
+lookupModuleDyn _ (Just pkgId) mdlName =
+  Module.mkModule pkgId mdlName
+lookupModuleDyn dflags Nothing mdlName =
+  flip Module.mkModule mdlName $
+  case filter snd $
+       Packages.lookupModuleInAllPackages dflags mdlName of
+    (pkgId,_):_ -> Packages.packageConfigId pkgId
+    [] -> Module.mainPackageId
+
 
 -------------------------------------------------------------------------------
 -- Warnings
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 792c0be3..46f9def7 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -126,7 +126,7 @@ options backwardsCompat =
     Option ['t']  ["title"]    (ReqArg Flag_Heading "TITLE")
       "page heading",
     Option ['q']  ["qual"] (ReqArg Flag_Qualification "QUAL")
-      "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'abbreviate'",
+      "qualification of names, one of \n'none' (default), 'full', 'local'\n'relative' or 'aliased'",
     Option ['?']  ["help"]  (NoArg Flag_Help)
       "display this help and exit",
     Option ['V']  ["version"]  (NoArg Flag_Version)
@@ -237,7 +237,7 @@ qualification flags =
       ["full"]       -> Right OptFullQual
       ["local"]      -> Right OptLocalQual
       ["relative"]   -> Right OptRelativeQual
-      ["abbreviate"] -> Right OptAbbreviateQual
+      ["aliased"]    -> Right OptAliasedQual
       [arg]          -> Left $ "unknown qualification type " ++ show arg
       _:_            -> Left "qualification option given multiple times"
 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 2195faf5..97d56a52 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -103,8 +103,8 @@ data Interface = Interface
     -- module.
   , ifaceVisibleExports  :: ![Name]
 
-    -- | Abbreviations of module imports as in @import A.B.C as C@.
-  , ifaceModuleAbbrevs   :: AbbreviationMap
+    -- | Aliases of module imports as in @import A.B.C as C@.
+  , ifaceModuleAliases   :: AliasMap
 
     -- | Instances exported by the module.
   , ifaceInstances       :: ![Instance]
@@ -383,21 +383,21 @@ data QualOption
   | OptLocalQual      -- ^ Qualify all imported names fully.
   | OptRelativeQual   -- ^ Like local, but strip module prefix
                       --   from modules in the same hierarchy.
-  | OptAbbreviateQual -- ^ Uses abbreviations of module names
+  | OptAliasedQual    -- ^ Uses aliases of module names
                       --   as suggested by module import renamings.
                       --   However, we are unfortunately not able
                       --   to maintain the original qualifications.
                       --   Image a re-export of a whole module,
                       --   how could the re-exported identifiers be qualified?
 
-type AbbreviationMap = Map ModuleName ModuleName
+type AliasMap = Map Module ModuleName
 
 data Qualification
   = NoQual
   | FullQual
   | LocalQual Module
   | RelativeQual Module
-  | AbbreviateQual AbbreviationMap Module
+  | AliasedQual AliasMap Module
        -- ^ @Module@ contains the current module.
        --   This way we can distinguish imported and local identifiers.
 
@@ -407,12 +407,12 @@ makeContentsQual qual =
     OptNoQual -> NoQual
     _         -> FullQual
 
-makeModuleQual :: QualOption -> AbbreviationMap -> Module -> Qualification
-makeModuleQual qual abbrevs mdl =
+makeModuleQual :: QualOption -> AliasMap -> Module -> Qualification
+makeModuleQual qual aliases mdl =
   case qual of
     OptLocalQual      -> LocalQual mdl
     OptRelativeQual   -> RelativeQual mdl
-    OptAbbreviateQual -> AbbreviateQual abbrevs mdl
+    OptAliasedQual    -> AliasedQual aliases mdl
     OptFullQual       -> FullQual
     OptNoQual         -> NoQual