diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index c9aeb6dbb646e2caefbea739725ba327e9d0dd4e..72398e3c947bc193f9513da7bd3071067602852d 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -394,11 +394,14 @@ render log' dflags unit_state flags sinceQual qual ifaces packages extSrcMap = d | Flag_HyperlinkedSource `elem` flags = Just hypSrcModuleUrlFormat | otherwise = srcModule + -- These urls have a template for the module %M srcMap = Map.union - (Map.map SrcExternal extSrcMap) + (Map.map (SrcExternal . hypSrcPkgUrlToModuleFormat) extSrcMap) (Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ]) - pkgSrcMap = Map.mapKeys moduleUnit extSrcMap + -- These urls have a template for the module %M and the name %N + pkgSrcMap = Map.map (hypSrcModuleUrlToNameFormat . hypSrcPkgUrlToModuleFormat) + $ Map.mapKeys moduleUnit extSrcMap pkgSrcMap' | Flag_HyperlinkedSource `elem` flags , Just k <- pkgKey @@ -408,6 +411,7 @@ render log' dflags unit_state flags sinceQual qual ifaces packages extSrcMap = d = Map.insert k srcNameUrl pkgSrcMap | otherwise = pkgSrcMap + -- These urls have a template for the module %M and the line %L -- TODO: Get these from the interface files as with srcMap pkgSrcLMap' | Flag_HyperlinkedSource `elem` flags diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs index 1c1134cb5c8e519c1c5e470aff2c65f7bf899a87..7db2f20d91dccff9affb273f19ff68f96ed54d05 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs @@ -9,6 +9,7 @@ module Haddock.Backends.Hyperlinker.Utils , hypSrcModuleNameUrlFormat, hypSrcModuleLineUrlFormat , spliceURL, spliceURL' , hypSrcModuleUrlToNameFormat + , hypSrcPkgUrlToModuleFormat -- * HIE file processing , PrintedType @@ -76,6 +77,9 @@ hypSrcModuleLineUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ lineFormat hypSrcModuleUrlToNameFormat :: String -> String hypSrcModuleUrlToNameFormat url = url ++ "#" ++ nameFormat +hypSrcPkgUrlToModuleFormat :: String -> String +hypSrcPkgUrlToModuleFormat url = url </> moduleFormat + moduleFormat :: String moduleFormat = "%{MODULE}.html" diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index 3d0dc02ce7d9dcaf4a9326b2b53e51e6d6e6f620..260cc7cfc678cb416e84e20f8ef47d34500be968 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -416,7 +416,7 @@ readIfaceArgs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] (src, ',':rest') -> let src' = case src of "" -> Nothing - _ -> Just (src ++ "/%M.html") + _ -> Just src docPaths = DocPaths { docPathsHtml = fpath , docPathsSources = src' }