diff options
author | Henning Thielemann <git@henning-thielemann.de> | 2012-04-01 22:03:25 +0200 |
---|---|---|
committer | Henning Thielemann <git@henning-thielemann.de> | 2012-04-01 22:03:25 +0200 |
commit | 979ada5bc63cba38bf570f943a3666298879bdc9 (patch) | |
tree | 67f86313b43e70306e26f9a80b5c32de2c3ad5b4 /src/Haddock/Backends/Xhtml | |
parent | e9898d45575458d49eb2119923c8c1adbc581065 (diff) |
'abbreviate' qualification style - basic support
Currently we ignore the package a module is imported from.
This means that a module import would shadow another one
with the same module name from a different package.
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 9963fffc..88ba14dc 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.Map as M import qualified Data.List as List import GHC @@ -64,24 +65,33 @@ ppQualifyName qual name mdl = case qual of NoQual -> ppName name FullQual -> ppFullQualName mdl name - LocalQual localmdl - | moduleString mdl == moduleString localmdl -> ppName name - | otherwise -> ppFullQualName mdl name + LocalQual localmdl -> + if moduleString mdl == moduleString localmdl + then ppName name + else ppFullQualName mdl name RelativeQual localmdl -> case List.stripPrefix (moduleString localmdl) (moduleString mdl) of -- local, A.x -> x - Just [] -> ppQualifyName NoQual name mdl + Just [] -> ppName name -- sub-module, A.B.x -> B.x Just ('.':m) -> toHtml $ m ++ '.' : getOccString name -- some module with same prefix, ABC.x -> ABC.x - Just _ -> ppQualifyName FullQual name mdl + Just _ -> ppFullQualName mdl name -- some other module, D.x -> D.x - Nothing -> ppQualifyName FullQual name mdl + Nothing -> ppFullQualName mdl name + AbbreviateQual abbrevs localmdl -> + case (moduleString mdl == moduleString localmdl, + M.lookup (moduleName mdl) abbrevs) of + (False, Just abbrev) -> ppQualName abbrev name + _ -> ppName name ppFullQualName :: Module -> Name -> Html ppFullQualName mdl name = toHtml $ moduleString mdl ++ '.' : getOccString name +ppQualName :: ModuleName -> Name -> Html +ppQualName mdlName name = + toHtml $ moduleNameString mdlName ++ '.' : getOccString name ppName :: Name -> Html ppName name = toHtml (getOccString name) |