aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Xhtml.hs14
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs8
-rw-r--r--src/Haddock/Options.hs10
-rw-r--r--src/Haddock/Types.hs32
-rw-r--r--src/Main.hs3
5 files changed, 41 insertions, 26 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 84468610..686bd36b 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -66,7 +66,7 @@ ppHtml :: String
-> Maybe String -- ^ The contents URL (--use-contents)
-> Maybe String -- ^ The index URL (--use-index)
-> Bool -- ^ Whether to use unicode in output (--use-unicode)
- -> Qualification -- ^ How to qualify names
+ -> QualOption -- ^ How to qualify names
-> Bool -- ^ Output pretty html (newlines and indenting)
-> IO ()
@@ -83,7 +83,7 @@ ppHtml doctitle maybe_package ifaces odir prologue
themes maybe_index_url maybe_source_url maybe_wiki_url
(map toInstalledIface visible_ifaces)
False -- we don't want to display the packages in a single-package contents
- prologue debug qual
+ prologue debug (makeContentsQual qual)
when (isNothing maybe_index_url) $
ppHtmlIndex odir doctitle maybe_package
@@ -461,7 +461,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
ppHtmlModule
:: FilePath -> String -> Themes
-> SourceURLs -> WikiURLs
- -> Maybe String -> Maybe String -> Bool -> Qualification
+ -> Maybe String -> Maybe String -> Bool -> QualOption
-> Bool -> Interface -> IO ()
ppHtmlModule odir doctitle themes
maybe_source_url maybe_wiki_url
@@ -469,10 +469,7 @@ ppHtmlModule odir doctitle themes
let
mdl = ifaceMod iface
mdl_str = moduleString mdl
- real_qual = case qual of
- LocalQual Nothing -> LocalQual (Just mdl)
- RelativeQual Nothing -> RelativeQual (Just mdl)
- _ -> qual
+ real_qual = makeModuleQual qual mdl
html =
headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
bodyHtml doctitle (Just iface)
@@ -484,8 +481,7 @@ ppHtmlModule odir doctitle themes
createDirectoryIfMissing True odir
writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
- ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode qual debug
-
+ ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode real_qual debug
ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
-> Interface -> Bool -> Qualification -> Bool -> IO ()
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 274078a6..9963fffc 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -64,14 +64,10 @@ ppQualifyName qual name mdl =
case qual of
NoQual -> ppName name
FullQual -> ppFullQualName mdl name
- -- this is just in case, it should never happen
- LocalQual Nothing -> ppQualifyName FullQual name mdl
- LocalQual (Just localmdl)
+ LocalQual localmdl
| moduleString mdl == moduleString localmdl -> ppName name
| otherwise -> ppFullQualName mdl name
- -- again, this never happens
- RelativeQual Nothing -> ppQualifyName FullQual name mdl
- RelativeQual (Just localmdl) ->
+ RelativeQual localmdl ->
case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
-- local, A.x -> x
Just [] -> ppQualifyName NoQual name mdl
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 4e42fd32..3292ba16 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -229,13 +229,13 @@ optLaTeXStyle :: [Flag] -> Maybe String
optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ]
-qualification :: [Flag] -> Qualification
+qualification :: [Flag] -> QualOption
qualification flags =
case map (map Char.toLower) [ str | Flag_Qualification str <- flags ] of
- "full":_ -> FullQual
- "local":_ -> LocalQual Nothing
- "relative":_ -> RelativeQual Nothing
- _ -> NoQual
+ "full":_ -> OptFullQual
+ "local":_ -> OptLocalQual
+ "relative":_ -> OptRelativeQual
+ _ -> OptNoQual
verbosity :: [Flag] -> Verbosity
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 22d2f6ae..de0cc3d9 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -374,12 +374,34 @@ data DocOption
-- | Option controlling how to qualify names
+data QualOption
+ = OptNoQual -- ^ Never qualify any names.
+ | OptFullQual -- ^ Qualify all names fully.
+ | OptLocalQual -- ^ Qualify all imported names fully.
+ | OptRelativeQual -- ^ Like local, but strip module prefix
+ -- from modules in the same hierarchy.
+
data Qualification
- = NoQual -- ^ Never qualify any names.
- | FullQual -- ^ Qualify all names fully.
- | LocalQual (Maybe Module) -- ^ Qualify all imported names fully.
- | RelativeQual (Maybe Module) -- ^ Like local, but strip module prefix.
- -- from modules in the same hierarchy.
+ = NoQual
+ | FullQual
+ | LocalQual Module
+ | RelativeQual Module
+ -- ^ @Maybe Module@ contains the current module.
+ -- This way we can distinguish imported and local identifiers.
+
+makeContentsQual :: QualOption -> Qualification
+makeContentsQual qual =
+ case qual of
+ OptNoQual -> NoQual
+ _ -> FullQual
+
+makeModuleQual :: QualOption -> Module -> Qualification
+makeModuleQual qual mdl =
+ case qual of
+ OptLocalQual -> LocalQual mdl
+ OptRelativeQual -> RelativeQual mdl
+ OptFullQual -> FullQual
+ OptNoQual -> NoQual
-----------------------------------------------------------------------------
diff --git a/src/Main.hs b/src/Main.hs
index 0a3c9ffc..e423cf03 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -228,7 +228,8 @@ render flags ifaces installedIfaces srcMap = do
when (Flag_GenContents `elem` flags) $ do
ppHtmlContents odir title pkgStr
themes opt_index_url sourceUrls' opt_wiki_urls
- allVisibleIfaces True prologue pretty opt_qualification
+ allVisibleIfaces True prologue pretty
+ (makeContentsQual opt_qualification)
copyHtmlBits odir libDir themes
when (Flag_Html `elem` flags) $ do