Skip to content
Snippets Groups Projects
Unverified Commit ab53ccf0 authored by Jade Lovelace's avatar Jade Lovelace Committed by GitHub
Browse files

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
```
parent 09b8abe0
No related branches found
No related tags found
No related merge requests found
......@@ -23,6 +23,7 @@ import System.FilePath.Posix ((</>))
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.List as List
import Text.XHtml (Html, HtmlAttr, (!))
import qualified Text.XHtml as Html
......@@ -248,14 +249,20 @@ hyperlink (srcs, srcs') ident = case ident of
Left name -> externalModHyperlink name
where
-- In a Nix environment, we have file:// URLs with absolute paths
makeHyperlinkUrl url | List.isPrefixOf "file://" url = url
makeHyperlinkUrl url = ".." </> url
internalHyperlink name content =
Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
externalNameHyperlink name content = case Map.lookup mdl srcs of
Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleNameUrl mdl name ]
Just (SrcExternal path) -> Html.anchor content !
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing (".." </> path) ]
Just (SrcExternal path) ->
let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleNameUrl mdl name
in Html.anchor content !
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing hyperlinkUrl ]
Nothing -> content
where
mdl = nameModule name
......@@ -264,8 +271,10 @@ hyperlink (srcs, srcs') ident = case ident of
case Map.lookup moduleName srcs' of
Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleUrl' moduleName ]
Just (SrcExternal path) -> Html.anchor content !
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing (".." </> path) ]
Just (SrcExternal path) ->
let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleUrl' moduleName
in Html.anchor content !
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing hyperlinkUrl ]
Nothing -> content
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment