diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Org.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Org.hs | 55 |
1 files changed, 35 insertions, 20 deletions
diff --git a/haddock-api/src/Haddock/Backends/Org.hs b/haddock-api/src/Haddock/Backends/Org.hs index cdd95d42..f0b91b50 100644 --- a/haddock-api/src/Haddock/Backends/Org.hs +++ b/haddock-api/src/Haddock/Backends/Org.hs @@ -172,17 +172,22 @@ toOrgDocument title mbPrologue pkgId ifaces = processPackage :: String -> Maybe (Doc RdrName) -> String -> [Interface] -> [OrgBlock] processPackage title mbPrologue pkgId ifaces = - headingPlainTextCId title pkgId packageLevel + Heading packageLevel + [plaintext title] + (cIdProp pkgId ++ hackageProp (hackagePackageUrl pkgId)) : Paragraph [plaintext $ maybe [] removeMarkup' mbPrologue] : concatMap processModule (sortOn ifaceMod ifaces) processModule :: Interface -> [OrgBlock] processModule iface = let - mdl = moduleString $ ifaceMod iface - pkg = cleanPkgStr $ unitString $ moduleUnit $ ifaceMod iface - path = (pkg, mdl) - heading = headingPlainTextCId mdl (pkg ++ "." ++ mdl) modLevel + mdl = moduleString $ ifaceMod iface + pkg = cleanPkgStr $ unitString $ moduleUnit $ ifaceMod iface + path = (pkg, mdl) + heading = Heading + modLevel + [plaintext mdl] + (cIdProp (pkg ++ "." ++ mdl) ++ hackageProp (hackageModuleUrl pkg mdl)) description = ppDocumentation (ifaceRnDoc iface) (Just modLevel) exported = evalState (mapM (processExport path) (ifaceRnExportItems iface)) modLevel @@ -466,7 +471,7 @@ ppTyClDecl (DataDecl _ (L _ name) tcdTyVars _ defn@(HsDataDefn { dd_ND = nd, dd_ ) : if gadt then [plaintext " where"] else [] ) - (cIdPaths path name) + (cIdPaths path name ++ hackageUrlProp path name) ] ++ ppDocForDecl docs (Just level) ++ ppDataDefn defn subdocs path (level + 1) @@ -489,7 +494,7 @@ ppTyClDecl (SynDecl _ (L _ name) tcdTyVars _fixity (L _ rhs)) docs _ path level ) ++ ppHsType rhs ) - (cIdPaths path name) + (cIdPaths path name ++ hackageUrlProp path name) ] ++ ppDocForDecl docs (Just level) -- class @@ -504,7 +509,7 @@ ppTyClDecl (ClassDecl {..}) docs subdocs path level = , intersperse Whitespace (map (Plain . ppName) (tyvarNames tcdTyVars)) ] ) - (cIdPaths path (unLoc tcdLName)) + (cIdPaths path (unLoc tcdLName) ++ hackageUrlProp path (unLoc tcdLName)) ] ++ ppDocForDecl docs (Just level) -- TODO: do we need an aDoc here instead of M.empty? @@ -523,7 +528,7 @@ ppTyClDecl (FamDecl _ (FamilyDecl _ (ClosedTypeFamily mbEqns) TopLevel (L _ name ++ maybe [] ppLInjectivityAnn mbInj ++ [plaintext " where"] ) - (cIdPaths path name) + (cIdPaths path name ++ hackageUrlProp path name) : ppDocForDecl docs (Just level) ++ concatMap (\x -> ppLTyFamInstEqn x subdocs path (level + 1)) (fromMaybe [] mbEqns) @@ -538,7 +543,7 @@ ppTyClDecl (FamDecl _ (FamilyDecl _ info TopLevel (L _ name) tyvars _fixity (L _ ++ ppFamilyResultSig resSig op ++ maybe [] ppLInjectivityAnn mbInj ) - (cIdPaths path name) + (cIdPaths path name ++ hackageUrlProp path name) : ppDocForDecl docs (Just level) where pre = case info of @@ -722,7 +727,9 @@ ppSig (TypeSig _ lhs rhs) (doc, aDoc) _ path level = ] ++ (ppHsSigType hsSig) ) - (concatMap (cIdPaths path . unLoc) lhs) + ( concatMap (cIdPaths path . unLoc) lhs + ++ concatMap (hackageUrlProp path . unLoc) lhs + ) : (if M.null aDoc then [] else ppHsSigTypeDoc hsSig aDoc) ++ ppDocumentation doc (Just level) where hsSig = unLoc (dropWildCards rhs) @@ -755,7 +762,9 @@ ppSig (PatSynSig _ names (L _ hsSig)) (doc, aDoc) _ path level = ] ++ (ppHsSigType hsSig) ) - (concatMap (cIdPaths path . unLoc) names) + ( concatMap (cIdPaths path . unLoc) names + ++ concatMap (hackageUrlProp path . unLoc) names + ) : (if M.null aDoc then [] else ppHsSigTypeDoc hsSig aDoc) ++ ppDocumentation doc (Just level) @@ -997,15 +1006,21 @@ removeHash :: String -> String removeHash s | length s > 65 = take (length s - 65) s removeHash s = s -hackageUrl :: String -> String -> String -> Bool -> String +hackagePackageUrl :: String -> String +hackagePackageUrl pkg = "https://hackage.haskell.org/package/" ++ pkg + +hackageModuleUrl :: String -> String -> String +hackageModuleUrl pkg mdl = + hackagePackageUrl pkg ++ "/docs/" ++ dotsToDashes mdl ++ ".html" + where dotsToDashes = map (\c -> if c == '.' then '-' else c) + +hackageUrl :: String -> String -> String -> String -- module should be of the form GHC-Hs-Decls instead of GHC.Hs.Decls -hackageUrl pkg mdl id isSub = - "https://hackage.haskell.org/package/" - ++ pkg - ++ "/docs/" - ++ mdl - ++ ".html#" - ++ if isSub then "v" else "t" ++ ":" ++ id +hackageUrl pkg mdl id = hackageModuleUrl pkg mdl ++ "#t:" ++ id + +hackageUrlProp :: ModPath -> DocName -> Properties +hackageUrlProp (pkg, mdl) name = + hackageProp (hackageUrl pkg mdl (docNameToString name)) -- * Orphan instances for show |