feat: add auto link
parent
97ddf05ab6
commit
11bb2af57a
|
@ -9,6 +9,8 @@ namespace Output
|
|||
|
||||
open Xml Parser Lean Parsec
|
||||
|
||||
instance : Inhabited Element := ⟨"", Std.RBMap.empty, #[]⟩
|
||||
|
||||
def manyDocument : Parsec (Array Element) := many (prolog *> element <* many Misc) <* eof
|
||||
|
||||
partial def elementToPlainText : Xml.Element → String
|
||||
|
@ -28,50 +30,91 @@ def textToIdAttribute (s : String) : String :=
|
|||
|>.toLower
|
||||
|>.replace " " "-"
|
||||
|
||||
def extendRelativeLink (link : String) (root : String) : String :=
|
||||
-- HACK: better way to detect absolute links
|
||||
if link.startsWith "http" then
|
||||
link
|
||||
else root ++ link
|
||||
|
||||
partial def addAttributes : Element → HtmlM Element
|
||||
| el@(Element.Element name attrs contents) => do
|
||||
-- add id and class to <h_></h_>
|
||||
if name = "h1" ∨ name = "h2" ∨ name = "h3" ∨ name = "h4" ∨ name = "h5" ∨ name = "h6" then
|
||||
let id := textToIdAttribute (elementToPlainText el)
|
||||
let anchorAttributes := Std.RBMap.empty
|
||||
|>.insert "class" "hover-link"
|
||||
|>.insert "href" s!"#{id}"
|
||||
let anchor := Element.Element "a" anchorAttributes #[Content.Character "#"]
|
||||
let newAttrs := attrs
|
||||
|>.insert "id" id
|
||||
|>.insert "class" "markdown-heading"
|
||||
let newContents := (←
|
||||
contents.mapM (λ c => match c with
|
||||
| Content.Element e => (addAttributes e).map (Content.Element)
|
||||
| _ => pure c))
|
||||
|>.push (Content.Element anchor)
|
||||
pure ⟨ name, newAttrs, newContents⟩
|
||||
-- extend relative href for <a></a>
|
||||
else if name = "a" then
|
||||
let root ← getRoot
|
||||
let newAttrs := match attrs.find? "href" with
|
||||
| some href => attrs.insert "href" (extendRelativeLink href root)
|
||||
| none => attrs
|
||||
pure ⟨ name, newAttrs, contents⟩
|
||||
-- recursively modify
|
||||
def possibleNameToLink (s : String) : HtmlM (Option String) := do
|
||||
let res ← getResult
|
||||
let name := s.splitOn "." |>.foldl (λ acc part => Name.mkStr acc part) Name.anonymous
|
||||
if res.name2ModIdx.contains name then
|
||||
declNameToLink name
|
||||
else
|
||||
let newContents ← contents.mapM λ c => match c with
|
||||
| Content.Element e => (addAttributes e).map Content.Element
|
||||
| _ => pure c
|
||||
pure ⟨ name, attrs, newContents ⟩
|
||||
match (← getCurrentName) with
|
||||
| some currentName =>
|
||||
match (res.moduleInfo.find! currentName).members.find? (·.getName.toString.endsWith s) with
|
||||
| some info =>
|
||||
declNameToLink info.getName
|
||||
| _ => pure none
|
||||
| _ => pure none
|
||||
|
||||
def extendRelativeLink (s : String) : HtmlM String := do
|
||||
-- for relative doc links
|
||||
if s.startsWith "#" then
|
||||
if let some link ← possibleNameToLink (s.drop 1) then
|
||||
pure link
|
||||
else
|
||||
pure s
|
||||
-- for absolute and relative urls
|
||||
else if s.startsWith "http" then
|
||||
pure s
|
||||
else pure ((←getRoot) ++ s)
|
||||
|
||||
def possibleNameToAnchor (s : String) : HtmlM Content := do
|
||||
let link? ← possibleNameToLink s
|
||||
match link? with
|
||||
| some link =>
|
||||
let res ← getResult
|
||||
let attributes := Std.RBMap.empty.insert "href" link
|
||||
pure $ Content.Element $ Element.Element "a" attributes #[Content.Character s]
|
||||
| none => pure $ Content.Character s
|
||||
|
||||
partial def modifyElement (element : Element) (linkCode : Bool := true) : HtmlM Element :=
|
||||
match element with
|
||||
| el@(Element.Element name attrs contents) => do
|
||||
-- add id and class to <h_></h_>
|
||||
if name = "h1" ∨ name = "h2" ∨ name = "h3" ∨ name = "h4" ∨ name = "h5" ∨ name = "h6" then
|
||||
let id := textToIdAttribute (elementToPlainText el)
|
||||
let anchorAttributes := Std.RBMap.empty
|
||||
|>.insert "class" "hover-link"
|
||||
|>.insert "href" s!"#{id}"
|
||||
let anchor := Element.Element "a" anchorAttributes #[Content.Character "#"]
|
||||
let newAttrs := attrs
|
||||
|>.insert "id" id
|
||||
|>.insert "class" "markdown-heading"
|
||||
let newContents := (←
|
||||
contents.mapM (λ c => match c with
|
||||
| Content.Element e => (modifyElement e).map (Content.Element)
|
||||
| _ => pure c))
|
||||
|>.push (Content.Character " ")
|
||||
|>.push (Content.Element anchor)
|
||||
pure ⟨ name, newAttrs, newContents⟩
|
||||
-- extend relative href for <a></a>
|
||||
else if name = "a" then
|
||||
let root ← getRoot
|
||||
let newAttrs ← match (attrs.find? "href").map (extendRelativeLink) with
|
||||
| some href => href.map (attrs.insert "href")
|
||||
| none => pure attrs
|
||||
pure ⟨ name, newAttrs, contents⟩
|
||||
-- auto link for inline <code></code>
|
||||
else if name = "code" then
|
||||
let mut newContents := #[]
|
||||
for c in contents do
|
||||
match c with
|
||||
| Content.Character s =>
|
||||
newContents := newContents ++ (← s.splitOn.mapM possibleNameToAnchor)
|
||||
| _ => newContents := newContents.push c
|
||||
pure ⟨ name, attrs, newContents⟩
|
||||
-- recursively modify
|
||||
else
|
||||
let newContents ← contents.mapM λ c => match c with
|
||||
-- disable auto link for code blocks
|
||||
| Content.Element e => (modifyElement e (name ≠ "pre")).map Content.Element
|
||||
| _ => pure c
|
||||
pure ⟨ name, attrs, newContents ⟩
|
||||
|
||||
def docStringToHtml (s : String) : HtmlM (Array Html) := do
|
||||
let rendered := CMark.renderHtml s
|
||||
match manyDocument rendered.mkIterator with
|
||||
| Parsec.ParseResult.success _ res =>
|
||||
res.mapM λ x => do
|
||||
pure (Html.text $ toString (← addAttributes x))
|
||||
pure (Html.text $ toString (← modifyElement x))
|
||||
| _ => pure #[Html.text rendered]
|
||||
|
||||
end Output
|
||||
|
|
Loading…
Reference in New Issue