Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.

Commit 2036454

Browse files
lf-duog
authored andcommitted
Fix hyperlinks to external items and modules (#1482)
Fixes #1481. There were two bugs in this: * We were assuming that we were always getting a relative path to the module in question, while Nix gives us file:// URLs sometimes. This change checks for those and stops prepending `..` to them. * We were not linking to the file under the module. This seems to have been a regression introduced by #977. That is, the URLs were going to something like file:///nix/store/3bwbsy0llxxn1pixx3ll02alln56ivxy-ghc-9.0.2-doc/share/doc/ghc/html/libraries/base-4.15.1.0/src which does not have the appropriate HTML file or fragment for the item in question at the end. There is a remaining instance of the latter bug, but not in the hyperlinker: the source links to items reexported from other modules are also not including the correct file name. e.g. the reexport of Entity in esqueleto, from persistent. NOTE: This needs to get tested with relative-path located modules. It seems correct for Nix based on my testing. Testing strategy: ``` nix-shell '<nixpkgs>' --pure -A haskell.packages.ghc922.aeson mkdir /tmp/aesonbuild && cd /tmp/aesonbuild export out=/tmp/aesonbuild/out genericBuild ln -sf $HOME/co/haddock/haddock-api/resources . ./Setup haddock --with-haddock=$HOME/path/to/haddock/exec --hyperlink-source ``` (cherry picked from commit ab53ccf)
1 parent 2368e93 commit 2036454

File tree

1 file changed

+13
-4
lines changed
  • haddock-api/src/Haddock/Backends/Hyperlinker

1 file changed

+13
-4
lines changed

haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import System.FilePath.Posix ((</>))
2424

2525
import qualified Data.Map as Map
2626
import qualified Data.Set as Set
27+
import qualified Data.List as List
2728

2829
import Text.XHtml (Html, HtmlAttr, (!))
2930
import qualified Text.XHtml as Html
@@ -249,14 +250,20 @@ hyperlink (srcs, srcs') ident = case ident of
249250
Left name -> externalModHyperlink name
250251

251252
where
253+
-- In a Nix environment, we have file:// URLs with absolute paths
254+
makeHyperlinkUrl url | List.isPrefixOf "file://" url = url
255+
makeHyperlinkUrl url = ".." </> url
256+
252257
internalHyperlink name content =
253258
Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
254259

255260
externalNameHyperlink name content = case Map.lookup mdl srcs of
256261
Just SrcLocal -> Html.anchor content !
257262
[ Html.href $ hypSrcModuleNameUrl mdl name ]
258-
Just (SrcExternal path) -> Html.anchor content !
259-
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing (".." </> path) ]
263+
Just (SrcExternal path) ->
264+
let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleNameUrl mdl name
265+
in Html.anchor content !
266+
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing hyperlinkUrl ]
260267
Nothing -> content
261268
where
262269
mdl = nameModule name
@@ -265,8 +272,10 @@ hyperlink (srcs, srcs') ident = case ident of
265272
case Map.lookup moduleName srcs' of
266273
Just SrcLocal -> Html.anchor content !
267274
[ Html.href $ hypSrcModuleUrl' moduleName ]
268-
Just (SrcExternal path) -> Html.anchor content !
269-
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing (".." </> path) ]
275+
Just (SrcExternal path) ->
276+
let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleUrl' moduleName
277+
in Html.anchor content !
278+
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing hyperlinkUrl ]
270279
Nothing -> content
271280

272281

0 commit comments

Comments
 (0)