diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Org.hs | 21 |
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 70231743..dbca2a66 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 @@ -467,19 +472,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] @@ -949,10 +955,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)] ] |