feat: add auto link

main
Xubai Wang 2022-02-18 00:46:02 +08:00
parent 97ddf05ab6
commit 11bb2af57a
1 changed files with 80 additions and 37 deletions

View File

@ -9,6 +9,8 @@ namespace Output
open Xml Parser Lean Parsec open Xml Parser Lean Parsec
instance : Inhabited Element := ⟨"", Std.RBMap.empty, #[]⟩
def manyDocument : Parsec (Array Element) := many (prolog *> element <* many Misc) <* eof def manyDocument : Parsec (Array Element) := many (prolog *> element <* many Misc) <* eof
partial def elementToPlainText : Xml.Element → String partial def elementToPlainText : Xml.Element → String
@ -28,50 +30,91 @@ def textToIdAttribute (s : String) : String :=
|>.toLower |>.toLower
|>.replace " " "-" |>.replace " " "-"
def extendRelativeLink (link : String) (root : String) : String := def possibleNameToLink (s : String) : HtmlM (Option String) := do
-- HACK: better way to detect absolute links let res ← getResult
if link.startsWith "http" then let name := s.splitOn "." |>.foldl (λ acc part => Name.mkStr acc part) Name.anonymous
link if res.name2ModIdx.contains name then
else root ++ link declNameToLink name
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
else else
let newContents ← contents.mapM λ c => match c with match (← getCurrentName) with
| Content.Element e => (addAttributes e).map Content.Element | some currentName =>
| _ => pure c match (res.moduleInfo.find! currentName).members.find? (·.getName.toString.endsWith s) with
pure ⟨ name, attrs, newContents ⟩ | 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 def docStringToHtml (s : String) : HtmlM (Array Html) := do
let rendered := CMark.renderHtml s let rendered := CMark.renderHtml s
match manyDocument rendered.mkIterator with match manyDocument rendered.mkIterator with
| Parsec.ParseResult.success _ res => | Parsec.ParseResult.success _ res =>
res.mapM λ x => do res.mapM λ x => do
pure (Html.text $ toString (← addAttributes x)) pure (Html.text $ toString (← modifyElement x))
| _ => pure #[Html.text rendered] | _ => pure #[Html.text rendered]
end Output end Output