style: Lean 4 compiler style in output

main
Henrik Böving 2023-01-01 19:51:01 +01:00
parent 3a5c0db46b
commit f74443a673
13 changed files with 146 additions and 148 deletions

View File

@ -66,10 +66,10 @@ def HtmlM.run (x : HtmlM α) (ctx : SiteContext) (baseCtx : SiteBaseContext) :
ReaderT.run x ctx |>.run baseCtx |>.run ReaderT.run x ctx |>.run baseCtx |>.run
instance [Monad m] : MonadLift HtmlM (HtmlT m) where instance [Monad m] : MonadLift HtmlM (HtmlT m) where
monadLift x := do pure <| x.run (←readThe SiteContext) (←readThe SiteBaseContext) monadLift x := do return x.run (← readThe SiteContext) (← readThe SiteBaseContext)
instance [Monad m] : MonadLift BaseHtmlM (BaseHtmlT m) where instance [Monad m] : MonadLift BaseHtmlM (BaseHtmlT m) where
monadLift x := do pure <| x.run (←readThe SiteBaseContext) monadLift x := do return x.run (← readThe SiteBaseContext)
/-- /--
Obtains the root URL as a relative one to the current depth. Obtains the root URL as a relative one to the current depth.
@ -81,11 +81,11 @@ def getRoot : BaseHtmlM String := do
let d <- SiteBaseContext.depthToRoot <$> read let d <- SiteBaseContext.depthToRoot <$> read
return (go d) return (go d)
def getHierarchy : BaseHtmlM Hierarchy := do pure (←read).hierarchy def getHierarchy : BaseHtmlM Hierarchy := do return (← read).hierarchy
def getCurrentName : BaseHtmlM (Option Name) := do pure (←read).currentName def getCurrentName : BaseHtmlM (Option Name) := do return (← read).currentName
def getResult : HtmlM AnalyzerResult := do pure (←read).result def getResult : HtmlM AnalyzerResult := do return (← read).result
def getSourceUrl (module : Name) (range : Option DeclarationRange): HtmlM String := do pure <| (←read).sourceLinker module range def getSourceUrl (module : Name) (range : Option DeclarationRange): HtmlM String := do return (← read).sourceLinker module range
def leanInkEnabled? : HtmlM Bool := do pure (←read).leanInkEnabled def leanInkEnabled? : HtmlM Bool := do return (← read).leanInkEnabled
/-- /--
If a template is meant to be extended because it for example only provides the If a template is meant to be extended because it for example only provides the
@ -102,20 +102,20 @@ Returns the doc-gen4 link to a module name.
-/ -/
def moduleNameToLink (n : Name) : BaseHtmlM String := do def moduleNameToLink (n : Name) : BaseHtmlM String := do
let parts := n.components.map Name.toString let parts := n.components.map Name.toString
pure <| (← getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html" return (← getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html"
/-- /--
Returns the HTML doc-gen4 link to a module name. Returns the HTML doc-gen4 link to a module name.
-/ -/
def moduleToHtmlLink (module : Name) : BaseHtmlM Html := do def moduleToHtmlLink (module : Name) : BaseHtmlM Html := do
pure <a href={←moduleNameToLink module}>{module.toString}</a> return <a href={← moduleNameToLink module}>{module.toString}</a>
/-- /--
Returns the LeanInk link to a module name. Returns the LeanInk link to a module name.
-/ -/
def moduleNameToInkLink (n : Name) : BaseHtmlM String := do def moduleNameToInkLink (n : Name) : BaseHtmlM String := do
let parts := "src" :: n.components.map Name.toString let parts := "src" :: n.components.map Name.toString
pure <| (← getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html" return (← getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html"
/-- /--
Returns the path to the HTML file that contains information about a module. Returns the path to the HTML file that contains information about a module.
@ -158,13 +158,13 @@ Returns the doc-gen4 link to a declaration name.
def declNameToLink (name : Name) : HtmlM String := do def declNameToLink (name : Name) : HtmlM String := do
let res ← getResult let res ← getResult
let module := res.moduleNames[res.name2ModIdx.find! name |>.toNat]! let module := res.moduleNames[res.name2ModIdx.find! name |>.toNat]!
pure <| (←moduleNameToLink module) ++ "#" ++ name.toString return (← moduleNameToLink module) ++ "#" ++ name.toString
/-- /--
Returns the HTML doc-gen4 link to a declaration name. Returns the HTML doc-gen4 link to a declaration name.
-/ -/
def declNameToHtmlLink (name : Name) : HtmlM Html := do def declNameToHtmlLink (name : Name) : HtmlM Html := do
pure <a href={←declNameToLink name}>{name.toString}</a> return <a href={← declNameToLink name}>{name.toString}</a>
/-- /--
Returns the LeanInk link to a declaration name. Returns the LeanInk link to a declaration name.
@ -172,14 +172,14 @@ Returns the LeanInk link to a declaration name.
def declNameToInkLink (name : Name) : HtmlM String := do def declNameToInkLink (name : Name) : HtmlM String := do
let res ← getResult let res ← getResult
let module := res.moduleNames[res.name2ModIdx.find! name |>.toNat]! let module := res.moduleNames[res.name2ModIdx.find! name |>.toNat]!
pure <| (←moduleNameToInkLink module) ++ "#" ++ name.toString return (← moduleNameToInkLink module) ++ "#" ++ name.toString
/-- /--
Returns the HTML doc-gen4 link to a declaration name with "break_within" Returns the HTML doc-gen4 link to a declaration name with "break_within"
set as class. set as class.
-/ -/
def declNameToHtmlBreakWithinLink (name : Name) : HtmlM Html := do def declNameToHtmlBreakWithinLink (name : Name) : HtmlM Html := do
pure <a class="break_within" href={←declNameToLink name}>{name.toString}</a> return <a class="break_within" href={← declNameToLink name}>{name.toString}</a>
/-- /--
In Lean syntax declarations the following pattern is quite common: In Lean syntax declarations the following pattern is quite common:
@ -207,8 +207,8 @@ to as much information as possible.
-/ -/
partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
match i with match i with
| .text t => pure #[Html.escape t] | .text t => return #[Html.escape t]
| .append tt => tt.foldlM (λ acc t => do pure <| acc ++ (←infoFormatToHtml t)) #[] | .append tt => tt.foldlM (fun acc t => do return acc ++ (← infoFormatToHtml t)) #[]
| .tag a t => | .tag a t =>
match a.info.val.info with match a.info.val.info with
| Info.ofTermInfo i => | Info.ofTermInfo i =>
@ -217,16 +217,16 @@ partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
| .const name _ => | .const name _ =>
-- TODO: this is some very primitive blacklisting but real Blacklisting needs MetaM -- TODO: this is some very primitive blacklisting but real Blacklisting needs MetaM
-- find a better solution -- find a better solution
if (←getResult).name2ModIdx.contains name then if (← getResult).name2ModIdx.contains name then
match t with match t with
| .text t => | .text t =>
let (front, t, back) := splitWhitespaces <| Html.escape t let (front, t, back) := splitWhitespaces <| Html.escape t
let elem := <a href={←declNameToLink name}>{t}</a> let elem := <a href={← declNameToLink name}>{t}</a>
pure #[Html.text front, elem, Html.text back] return #[Html.text front, elem, Html.text back]
| _ => | _ =>
pure #[<a href={←declNameToLink name}>[←infoFormatToHtml t]</a>] return #[<a href={← declNameToLink name}>[← infoFormatToHtml t]</a>]
else else
pure #[<span class="fn">[←infoFormatToHtml t]</span>] return #[<span class="fn">[← infoFormatToHtml t]</span>]
| .sort _ => | .sort _ =>
match t with match t with
| .text t => | .text t =>
@ -234,21 +234,21 @@ partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
let sortLink := <a href={s!"{← getRoot}foundational_types.html"}>{sortPrefix}</a> let sortLink := <a href={s!"{← getRoot}foundational_types.html"}>{sortPrefix}</a>
if rest != [] then if rest != [] then
rest := " " :: rest rest := " " :: rest
pure #[sortLink, Html.text <| String.join rest] return #[sortLink, Html.text <| String.join rest]
| _ => | _ =>
pure #[<a href={s!"{← getRoot}foundational_types.html"}>[← infoFormatToHtml t]</a>] return #[<a href={s!"{← getRoot}foundational_types.html"}>[← infoFormatToHtml t]</a>]
| _ => | _ =>
pure #[<span class="fn">[←infoFormatToHtml t]</span>] return #[<span class="fn">[← infoFormatToHtml t]</span>]
| _ => pure #[<span class="fn">[←infoFormatToHtml t]</span>] | _ => return #[<span class="fn">[← infoFormatToHtml t]</span>]
def baseHtmlHeadDeclarations : BaseHtmlM (Array Html) := do def baseHtmlHeadDeclarations : BaseHtmlM (Array Html) := do
pure #[ return #[
<meta charset="UTF-8"/>, <meta charset="UTF-8"/>,
<meta name="viewport" content="width=device-width, initial-scale=1"/>, <meta name="viewport" content="width=device-width, initial-scale=1"/>,
<link rel="stylesheet" href={s!"{←getRoot}style.css"}/>, <link rel="stylesheet" href={s!"{← getRoot}style.css"}/>,
<link rel="stylesheet" href={s!"{←getRoot}src/pygments.css"}/>, <link rel="stylesheet" href={s!"{← getRoot}src/pygments.css"}/>,
<link rel="shortcut icon" href={s!"{←getRoot}favicon.ico"}/>, <link rel="shortcut icon" href={s!"{← getRoot}favicon.ico"}/>,
<link rel="prefetch" href={s!"{←getRoot}/declarations/declaration-data.bmp"} as="image"/> <link rel="prefetch" href={s!"{← getRoot}/declarations/declaration-data.bmp"} as="image"/>
] ]
end DocGen4.Output end DocGen4.Output

