diff options
author | Jade Lovelace <software@lfcode.ca> | 2022-05-07 08:42:08 -0700 |
---|---|---|
committer | GitHub <noreply@github.com> | 2022-05-07 17:42:08 +0200 |
commit | ab53ccf089ea703b767581ac14be0f6c78a7678a (patch) | |
tree | de661f1a172c5f39370d6ca11ec7baadaf15ceae /haddock-api | |
parent | 09b8abe04fc34460ccf3c4ed4d35bceb1bc6b718 (diff) |
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
```
Diffstat (limited to 'haddock-api')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 623cd75b..a8a51e5d 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -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 |