fixing namespace typ and val, and relevant link gen

1 files changed, 13 insertions, 8 deletions

diff --git a/haddock-api/src/Haddock/Backends/Org.hs b/haddock-api/src/Haddock/Backends/Org.hs
index 73989615..c1efefa1 100644
--- a/haddock-api/src/Haddock/Backends/Org.hs
+++ b/haddock-api/src/Haddock/Backends/Org.hs
@@ -97,9 +97,11 @@ import           GHC.Data.FastString            ( unpackFS )
 import           GHC.Types.Basic                ( PromotionFlag(..)
                                                 , TopLevelFlag(..)
                                                 )
-import           GHC.Types.Name                 ( isDataConName
+import           GHC.Types.Name                 ( HasOccName
+                                                , isValOcc
                                                 , nameModule_maybe
                                                 , nameOccName
+                                                , occName
                                                 )
 import           GHC.Types.Name.Occurrence      ( OccName
                                                 , occNameString
@@ -175,6 +177,9 @@ unimpHeading thing level = headingPlainText (unimp thing) level
 emptyDoc :: DocForDecl DocName
 emptyDoc = (Documentation Nothing Nothing, M.empty)
 
+idPathSep :: String
+idPathSep = "/"
+
 -- The main function
 ppOrg
   :: String
@@ -465,19 +470,20 @@ mbMDocHasDoc _                           = True
 parensIfMany :: [a] -> [OrgInline] -> [OrgInline]
 parensIfMany xs org = if length xs > 1 then orgParens org else org
 
-dcSuffix :: DocName -> String
-dcSuffix name = if isDataConName (getName name) then ":dc" else ""
+valOrTyp :: HasOccName n => n -> String
+valOrTyp name = if isValOcc (occName name) then "v" else "t"
 
 idPath :: ModPath -> DocName -> String
 idPath (pkg, mdl) name =
-  pkg ++ "." ++ mdl ++ "." ++ docNameToString name ++ dcSuffix name
+  intercalate idPathSep [pkg, mdl, valOrTyp name, docNameToString name]
 
 idPath' :: Module -> DocName -> String
 idPath' mdl name =
   idPath (cleanPkgStr $ unitString $ moduleUnit mdl, moduleString mdl) name
 
-idPathNoPkg :: String -> DocName -> String
-idPathNoPkg mdl name = mdl ++ "." ++ docNameToString name ++ dcSuffix name
+idPathNoPkg :: HasOccName n => String -> n -> String
+idPathNoPkg mdl name =
+  intercalate idPathSep [mdl, valOrTyp name, occNameString (occName name)]
 
 cIdPaths :: ModPath -> DocName -> Properties
 cIdPaths path@(_, mdl) name = cIdsProp [idPath path name, idPathNoPkg mdl name]
@@ -948,10 +954,9 @@ ppDocName docName@(Undocumented name) = case nameModule_maybe name of
   Nothing  -> [Plain $ docNameToDoc docName]
   Just mdl -> ppDocName (Documented name mdl)
 
--- TODO: determine whether it's a subordinate based on NameSpace
 ppMO :: (ModuleName, OccName) -> [OrgInline]
 ppMO (mdl, occ) =
-  [ Link (text $ "#" ++ moToString (mdl, occ))
+  [ Link (text $ "#" ++ idPathNoPkg (moduleNameString mdl) occ)
          [plaintext $ moToString (mdl, occ)]
   ]