diff options
author | David Waern <david.waern@gmail.com> | 2012-04-02 01:05:47 +0200 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2012-04-02 01:05:47 +0200 |
commit | 4b82bad435e629c3cd65782c8ffb9bae8a7e16b4 (patch) | |
tree | 0cd22cdf721497454c10de78b37b2830d3901aea /src/Haddock/Backends/Xhtml/Names.hs | |
parent | 162364b177c3982c67c842d310aead45434a3760 (diff) | |
parent | 979ada5bc63cba38bf570f943a3666298879bdc9 (diff) |
Merge http://code.haskell.org/~thielema/haddock/ into ghc-7.4
Diffstat (limited to 'src/Haddock/Backends/Xhtml/Names.hs')
-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) |