diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index 12f37cedf9a7a93614753889ee29bd395a5a6aba..d77990d1a22bd94b67d667103c3f18c4e6c17651 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -24,6 +24,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
@@ -249,14 +250,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
@@ -265,8 +272,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