[Git][ghc/ghc][wip/24907] haddock: Add name anchor to external source urls from documentation page

[Zubin (@wz1000)]

Zubin pushed to branch wip/24907 at Glasgow Haskell Compiler / GHC


Commits:
9ee19631 by Zubin Duggal at 2024-05-31T12:54:40+05:30
haddock: Add name anchor to external source urls from documentation page

URLs for external source links from documentation pages were missing a splice
location for the name.

Fixes #24912

- - - - -


3 changed files:

- utils/haddock/haddock-api/src/Haddock.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Options.hs


Changes:

=====================================
utils/haddock/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


=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
=====================================
@@ -14,6 +14,7 @@ module Haddock.Backends.Hyperlinker.Utils
   , hypSrcModuleNameUrlFormat
   , hypSrcModuleLineUrlFormat
   , hypSrcModuleUrlToNameFormat
+  , hypSrcPkgUrlToModuleFormat
   , spliceURL
   , spliceURL'
 
@@ -86,6 +87,9 @@ hypSrcModuleLineUrlFormat = hypSrcModuleUrlFormat ++ "#" ++ lineFormat
 hypSrcModuleUrlToNameFormat :: String -> String
 hypSrcModuleUrlToNameFormat url = url ++ "#" ++ nameFormat
 
+hypSrcPkgUrlToModuleFormat :: String -> String
+hypSrcPkgUrlToModuleFormat url = url </> moduleFormat
+
 moduleFormat :: String
 moduleFormat = "%{MODULE}.html"
 


=====================================
utils/haddock/haddock-api/src/Haddock/Options.hs
=====================================
@@ -563,7 +563,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'
                                       }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ee196310f4c64e4e584f1a11f60396fe8be7639

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ee196310f4c64e4e584f1a11f60396fe8be7639
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240531/3dadc43b/attachment-0001.html>