View File

@ -12,7 +12,7 @@ open Lean Widget
def equationLimit : Nat := 200 def equationLimit : Nat := 200
def equationToHtml (c : CodeWithInfos) : HtmlM Html := do def equationToHtml (c : CodeWithInfos) : HtmlM Html := do
pure <li class="equation">[←infoFormatToHtml c]</li> return <li class="equation">[← infoFormatToHtml c]</li>
/-- /--
Attempt to render all `simp` equations for this definition. At a size Attempt to render all `simp` equations for this definition. At a size
@ -23,9 +23,9 @@ defined in `equationLimit` we stop trying since they:
def equationsToHtml (i : Process.DefinitionInfo) : HtmlM (Array Html) := do def equationsToHtml (i : Process.DefinitionInfo) : HtmlM (Array Html) := do
if let some eqs := i.equations then if let some eqs := i.equations then
let equationsHtml ← eqs.mapM equationToHtml let equationsHtml ← eqs.mapM equationToHtml
let filteredEquationsHtml := equationsHtml.filter (λ eq => eq.textLength < equationLimit) let filteredEquationsHtml := equationsHtml.filter (·.textLength < equationLimit)
if equationsHtml.size ≠ filteredEquationsHtml.size then if equationsHtml.size ≠ filteredEquationsHtml.size then
pure #[ return #[
<details> <details>
<summary>Equations</summary> <summary>Equations</summary>
<ul class="equations"> <ul class="equations">
@ -35,7 +35,7 @@ def equationsToHtml (i : Process.DefinitionInfo) : HtmlM (Array Html) := do
</details> </details>
] ]
else else
pure #[ return #[
<details> <details>
<summary>Equations</summary> <summary>Equations</summary>
<ul class="equations"> <ul class="equations">
@ -44,7 +44,7 @@ def equationsToHtml (i : Process.DefinitionInfo) : HtmlM (Array Html) := do
</details> </details>
] ]
else else
pure #[] return #[]
end Output end Output
end DocGen4 end DocGen4

View File

