diff options
Diffstat (limited to 'haddock-api/src/Haddock.hs')
-rw-r--r-- | haddock-api/src/Haddock.hs | 27 |
1 files changed, 17 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 5a1c6abe..5c48d28b 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -46,6 +46,7 @@ import Data.List (isPrefixOf) import Control.Exception import Data.Maybe import Data.IORef +import Data.Map (Map) import qualified Data.Map as Map import System.IO import System.Exit @@ -228,13 +229,14 @@ renderStep dflags flags qual pkgs interfaces = do let ifaceFiles = map snd pkgs installedIfaces = concatMap ifInstalledIfaces ifaceFiles - srcMap = Map.fromList [ (ifPackageKey if_, x) | ((_, Just x), if_) <- pkgs ] - render dflags flags qual interfaces installedIfaces srcMap + extSrcMap = Map.fromList + [ (ifModule ifile, path) | ((_, Just path), ifile) <- pkgs ] + render dflags flags qual interfaces installedIfaces extSrcMap -- | Render the interfaces with whatever backend is specified in the flags. -render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> SrcMap -> IO () -render dflags flags qual ifaces installedIfaces srcMap = do +render :: DynFlags -> [Flag] -> QualOption -> [Interface] -> [InstalledInterface] -> Map Module FilePath -> IO () +render dflags flags qual ifaces installedIfaces extSrcMap = do let title = fromMaybe "" (optTitle flags) @@ -264,15 +266,20 @@ render dflags flags qual ifaces installedIfaces srcMap = do | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat | otherwise = srcModule - srcMap' + srcMap = Map.union + (Map.map SrcExternal extSrcMap) + (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ]) + + pkgSrcMap = Map.mapKeys modulePackageKey extSrcMap + pkgSrcMap' | Flag_HyperlinkedSource `elem` flags = - Map.insert pkgKey hypSrcModuleNameUrlFormat srcMap - | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl srcMap - | otherwise = srcMap + Map.insert pkgKey hypSrcModuleNameUrlFormat pkgSrcMap + | Just srcNameUrl <- srcEntity = Map.insert pkgKey srcNameUrl pkgSrcMap + | otherwise = pkgSrcMap -- TODO: Get these from the interface files as with srcMap srcLMap' = maybe Map.empty (\path -> Map.singleton pkgKey path) srcLEntity - sourceUrls' = (srcBase, srcModule', srcMap', srcLMap') + sourceUrls' = (srcBase, srcModule', pkgSrcMap', srcLMap') libDir <- getHaddockLibDir flags prologue <- getPrologue dflags flags @@ -322,7 +329,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do libDir when (Flag_HyperlinkedSource `elem` flags) $ do - ppHyperlinkedSource odir libDir opt_source_css pretty pkgKey srcMap ifaces + ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces -- | From GHC 7.10, this function has a potential to crash with a -- nasty message such as @expectJust getPackageDetails@ because |