import CMark import DocGen4.Output.Template import Lean.Data.Parsec open Lean namespace DocGen4 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 | (Element.Element name attrs contents) => "".intercalate (contents.toList.map contentToPlainText) where contentToPlainText c := match c with | Content.Element el => elementToPlainText el | Content.Comment _ => "" | Content.Character s => s def dropAllCharWhile (s : String) (p : Char → Bool) : String := ⟨ s.data.filter p ⟩ def textToIdAttribute (s : String) : String := dropAllCharWhile s (λ c => (c.isAlphanum ∨ c = '-' ∨ c = ' ')) |>.toLower |>.replace " " "-" def possibleNameToLink (s : String) : HtmlM (Option String) := do let res ← getResult let name := s.splitOn "." |>.foldl (λ acc part => Name.mkStr acc part) Name.anonymous -- with exactly the same name if res.name2ModIdx.contains name then declNameToLink name -- find similar name in the same module else 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 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 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 else if name = "code" ∧ linkCode 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 (← modifyElement x)) | _ => pure #[Html.text rendered] end Output end DocGen4