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

Fix hyperlinks to external items and modules #1482

Merged
merged 1 commit into from
May 7, 2022
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 13 additions & 4 deletions haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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


Expand Down