aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYuchen Pei <hi@ypei.me>2022-09-14 17:03:00 +1000
committerYuchen Pei <hi@ypei.me>2022-09-15 12:46:12 +1000
commit4365659b5ccb1a1ed36cf89c9e93722764bcd777 (patch)
tree1db84d682be218dae27e820102c95e3762b38ded
parentf4c8ccd5fd7eadcddffdfdff169a75adb8d54f1b (diff)
fixing namespace typ and val, and relevant link gen
-rw-r--r--haddock-api/src/Haddock/Backends/Org.hs21
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)]
]