aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Xhtml.hs6
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs39
2 files changed, 37 insertions, 8 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 452fdfa0..433ea212 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -458,13 +458,17 @@ ppHtmlModule odir doctitle themes
let
mdl = ifaceMod iface
mdl_str = moduleString mdl
+ real_quali = case quali of
+ LocalQuali Nothing -> LocalQuali (Just mdl)
+ RelativeQuali Nothing -> RelativeQuali (Just mdl)
+ _ -> quali
html =
headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
bodyHtml doctitle (Just iface)
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url << [
divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)),
- ifaceToHtml maybe_source_url maybe_wiki_url iface unicode quali
+ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_quali
]
createDirectoryIfMissing True odir
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 6df32fc4..016aac14 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -24,6 +24,7 @@ import Haddock.Types
import Haddock.Utils
import Text.XHtml hiding ( name, title, p, quote )
+import qualified Data.List as List
import GHC
import Name
@@ -41,18 +42,42 @@ ppRdrName = ppOccName . rdrNameOcc
ppLDocName :: Qualification -> Located DocName -> Html
ppLDocName quali (L _ d) = ppDocName quali d
+-- | Render a name depending on the selected qualification mode
+qualifyName :: Qualification -> DocName -> Html
+qualifyName quali docName@(Documented name mdl) = case quali of
+ NoQuali -> ppName name
+ FullQuali -> ppFullQualName mdl name
+ -- this is just in case, it should never happen
+ LocalQuali Nothing -> qualifyName FullQuali docName
+ LocalQuali (Just localmdl) ->
+ if (moduleString mdl == moduleString localmdl)
+ then ppName name
+ else ppFullQualName mdl name
+ -- again, this never happens
+ RelativeQuali Nothing -> qualifyName FullQuali docName
+ RelativeQuali (Just localmdl) ->
+ case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
+ -- local, A.x -> x
+ Just [] -> qualifyName NoQuali docName
+ -- sub-module, A.B.x -> B.x
+ Just ('.':m) -> toHtml $ m ++ '.' : getOccString name
+ -- some module with same prefix, ABC.x -> ABC.x
+ Just _ -> qualifyName FullQuali docName
+ -- some other module, D.x -> D.x
+ Nothing -> qualifyName FullQuali docName
+
+-- this is just for exhaustiveness, but already handled by ppDocName
+qualifyName _ (Undocumented name) = ppName name
ppDocName :: Qualification -> DocName -> Html
-ppDocName quali (Documented name mdl) =
- linkIdOcc mdl (Just occName) << theName
+ppDocName quali docName@(Documented name mdl) =
+ linkIdOcc mdl (Just occName) << qualifyName quali docName
where occName = nameOccName name
- theName = case quali of
- NoQuali -> ppName name
- FullQuali -> ppQualName mdl name
+
ppDocName _ (Undocumented name) = ppName name
-ppQualName :: Module -> Name -> Html
-ppQualName mdl name = toHtml $ moduleString mdl ++ '.' : getOccString name
+ppFullQualName :: Module -> Name -> Html
+ppFullQualName mdl name = toHtml $ moduleString mdl ++ '.' : getOccString name
ppName :: Name -> Html
ppName name = toHtml (getOccString name)