@ -23,7 +23,7 @@ namespace Output
/-- /--
Similar to `Stirng.split` in Lean core, but keeps the separater. Similar to `Stirng.split` in Lean core, but keeps the separater.
e.g. `splitAround "a,b,c" (λ c => c = ',') = ["a", ",", "b", ",", "c"]` e.g. `splitAround "a,b,c" (fun c => c = ',') = ["a", ",", "b", ",", "c"]`
-/ -/
def splitAround (s : String) (p : Char → Bool) : List String := splitAroundAux s p 0 0 [] def splitAround (s : String) (p : Char → Bool) : List String := splitAroundAux s p 0 0 []
@ -81,15 +81,15 @@ def nameToLink? (s : String) : HtmlM (Option String) := do
match res.moduleInfo.find! currentName |>.members |> filterMapDocInfo |>.find? (sameEnd ·.getName name) with match res.moduleInfo.find! currentName |>.members |> filterMapDocInfo |>.find? (sameEnd ·.getName name) with
| some info => | some info =>
declNameToLink info.getName declNameToLink info.getName
| _ => pure none | _ => return none
| _ => pure none | _ => return none
else else
pure none return none
where where
-- check if two names have the same ending components -- check if two names have the same ending components
sameEnd n1 n2 := sameEnd n1 n2 :=
List.zip n1.componentsRev n2.componentsRev List.zip n1.componentsRev n2.componentsRev
|>.all λ ⟨a, b⟩ => a == b |>.all fun ⟨a, b⟩ => a == b
/-- /--
Extend links with following rules: Extend links with following rules:
@ -103,16 +103,16 @@ def extendLink (s : String) : HtmlM String := do
-- for intra doc links -- for intra doc links
if s.startsWith "##" then if s.startsWith "##" then
if let some link ← nameToLink? (s.drop 2) then if let some link ← nameToLink? (s.drop 2) then
pure link return link
else else
panic! s!"Cannot find {s.drop 2}, only full name and abbrev in current module is supported" panic! s!"Cannot find {s.drop 2}, only full name and abbrev in current module is supported"
-- for id -- for id
else if s.startsWith "#" then else if s.startsWith "#" then
pure s return s
-- for absolute and relative urls -- for absolute and relative urls
else if s.startsWith "http" then else if s.startsWith "http" then
pure s return s
else pure ((←getRoot) ++ s) else return ((← getRoot) ++ s)
/-- Add attributes for heading. -/ /-- Add attributes for heading. -/
def addHeadingAttributes (el : Element) (modifyElement : Element → HtmlM Element) : HtmlM Element := do def addHeadingAttributes (el : Element) (modifyElement : Element → HtmlM Element) : HtmlM Element := do
@ -127,12 +127,12 @@ def addHeadingAttributes (el : Element) (modifyElement : Element → HtmlM Eleme
|>.insert "id" id |>.insert "id" id
|>.insert "class" "markdown-heading" |>.insert "class" "markdown-heading"
let newContents := (← let newContents := (←
contents.mapM (λ c => match c with contents.mapM (fun c => match c with
| Content.Element e => return Content.Element (← modifyElement e) | Content.Element e => return Content.Element (← modifyElement e)
| _ => pure c)) | _ => pure c))
|>.push (Content.Character " ") |>.push (Content.Character " ")
|>.push (Content.Element anchor) |>.push (Content.Element anchor)
pure ⟨ name, newAttrs, newContents⟩ return ⟨ name, newAttrs, newContents⟩
/-- Extend anchor links. -/ /-- Extend anchor links. -/
def extendAnchor (el : Element) : HtmlM Element := do def extendAnchor (el : Element) : HtmlM Element := do
@ -141,7 +141,7 @@ def extendAnchor (el : Element) : HtmlM Element := do
let newAttrs ← match attrs.find? "href" with let newAttrs ← match attrs.find? "href" with
| some href => pure (attrs.insert "href" (← extendLink href)) | some href => pure (attrs.insert "href" (← extendLink href))
| none => pure attrs | none => pure attrs
pure ⟨ name, newAttrs, contents⟩ return ⟨ name, newAttrs, contents⟩
/-- Automatically add intra documentation link for inline code span. -/ /-- Automatically add intra documentation link for inline code span. -/
def autoLink (el : Element) : HtmlM Element := do def autoLink (el : Element) : HtmlM Element := do
@ -153,27 +153,27 @@ def autoLink (el : Element) : HtmlM Element := do
| Content.Character s => | Content.Character s =>
newContents := newContents ++ (← splitAround s unicodeToSplit |>.mapM linkify).join newContents := newContents ++ (← splitAround s unicodeToSplit |>.mapM linkify).join
| _ => newContents := newContents.push c | _ => newContents := newContents.push c
pure ⟨ name, attrs, newContents ⟩ return ⟨ name, attrs, newContents ⟩
where where
linkify s := do linkify s := do
let link? ← nameToLink? s let link? ← nameToLink? s
match link? with match link? with
| some link => | some link =>
let attributes := Lean.RBMap.empty.insert "href" link let attributes := Lean.RBMap.empty.insert "href" link
pure [Content.Element <| Element.Element "a" attributes #[Content.Character s]] return [Content.Element <| Element.Element "a" attributes #[Content.Character s]]
| none => | none =>
let sHead := s.dropRightWhile (λ c => c ≠ '.') let sHead := s.dropRightWhile (· != '.')
let sTail := s.takeRightWhile (λ c => c ≠ '.') let sTail := s.takeRightWhile (· != '.')
let link'? ← nameToLink? sTail let link'? ← nameToLink? sTail
match link'? with match link'? with
| some link' => | some link' =>
let attributes := Lean.RBMap.empty.insert "href" link' let attributes := Lean.RBMap.empty.insert "href" link'
pure [ return [
Content.Character sHead, Content.Character sHead,
Content.Element <| Element.Element "a" attributes #[Content.Character sTail] Content.Element <| Element.Element "a" attributes #[Content.Character sTail]
] ]
| none => | none =>
pure [Content.Character s] return [Content.Character s]
unicodeToSplit (c : Char) : Bool := unicodeToSplit (c : Char) : Bool :=
charInGeneralCategory c GeneralCategory.separator || charInGeneralCategory c GeneralCategory.separator ||
charInGeneralCategory c GeneralCategory.other charInGeneralCategory c GeneralCategory.other
@ -192,19 +192,18 @@ partial def modifyElement (element : Element) : HtmlM Element :=
autoLink el autoLink el
-- recursively modify -- recursively modify
else else
let newContents ← contents.mapM λ c => match c with let newContents ← contents.mapM fun c => match c with
| Content.Element e => return Content.Element (← modifyElement e) | Content.Element e => return Content.Element (← modifyElement e)
| _ => pure c | _ => pure c
pure ⟨ name, attrs, newContents ⟩ return ⟨ name, attrs, newContents ⟩
/-- Convert docstring to Html. -/ /-- Convert docstring to Html. -/
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 fun x => do return Html.text <| toString (← modifyElement x)
pure (Html.text <| toString (← modifyElement x)) | _ => return #[Html.text rendered]
| _ => pure #[Html.text rendered]
end Output end Output
end DocGen4 end DocGen4

View File

@ -10,8 +10,8 @@ def find : BaseHtmlM Html := do
pure pure
<html lang="en"> <html lang="en">
<head> <head>
<link rel="preload" href={s!"{←getRoot}/declarations/declaration-data.bmp"} as="image"/> <link rel="preload" href={s!"{← getRoot}/declarations/declaration-data.bmp"} as="image"/>
<script>{s!"const SITE_ROOT={String.quote (←getRoot)};"}</script> <script>{s!"const SITE_ROOT={String.quote (← getRoot)};"}</script>
<script type="module" async="true" src="./find.js"></script> <script type="module" async="true" src="./find.js"></script>
</head> </head>
<body></body> <body></body>

View File

@ -28,7 +28,7 @@ def foundationalTypes : BaseHtmlM Html := templateLiftExtends (baseHtml "Foundat
<p><code>Prop</code> is notation for <code>Sort 0</code>.</p> <p><code>Prop</code> is notation for <code>Sort 0</code>.</p>
{← instancesForToHtml `_builtin_prop} {← instancesForToHtml `_builtin_prop}
<h2 id="pi-types-codeπ-a--α-β-acode">Pi types, <code>{"Π a : α, β a"}</code></h2> <h2 id="pi-types-codeπ-a--α-β-acode">Pi types, <code>{"(a : α) → β a"}</code></h2>
<p>The type of dependent functions is known as a pi type. <p>The type of dependent functions is known as a pi type.
Non-dependent functions and implications are a special case.</p> Non-dependent functions and implications are a special case.</p>
<p>Note that these can also be written with the alternative notations:</p> <p>Note that these can also be written with the alternative notations:</p>
@ -39,13 +39,12 @@ def foundationalTypes : BaseHtmlM Html := templateLiftExtends (baseHtml "Foundat
</ul> </ul>
<p>Lean also permits ASCII-only spellings of the three variants:</p> <p>Lean also permits ASCII-only spellings of the three variants:</p>
<ul> <ul>
<li><code>Pi a : A, B a</code> for <code>{"Π a : α, β a"}</code></li>
<li><code>forall a : A, B a</code> for <code>{"∀ a : α, β a"}</code></li> <li><code>forall a : A, B a</code> for <code>{"∀ a : α, β a"}</code></li>
<li><code>(a : A) -&gt; B a</code>, for <code>(a : α) → β a</code></li> <li><code>(a : A) -&gt; B a</code>, for <code>(a : α) → β a</code></li>
<li><code>A -&gt; B</code>, for <code>α → β</code></li> <li><code>A -&gt; B</code>, for <code>α → β</code></li>
</ul> </ul>
<p>Note that despite not itself being a function, <code>(→)</code> is available as infix notation for <p>Note that despite not itself being a function, <code>(→)</code> is available as infix notation for
<code>{"λ α β, α → β"}</code>.</p> <code>{"fun α β, α → β"}</code>.</p>
-- TODO: instances for pi types -- TODO: instances for pi types
</main> </main>

View File

@ -23,17 +23,17 @@ def ctorToHtml (c : Process.NameInfo) : HtmlM Html := do
pure pure
<li class="constructor" id={name}> <li class="constructor" id={name}>
<div class="inductive_ctor_doc">[renderedDoc]</div> <div class="inductive_ctor_doc">[renderedDoc]</div>
{shortName} : [←infoFormatToHtml c.type] {shortName} : [← infoFormatToHtml c.type]
</li> </li>
else else
pure pure
<li class="constructor" id={name}> <li class="constructor" id={name}>
{shortName} : [←infoFormatToHtml c.type] {shortName} : [← infoFormatToHtml c.type]
</li> </li>
def inductiveToHtml (i : Process.InductiveInfo) : HtmlM (Array Html) := do def inductiveToHtml (i : Process.InductiveInfo) : HtmlM (Array Html) := do
let constructorsHtml := <ul class="constructors">[← i.ctors.toArray.mapM ctorToHtml]</ul> let constructorsHtml := <ul class="constructors">[← i.ctors.toArray.mapM ctorToHtml]</ul>
pure #[constructorsHtml] return #[constructorsHtml]
end Output end Output
end DocGen4 end DocGen4

View File

@ -31,14 +31,14 @@ def argToHtml (arg : Arg) : HtmlM Html := do
| BinderInfo.strictImplicit => ("⦃", "⦄", true) | BinderInfo.strictImplicit => ("⦃", "⦄", true)
| BinderInfo.instImplicit => ("[", "]", true) | BinderInfo.instImplicit => ("[", "]", true)
let mut nodes := #[Html.text s!"{l}{arg.name.toString} : "] let mut nodes := #[Html.text s!"{l}{arg.name.toString} : "]
nodes := nodes.append (←infoFormatToHtml arg.type) nodes := nodes.append (← infoFormatToHtml arg.type)
nodes := nodes.push r nodes := nodes.push r
let inner := <span class="fn">[nodes]</span> let inner := <span class="fn">[nodes]</span>
let html := Html.element "span" false #[("class", "decl_args")] #[inner] let html := Html.element "span" false #[("class", "decl_args")] #[inner]
if implicit then if implicit then
pure <span class="impl_arg">{html}</span> return <span class="impl_arg">{html}</span>
else else
pure html return html
/-- /--
Render the structures this structure extends from as HTML so it can be Render the structures this structure extends from as HTML so it can be
@ -55,7 +55,7 @@ def structureInfoHeader (s : Process.StructureInfo) : HtmlM (Array Html) := do
let html:= Html.element "span" false #[("class", "decl_parent")] #[inner] let html:= Html.element "span" false #[("class", "decl_parent")] #[inner]
parents := parents.push html parents := parents.push html
nodes := nodes.append (parents.toList.intersperse (Html.text ", ")).toArray nodes := nodes.append (parents.toList.intersperse (Html.text ", ")).toArray
pure nodes return nodes
/-- /--
Render the general header of a declaration containing its declaration type Render the general header of a declaration containing its declaration type
@ -66,22 +66,22 @@ def docInfoHeader (doc : DocInfo) : HtmlM Html := do
nodes := nodes.push <| Html.element "span" false #[("class", "decl_kind")] #[doc.getKindDescription] nodes := nodes.push <| Html.element "span" false #[("class", "decl_kind")] #[doc.getKindDescription]
nodes := nodes.push nodes := nodes.push
<span class="decl_name"> <span class="decl_name">
<a class="break_within" href={←declNameToLink doc.getName}> <a class="break_within" href={← declNameToLink doc.getName}>
-- TODO: HTMLify the name -- TODO: HTMLify the name
{doc.getName.toString} {doc.getName.toString}
</a> </a>
</span> </span>
for arg in doc.getArgs do for arg in doc.getArgs do
nodes := nodes.push (←argToHtml arg) nodes := nodes.push (← argToHtml arg)
match doc with match doc with
| DocInfo.structureInfo i => nodes := nodes.append (←structureInfoHeader i) | DocInfo.structureInfo i => nodes := nodes.append (← structureInfoHeader i)
| DocInfo.classInfo i => nodes := nodes.append (←structureInfoHeader i) | DocInfo.classInfo i => nodes := nodes.append (← structureInfoHeader i)
| _ => nodes := nodes | _ => nodes := nodes
nodes := nodes.push <| Html.element "span" true #[("class", "decl_args")] #[" :"] nodes := nodes.push <| Html.element "span" true #[("class", "decl_args")] #[" :"]
nodes := nodes.push <div class="decl_type">[←infoFormatToHtml doc.getType]</div> nodes := nodes.push <div class="decl_type">[← infoFormatToHtml doc.getType]</div>
pure <div class="decl_header"> [nodes] </div> return <div class="decl_header"> [nodes] </div>
/-- /--
The main entry point for rendering a single declaration inside a given module. The main entry point for rendering a single declaration inside a given module.
@ -100,12 +100,12 @@ def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do
| none => pure #[] | none => pure #[]
-- extra information like equations and instances -- extra information like equations and instances
let extraInfoHtml ← match doc with let extraInfoHtml ← match doc with
| DocInfo.classInfo i => pure #[←classInstancesToHtml i.name] | DocInfo.classInfo i => pure #[← classInstancesToHtml i.name]
| DocInfo.definitionInfo i => equationsToHtml i | DocInfo.definitionInfo i => equationsToHtml i
| DocInfo.instanceInfo i => equationsToHtml i.toDefinitionInfo | DocInfo.instanceInfo i => equationsToHtml i.toDefinitionInfo
| DocInfo.classInductiveInfo i => pure #[←classInstancesToHtml i.name] | DocInfo.classInductiveInfo i => pure #[← classInstancesToHtml i.name]
| DocInfo.inductiveInfo i => pure #[←instancesForToHtml i.name] | DocInfo.inductiveInfo i => pure #[← instancesForToHtml i.name]
| DocInfo.structureInfo i => pure #[←instancesForToHtml i.name] | DocInfo.structureInfo i => pure #[← instancesForToHtml i.name]
| _ => pure #[] | _ => pure #[]
let attrs := doc.getAttrs let attrs := doc.getAttrs
let attrsHtml := let attrsHtml :=
@ -115,10 +115,10 @@ def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do
else else
#[] #[]
let leanInkHtml := let leanInkHtml :=
if ←leanInkEnabled? then if ← leanInkEnabled? then
#[ #[
<div class="ink_link"> <div class="ink_link">
<a href={←declNameToInkLink doc.getName}>ink</a> <a href={← declNameToInkLink doc.getName}>ink</a>
</div> </div>
] ]
else else
@ -128,11 +128,11 @@ def docInfoToHtml (module : Name) (doc : DocInfo) : HtmlM Html := do
<div class="decl" id={doc.getName.toString}> <div class="decl" id={doc.getName.toString}>
<div class={doc.getKind}> <div class={doc.getKind}>
<div class="gh_link"> <div class="gh_link">
<a href={←getSourceUrl module doc.getDeclarationRange}>source</a> <a href={← getSourceUrl module doc.getDeclarationRange}>source</a>
</div> </div>
[leanInkHtml] [leanInkHtml]
[attrsHtml] [attrsHtml]
{←docInfoHeader doc} {← docInfoHeader doc}
[docInfoHtml] [docInfoHtml]
[docStringHtml] [docStringHtml]
[extraInfoHtml] [extraInfoHtml]
@ -146,7 +146,7 @@ as HTML.
def modDocToHtml (mdoc : ModuleDoc) : HtmlM Html := do def modDocToHtml (mdoc : ModuleDoc) : HtmlM Html := do
pure pure
<div class="mod_doc"> <div class="mod_doc">
[←docStringToHtml mdoc.doc] [← docStringToHtml mdoc.doc]
</div> </div>
/-- /--
@ -168,15 +168,15 @@ Returns the list of all imports this module does.
-/ -/
def getImports (module : Name) : HtmlM (Array Name) := do def getImports (module : Name) : HtmlM (Array Name) := do
let res ← getResult let res ← getResult
pure <| res.moduleInfo.find! module |>.imports return res.moduleInfo.find! module |>.imports
/-- /--
Sort the list of all modules this one is importing, linkify it Sort the list of all modules this one is importing, linkify it
and return the HTML. and return the HTML.
-/ -/
def importsHtml (moduleName : Name) : HtmlM (Array Html) := do def importsHtml (moduleName : Name) : HtmlM (Array Html) := do
let imports := (←getImports moduleName) |>.qsort Name.lt let imports := (← getImports moduleName).qsort Name.lt
imports.mapM (λ i => do pure <li>{←moduleToHtmlLink i}</li>) imports.mapM (fun i => do return <li>{← moduleToHtmlLink i}</li>)
/-- /--
Render the internal nav bar (the thing on the right on all module pages). Render the internal nav bar (the thing on the right on all module pages).
@ -185,12 +185,12 @@ def internalNav (members : Array Name) (moduleName : Name) : HtmlM Html := do
pure pure
<nav class="internal_nav"> <nav class="internal_nav">
<h3><a class="break_within" href="#top">{moduleName.toString}</a></h3> <h3><a class="break_within" href="#top">{moduleName.toString}</a></h3>
<p class="gh_nav_link"><a href={←getSourceUrl moduleName none}>source</a></p> <p class="gh_nav_link"><a href={← getSourceUrl moduleName none}>source</a></p>
<div class="imports"> <div class="imports">
<details> <details>
<summary>Imports</summary> <summary>Imports</summary>
<ul> <ul>
[←importsHtml moduleName] [← importsHtml moduleName]
</ul> </ul>
</details> </details>
<details> <details>
@ -205,10 +205,10 @@ def internalNav (members : Array Name) (moduleName : Name) : HtmlM Html := do
The main entry point to rendering the HTML for an entire module. The main entry point to rendering the HTML for an entire module.
-/ -/
def moduleToHtml (module : Process.Module) : HtmlM Html := withTheReader SiteBaseContext (setCurrentName module.name) do def moduleToHtml (module : Process.Module) : HtmlM Html := withTheReader SiteBaseContext (setCurrentName module.name) do
let memberDocs ← module.members.mapM (λ i => moduleMemberToHtml module.name i) let memberDocs ← module.members.mapM (moduleMemberToHtml module.name ·)
let memberNames := filterMapDocInfo module.members |>.map DocInfo.getName let memberNames := filterMapDocInfo module.members |>.map DocInfo.getName
templateLiftExtends (baseHtmlGenerator module.name.toString) <| pure #[ templateLiftExtends (baseHtmlGenerator module.name.toString) <| pure #[
←internalNav memberNames module.name, internalNav memberNames module.name,
Html.element "main" false #[] memberDocs Html.element "main" false #[] memberDocs
] ]

