diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -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 12f37ced..d77990d1 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 | 
