Re-structure qualification code a little

1 files changed, 19 insertions, 20 deletions

diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 849f6a28..32a9f64c 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -44,37 +44,36 @@ ppLDocName qual (L _ d) = ppDocName qual d
 
 
 -- | Render a name depending on the selected qualification mode
-qualifyName :: Qualification -> DocName -> Html
-qualifyName qual docName@(Documented name mdl) = case qual of
+ppQualifyName :: Qualification -> Name -> Module -> Html
+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 -> qualifyName FullQual docName
+    LocalQual Nothing -> ppQualifyName FullQual name mdl
     LocalQual (Just localmdl)
       | moduleString mdl == moduleString localmdl -> ppName name
       | otherwise -> ppFullQualName mdl name
     -- again, this never happens
-    RelativeQual Nothing -> qualifyName FullQual docName
+    RelativeQual Nothing -> ppQualifyName FullQual name mdl
     RelativeQual (Just localmdl) ->
-        case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
-            -- local, A.x -> x
-            Just []      -> qualifyName NoQual 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 FullQual docName
-            -- some other module, D.x -> D.x
-            Nothing      -> qualifyName FullQual docName
-
-qualifyName qual (Undocumented name) = qualifyName qual (Documented name (nameModule name))
+      case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
+        -- local, A.x -> x
+        Just []      -> ppQualifyName NoQual name mdl
+        -- 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
+        -- some other module, D.x -> D.x
+        Nothing      -> ppQualifyName FullQual name mdl
 
 
 ppDocName :: Qualification -> DocName -> Html
-ppDocName qual docName@(Documented name mdl) =
-  linkIdOcc mdl (Just occName) << qualifyName qual docName
-    where occName = nameOccName name
-
-ppDocName qual docName@(Undocumented name) = qualifyName qual docName
+ppDocName qual docName =
+  case docName of
+    Documented name mdl ->
+      linkIdOcc mdl (Just (nameOccName name)) << ppQualifyName qual name mdl
+    Undocumented name -> ppQualifyName qual name (nameModule name)
 
 
 ppFullQualName :: Module -> Name -> Html