diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-06 17:06:19 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-06 17:06:19 +0200 |
commit | bbd036ad309c95ce70affa5aa0a77a61aa5569c8 (patch) | |
tree | ec8be000511952995f011c575d605bfe682481b7 /haddock-api/src/Haddock/Backends/Hyperlinker | |
parent | 13254609062a16e010d1c5a24e571dfe98ab6f69 (diff) |
Add support for hyperlinking modules in import lists.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs | 21 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs | 10 |
2 files changed, 16 insertions, 15 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs index 1065897d..5037421a 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs @@ -144,14 +144,14 @@ hyperlink srcs details = case rtkName details of if GHC.isInternalName name then internalHyperlink name else externalNameHyperlink srcs name - Right name -> externalModHyperlink name + Right name -> externalModHyperlink srcs name internalHyperlink :: GHC.Name -> Html -> Html internalHyperlink name content = Html.anchor content ! [ Html.href $ "#" ++ internalAnchorIdent name ] externalNameHyperlink :: SrcMap -> GHC.Name -> Html -> Html -externalNameHyperlink srcs name content = case Map.lookup mdl srcs of +externalNameHyperlink (srcs, _) name content = case Map.lookup mdl srcs of Just SrcLocal -> Html.anchor content ! [ Html.href $ hypSrcModuleNameUrl mdl name ] Just (SrcExternal path) -> Html.anchor content ! @@ -160,13 +160,10 @@ externalNameHyperlink srcs name content = case Map.lookup mdl srcs of where mdl = GHC.nameModule name --- TODO: Implement module hyperlinks. --- --- Unfortunately, 'ModuleName' is not enough to provide viable cross-package --- hyperlink. And the problem is that GHC AST does not have other information --- on imported modules, so for the time being, we do not provide such reference --- either. -externalModHyperlink :: GHC.ModuleName -> Html -> Html -externalModHyperlink _ content = - content - --Html.anchor content ! [ Html.href $ hypSrcModuleUrl' mdl ] +externalModHyperlink :: SrcMap -> GHC.ModuleName -> Html -> Html +externalModHyperlink (_, srcs) name content = case Map.lookup name srcs of + Just SrcLocal -> Html.anchor content ! + [ Html.href $ hypSrcModuleUrl' name ] + Just (SrcExternal path) -> Html.anchor content ! + [ Html.href $ path </> hypSrcModuleUrl' name ] + Nothing -> content diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs index ecb51a07..c3954dc9 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs @@ -4,6 +4,7 @@ module Haddock.Backends.Hyperlinker.Types where import qualified GHC import Data.Map (Map) +import qualified Data.Map as Map data Token = Token @@ -66,7 +67,10 @@ rtkName (RtkModule name) = Right name -- Used in 'SrcMap' to determine whether module originates in current package -- or in an external package. data SrcPath - = SrcExternal FilePath - | SrcLocal + = SrcExternal FilePath + | SrcLocal -type SrcMap = Map GHC.Module SrcPath +type SrcMap = (Map GHC.Module SrcPath, Map GHC.ModuleName SrcPath) + +mkSrcMap :: Map GHC.Module SrcPath -> SrcMap +mkSrcMap srcs = (srcs, Map.mapKeys GHC.moduleName srcs) |