View File

@ -14,8 +14,8 @@ open Lean
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def moduleListFile (file : Name) : BaseHtmlM Html := do def moduleListFile (file : Name) : BaseHtmlM Html := do
pure <div class={if (← getCurrentName) == file then "nav_link visible" else "nav_link"}> return <div class={if (← getCurrentName) == file then "nav_link visible" else "nav_link"}>
<a href={←moduleNameToLink file}>{file.getString!}</a> <a href={← moduleNameToLink file}>{file.getString!}</a>
</div> </div>
/-- /--
@ -23,20 +23,20 @@ Build the HTML tree representing the module hierarchy.
-/ -/
partial def moduleListDir (h : Hierarchy) : BaseHtmlM Html := do partial def moduleListDir (h : Hierarchy) : BaseHtmlM Html := do
let children := Array.mk (h.getChildren.toList.map Prod.snd) let children := Array.mk (h.getChildren.toList.map Prod.snd)
let dirs := children.filter (λ c => c.getChildren.toList.length != 0) let dirs := children.filter (fun c => c.getChildren.toList.length != 0)
let files := children.filter (λ c => Hierarchy.isFile c ∧ c.getChildren.toList.length = 0) let files := children.filter (fun c => Hierarchy.isFile c && c.getChildren.toList.length = 0)
|>.map Hierarchy.getName |>.map Hierarchy.getName
let dirNodes ← (dirs.mapM moduleListDir) let dirNodes ← dirs.mapM moduleListDir
let fileNodes ← (files.mapM moduleListFile) let fileNodes ← files.mapM moduleListFile
let moduleLink ← moduleNameToLink h.getName let moduleLink ← moduleNameToLink h.getName
let summary := let summary :=
if h.isFile then if h.isFile then
<summary>{←moduleToHtmlLink h.getName}</summary> <summary>{← moduleToHtmlLink h.getName}</summary>
else else
<summary>{h.getName.getString!}</summary> <summary>{h.getName.getString!}</summary>
pure pure
<details class="nav_sect" "data-path"={moduleLink} [if (←getCurrentName).any (h.getName.isPrefixOf ·) then #[("open", "")] else #[]]> <details class="nav_sect" "data-path"={moduleLink} [if (← getCurrentName).any (h.getName.isPrefixOf ·) then #[("open", "")] else #[]]>
{summary} {summary}
[dirNodes] [dirNodes]
[fileNodes] [fileNodes]
@ -49,8 +49,8 @@ def moduleList : BaseHtmlM Html := do
let hierarchy ← getHierarchy let hierarchy ← getHierarchy
let mut list := Array.empty let mut list := Array.empty
for (_, cs) in hierarchy.getChildren do for (_, cs) in hierarchy.getChildren do
list := list.push <| ←moduleListDir cs list := list.push <| ← moduleListDir cs
pure <div class="module_list">[list]</div> return <div class="module_list">[list]</div>
/-- /--
The main entry point to rendering the navbar on the left hand side. The main entry point to rendering the navbar on the left hand side.
@ -59,9 +59,9 @@ def navbar : BaseHtmlM Html := do
pure pure
<html lang="en"> <html lang="en">
<head> <head>
[←baseHtmlHeadDeclarations] [← baseHtmlHeadDeclarations]
<script type="module" src={s!"{←getRoot}nav.js"}></script> <script type="module" src={s!"{← getRoot}nav.js"}></script>
<base target="_parent" /> <base target="_parent" />
</head> </head>
@ -69,16 +69,16 @@ def navbar : BaseHtmlM Html := do
<div class="navframe"> <div class="navframe">
<nav class="nav"> <nav class="nav">
<h3>General documentation</h3> <h3>General documentation</h3>
<div class="nav_link"><a href={s!"{←getRoot}"}>index</a></div> <div class="nav_link"><a href={s!"{← getRoot}"}>index</a></div>
<div class="nav_link"><a href={s!"{←getRoot}foundational_types.html"}>foundational types</a></div> <div class="nav_link"><a href={s!"{← getRoot}foundational_types.html"}>foundational types</a></div>
/- /-
TODO: Add these in later TODO: Add these in later
<div class="nav_link"><a href={s!"{←getRoot}tactics.html"}>tactics</a></div> <div class="nav_link"><a href={s!"{← getRoot}tactics.html"}>tactics</a></div>
<div class="nav_link"><a href={s!"{←getRoot}commands.html"}>commands</a></div> <div class="nav_link"><a href={s!"{← getRoot}commands.html"}>commands</a></div>
<div class="nav_link"><a href={s!"{←getRoot}hole_commands.html"}>hole commands</a></div> <div class="nav_link"><a href={s!"{← getRoot}hole_commands.html"}>hole commands</a></div>
<div class="nav_link"><a href={s!"{←getRoot}attributes.html"}>attributes</a></div> <div class="nav_link"><a href={s!"{← getRoot}attributes.html"}>attributes</a></div>
<div class="nav_link"><a href={s!"{←getRoot}notes.html"}>notes</a></div> <div class="nav_link"><a href={s!"{← getRoot}notes.html"}>notes</a></div>
<div class="nav_link"><a href={s!"{←getRoot}references.html"}>references</a></div> <div class="nav_link"><a href={s!"{← getRoot}references.html"}>references</a></div>
-/ -/
<h3>Library</h3> <h3>Library</h3>
{← moduleList} {← moduleList}

View File

@ -25,11 +25,11 @@ def getGithubBaseUrl (gitUrl : String) : String := Id.run do
if url.startsWith "git@" then if url.startsWith "git@" then
url := url.drop 15 url := url.drop 15
url := url.dropRight 4 url := url.dropRight 4
pure s!"https://github.com/{url}" return s!"https://github.com/{url}"
else if url.endsWith ".git" then else if url.endsWith ".git" then
pure <| url.dropRight 4 return url.dropRight 4
else else
pure url return url
/-- /--
Obtain the Github URL of a project by parsing the origin remote. Obtain the Github URL of a project by parsing the origin remote.
@ -38,7 +38,7 @@ def getProjectGithubUrl : IO String := do
let out ← IO.Process.output {cmd := "git", args := #["remote", "get-url", "origin"]} let out ← IO.Process.output {cmd := "git", args := #["remote", "get-url", "origin"]}
if out.exitCode != 0 then if out.exitCode != 0 then
throw <| IO.userError <| "git exited with code " ++ toString out.exitCode throw <| IO.userError <| "git exited with code " ++ toString out.exitCode
pure out.stdout.trimRight return out.stdout.trimRight
/-- /--
Obtain the git commit hash of the project that is currently getting analyzed. Obtain the git commit hash of the project that is currently getting analyzed.
@ -47,7 +47,7 @@ def getProjectCommit : IO String := do
let out ← IO.Process.output {cmd := "git", args := #["rev-parse", "HEAD"]} let out ← IO.Process.output {cmd := "git", args := #["rev-parse", "HEAD"]}
if out.exitCode != 0 then if out.exitCode != 0 then
throw <| IO.userError <| "git exited with code " ++ toString out.exitCode throw <| IO.userError <| "git exited with code " ++ toString out.exitCode
pure out.stdout.trimRight return out.stdout.trimRight
/-- /--
Given a lake workspace with all the dependencies as well as the hash of the Given a lake workspace with all the dependencies as well as the hash of the
@ -58,17 +58,17 @@ def sourceLinker (ws : Lake.Workspace) : IO (Name → Option DeclarationRange
let leanHash := ws.lakeEnv.lean.githash let leanHash := ws.lakeEnv.lean.githash
-- Compute a map from package names to source URL -- Compute a map from package names to source URL
let mut gitMap := Lean.mkHashMap let mut gitMap := Lean.mkHashMap
let projectBaseUrl := getGithubBaseUrl (←getProjectGithubUrl) let projectBaseUrl := getGithubBaseUrl (← getProjectGithubUrl)
let projectCommit ← getProjectCommit let projectCommit ← getProjectCommit
gitMap := gitMap.insert ws.root.name (projectBaseUrl, projectCommit) gitMap := gitMap.insert ws.root.name (projectBaseUrl, projectCommit)
let manifest ← Lake.Manifest.loadOrEmpty ws.root.manifestFile let manifest ← Lake.Manifest.loadOrEmpty ws.root.manifestFile
|>.run (Lake.MonadLog.eio .normal) |>.run (Lake.MonadLog.eio .normal)
|>.toIO (λ _ => IO.userError "Failed to load lake manifest") |>.toIO (fun _ => IO.userError "Failed to load lake manifest")
for pkg in manifest.entryArray do for pkg in manifest.entryArray do
if let .git _ url rev .. := pkg then if let .git _ url rev .. := pkg then
gitMap := gitMap.insert pkg.name (getGithubBaseUrl url, rev) gitMap := gitMap.insert pkg.name (getGithubBaseUrl url, rev)
pure λ module range => return fun module range =>
let parts := module.components.map Name.toString let parts := module.components.map Name.toString
let path := (parts.intersperse "/").foldl (· ++ ·) "" let path := (parts.intersperse "/").foldl (· ++ ·) ""
let root := module.getRoot let root := module.getRoot

View File

@ -19,12 +19,12 @@ def fieldToHtml (f : Process.NameInfo) : HtmlM Html := do
pure pure
<li id={name} class="structure_field"> <li id={name} class="structure_field">
<div class="structure_field_doc">[renderedDoc]</div> <div class="structure_field_doc">[renderedDoc]</div>
<div class="structure_field_info">{s!"{shortName} "} : [←infoFormatToHtml f.type]</div> <div class="structure_field_info">{s!"{shortName} "} : [← infoFormatToHtml f.type]</div>
</li> </li>
else else
pure pure
<li id={name} class="structure_field"> <li id={name} class="structure_field">
<div class="structure_field_info">{s!"{shortName} "} : [←infoFormatToHtml f.type]</div> <div class="structure_field_info">{s!"{shortName} "} : [← infoFormatToHtml f.type]</div>
</li> </li>
/-- /--
@ -34,18 +34,18 @@ def structureToHtml (i : Process.StructureInfo) : HtmlM (Array Html) := do
let structureHtml := let structureHtml :=
if Name.isSuffixOf `mk i.ctor.name then if Name.isSuffixOf `mk i.ctor.name then
(<ul class="structure_fields" id={i.ctor.name.toString}> (<ul class="structure_fields" id={i.ctor.name.toString}>
[←i.fieldInfo.mapM fieldToHtml] [← i.fieldInfo.mapM fieldToHtml]
</ul>) </ul>)
else else
let ctorShortName := i.ctor.name.componentsRev.head!.toString let ctorShortName := i.ctor.name.componentsRev.head!.toString
(<ul class="structure_ext"> (<ul class="structure_ext">
<li id={i.ctor.name.toString} class="structure_ext_ctor">{s!"{ctorShortName} "} :: (</li> <li id={i.ctor.name.toString} class="structure_ext_ctor">{s!"{ctorShortName} "} :: (</li>
<ul class="structure_ext_fields"> <ul class="structure_ext_fields">
[←i.fieldInfo.mapM fieldToHtml] [← i.fieldInfo.mapM fieldToHtml]
</ul> </ul>
<li class="structure_ext_ctor">)</li> <li class="structure_ext_ctor">)</li>
</ul>) </ul>)
pure #[structureHtml] return #[structureHtml]
end Output end Output
end DocGen4 end DocGen4

View File

@ -16,26 +16,26 @@ The HTML template used for all pages.
-/ -/
def baseHtmlGenerator (title : String) (site : Array Html) : BaseHtmlM Html := do def baseHtmlGenerator (title : String) (site : Array Html) : BaseHtmlM Html := do
let moduleConstant := let moduleConstant :=
if let some module := (←getCurrentName) then if let some module := ← getCurrentName then
#[<script>{s!"const MODULE_NAME={String.quote module.toString};"}</script>] #[<script>{s!"const MODULE_NAME={String.quote module.toString};"}</script>]
else else
#[] #[]
pure pure
<html lang="en"> <html lang="en">
<head> <head>
[←baseHtmlHeadDeclarations] [← baseHtmlHeadDeclarations]
<title>{title}</title> <title>{title}</title>
<script defer="true" src={s!"{←getRoot}mathjax-config.js"}></script> <script defer="true" src={s!"{← getRoot}mathjax-config.js"}></script>
<script defer="true" src="https://polyfill.io/v3/polyfill.min.js?features=es6"></script> <script defer="true" src="https://polyfill.io/v3/polyfill.min.js?features=es6"></script>
<script defer="true" src="https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js"></script> <script defer="true" src="https://cdn.jsdelivr.net/npm/mathjax@3/es5/tex-mml-chtml.js"></script>
<script>{s!"const SITE_ROOT={String.quote (←getRoot)};"}</script> <script>{s!"const SITE_ROOT={String.quote (← getRoot)};"}</script>
[moduleConstant] [moduleConstant]
<script type="module" src={s!"{←getRoot}search.js"}></script> <script type="module" src={s!"{← getRoot}search.js"}></script>
<script type="module" src={s!"{←getRoot}how-about.js"}></script> <script type="module" src={s!"{← getRoot}how-about.js"}></script>
<script type="module" src={s!"{←getRoot}instances.js"}></script> <script type="module" src={s!"{← getRoot}instances.js"}></script>
<script type="module" src={s!"{←getRoot}importedBy.js"}></script> <script type="module" src={s!"{← getRoot}importedBy.js"}></script>
</head> </head>
<body> <body>
@ -56,7 +56,7 @@ def baseHtmlGenerator (title : String) (site : Array Html) : BaseHtmlM Html := d
[site] [site]
<nav class="nav"> <nav class="nav">
<iframe src={s!"{←getRoot}navbar.html"} class="navframe" frameBorder="0"></iframe> <iframe src={s!"{← getRoot}navbar.html"} class="navframe" frameBorder="0"></iframe>
</nav> </nav>
</body> </body>
</html> </html>

View File

@ -29,7 +29,7 @@ instance : Coe String Html :=
namespace Html namespace Html
def attributesToString (attrs : Array (String × String)) :String := def attributesToString (attrs : Array (String × String)) :String :=
attrs.foldl (λ acc (k, v) => acc ++ " " ++ k ++ "=\"" ++ v ++ "\"") "" attrs.foldl (fun acc (k, v) => acc ++ " " ++ k ++ "=\"" ++ v ++ "\"") ""
-- TODO: Termination proof -- TODO: Termination proof
partial def toStringAux : Html → String partial def toStringAux : Html → String
@ -60,7 +60,7 @@ def escapePairs : Array (String × String) :=
] ]
def escape (s : String) : String := def escape (s : String) : String :=
escapePairs.foldl (λ acc (o, r) => acc.replace o r) s escapePairs.foldl (fun acc (o, r) => acc.replace o r) s
end Html end Html

View File

@ -36,11 +36,11 @@ structure JsonIndex where
instance : ToJson JsonIndex where instance : ToJson JsonIndex where
toJson idx := Id.run do toJson idx := Id.run do
let jsonDecls := Json.mkObj <| idx.declarations.map (λ (k, v) => (k, toJson v)) let jsonDecls := Json.mkObj <| idx.declarations.map (fun (k, v) => (k, toJson v))
let jsonInstances := Json.mkObj <| idx.instances.toList.map (λ (k, v) => (k, toJson v)) let jsonInstances := Json.mkObj <| idx.instances.toList.map (fun (k, v) => (k, toJson v))
let jsonImportedBy := Json.mkObj <| idx.importedBy.toList.map (λ (k, v) => (k, toJson v)) let jsonImportedBy := Json.mkObj <| idx.importedBy.toList.map (fun (k, v) => (k, toJson v))
let jsonModules := Json.mkObj <| idx.modules.map (λ (k, v) => (k, toJson v)) let jsonModules := Json.mkObj <| idx.modules.map (fun (k, v) => (k, toJson v))
let jsonInstancesFor := Json.mkObj <| idx.instancesFor.toList.map (λ (k, v) => (k, toJson v)) let jsonInstancesFor := Json.mkObj <| idx.instancesFor.toList.map (fun (k, v) => (k, toJson v))
let finalJson := Json.mkObj [ let finalJson := Json.mkObj [
("declarations", jsonDecls), ("declarations", jsonDecls),
("instances", jsonInstances), ("instances", jsonInstances),
@ -48,12 +48,12 @@ instance : ToJson JsonIndex where
("modules", jsonModules), ("modules", jsonModules),
("instancesFor", jsonInstancesFor) ("instancesFor", jsonInstancesFor)
] ]
pure finalJson return finalJson
def JsonIndex.addModule (index : JsonIndex) (module : JsonModule) : BaseHtmlM JsonIndex := do def JsonIndex.addModule (index : JsonIndex) (module : JsonModule) : BaseHtmlM JsonIndex := do
let mut index := index let mut index := index
let newModule := (module.name, ←moduleNameToLink (String.toName module.name)) let newModule := (module.name, ← moduleNameToLink (String.toName module.name))
let newDecls := module.declarations.map (λ d => (d.name, d)) let newDecls := module.declarations.map (fun d => (d.name, d))
index := { index with index := { index with
modules := newModule :: index.modules modules := newModule :: index.modules
declarations := newDecls ++ index.declarations declarations := newDecls ++ index.declarations
@ -72,21 +72,21 @@ def JsonIndex.addModule (index : JsonIndex) (module : JsonModule) : BaseHtmlM Js
let mut impBy := index.importedBy.findD imp #[] let mut impBy := index.importedBy.findD imp #[]
impBy := impBy.push module.name impBy := impBy.push module.name
index := { index with importedBy := index.importedBy.insert imp impBy } index := { index with importedBy := index.importedBy.insert imp impBy }
pure index return index
def DocInfo.toJson (module : Name) (info : Process.DocInfo) : HtmlM JsonDeclaration := do def DocInfo.toJson (module : Name) (info : Process.DocInfo) : HtmlM JsonDeclaration := do
let name := info.getName.toString let name := info.getName.toString
let doc := info.getDocString.getD "" let doc := info.getDocString.getD ""
let docLink ← declNameToLink info.getName let docLink ← declNameToLink info.getName
let sourceLink ← getSourceUrl module info.getDeclarationRange let sourceLink ← getSourceUrl module info.getDeclarationRange
pure { name, doc, docLink, sourceLink } return { name, doc, docLink, sourceLink }
def Process.Module.toJson (module : Process.Module) : HtmlM Json := do def Process.Module.toJson (module : Process.Module) : HtmlM Json := do
let mut jsonDecls := [] let mut jsonDecls := []
let mut instances := #[] let mut instances := #[]
let declInfo := Process.filterMapDocInfo module.members let declInfo := Process.filterMapDocInfo module.members
for decl in declInfo do for decl in declInfo do
jsonDecls := (←DocInfo.toJson module.name decl) :: jsonDecls jsonDecls := (← DocInfo.toJson module.name decl) :: jsonDecls
if let .instanceInfo i := decl then if let .instanceInfo i := decl then
instances := instances.push { instances := instances.push {
name := i.name.toString, name := i.name.toString,
@ -99,6 +99,6 @@ def Process.Module.toJson (module : Process.Module) : HtmlM Json := do
instances, instances,
imports := module.imports.map Name.toString imports := module.imports.map Name.toString
} }
pure <| ToJson.toJson jsonMod return ToJson.toJson jsonMod
end DocGen4.Output end DocGen4.Output