Skip to content
Snippets Groups Projects
Commit 2036454b authored by Jade Lovelace's avatar Jade Lovelace Committed by Douglas Wilson
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
```

(cherry picked from commit ab53ccf0)
parent 2368e932
No related branches found
No related tags found
No related merge requests found
...@@ -24,6 +24,7 @@ import System.FilePath.Posix ((</>)) ...@@ -24,6 +24,7 @@ import System.FilePath.Posix ((</>))
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.List as List
import Text.XHtml (Html, HtmlAttr, (!)) import Text.XHtml (Html, HtmlAttr, (!))
import qualified Text.XHtml as Html import qualified Text.XHtml as Html
...@@ -249,14 +250,20 @@ hyperlink (srcs, srcs') ident = case ident of ...@@ -249,14 +250,20 @@ hyperlink (srcs, srcs') ident = case ident of
Left name -> externalModHyperlink name Left name -> externalModHyperlink name
where 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 = internalHyperlink name content =
Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ] Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ]
externalNameHyperlink name content = case Map.lookup mdl srcs of externalNameHyperlink name content = case Map.lookup mdl srcs of
Just SrcLocal -> Html.anchor content ! Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleNameUrl mdl name ] [ Html.href $ hypSrcModuleNameUrl mdl name ]
Just (SrcExternal path) -> Html.anchor content ! Just (SrcExternal path) ->
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing (".." </> path) ] let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleNameUrl mdl name
in Html.anchor content !
[ Html.href $ spliceURL Nothing (Just mdl) (Just name) Nothing hyperlinkUrl ]
Nothing -> content Nothing -> content
where where
mdl = nameModule name mdl = nameModule name
...@@ -265,8 +272,10 @@ hyperlink (srcs, srcs') ident = case ident of ...@@ -265,8 +272,10 @@ hyperlink (srcs, srcs') ident = case ident of
case Map.lookup moduleName srcs' of case Map.lookup moduleName srcs' of
Just SrcLocal -> Html.anchor content ! Just SrcLocal -> Html.anchor content !
[ Html.href $ hypSrcModuleUrl' moduleName ] [ Html.href $ hypSrcModuleUrl' moduleName ]
Just (SrcExternal path) -> Html.anchor content ! Just (SrcExternal path) ->
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing (".." </> path) ] let hyperlinkUrl = makeHyperlinkUrl path </> hypSrcModuleUrl' moduleName
in Html.anchor content !
[ Html.href $ spliceURL' Nothing (Just moduleName) Nothing Nothing hyperlinkUrl ]
Nothing -> content 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