diff options
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..863e5f90 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 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) |