feat: fix links to inductive ctors and structure fields

main
Henrik Böving 2022-01-09 14:07:50 +01:00
parent b90644cfd2
commit 0754b43873
3 changed files with 9 additions and 6 deletions

View File

@ -6,8 +6,9 @@ namespace Output
open scoped DocGen4.Jsx
def ctorToHtml (i : NameInfo) : HtmlM Html := do
let name := i.name.components'.head!.toString
return <li «class»="constructor" id={name}>{name} : [←infoFormatToHtml i.type]</li>
let shortName := i.name.components'.head!.toString
let name := i.name.toString
return <li «class»="constructor" id={name}>{shortName} : [←infoFormatToHtml i.type]</li>
def inductiveToHtml (i : InductiveInfo) : HtmlM (Array Html) := do
#[Html.element "ul" false #[("class", "constructors")] (←i.ctors.toArray.mapM ctorToHtml)]

View File

@ -6,7 +6,9 @@ namespace Output
open scoped DocGen4.Jsx
def fieldToHtml (f : NameInfo) : HtmlM Html := do
return <li «class»="structure_field" id={f.name.toString}>{s!"{f.name} : "} [←infoFormatToHtml f.type]</li>
let shortName := f.name.components'.head!.toString
let name := f.name.toString
return <li «class»="structure_field" id={name}>{shortName} : [←infoFormatToHtml f.type]</li>
def structureToHtml (i : StructureInfo) : HtmlM (Array Html) := do
#[Html.element "ul" false #[("class", "structure_fields"), ("id", s!"{i.name.toString}.mk")] (←i.fieldInfo.mapM fieldToHtml)]

View File

@ -182,13 +182,13 @@ def dropArgs (type : Expr) (n : Nat) : (Expr × List (Name × Expr)) :=
{ next with snd := (name, type) :: next.snd}
| e, x + 1 => panic! s!"No forallE left"
def getFieldTypes (ctor : ConstructorVal) (parents : Nat) : MetaM (Array NameInfo) := do
def getFieldTypes (struct : Name) (ctor : ConstructorVal) (parents : Nat) : MetaM (Array NameInfo) := do
let type := ctor.type
let (field_function, params) := dropArgs type (ctor.numParams + parents)
let (_, fields) := dropArgs field_function (ctor.numFields - parents)
let mut field_infos := #[]
for (name, type) in fields do
field_infos := field_infos.push { name := name, type := ←prettyPrintTerm type}
field_infos := field_infos.push { name := struct.append name, type := ←prettyPrintTerm type}
field_infos
def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
@ -200,7 +200,7 @@ def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
match getStructureInfo? env v.name with
| some i =>
if i.fieldNames.size - parents.size > 0 then
return StructureInfo.mk info (←getFieldTypes ctor parents.size) parents ⟨ctor.name, ctorType⟩
return StructureInfo.mk info (←getFieldTypes v.name ctor parents.size) parents ⟨ctor.name, ctorType⟩
else
return StructureInfo.mk info #[] parents ⟨ctor.name, ctorType⟩
| none => panic! s!"{v.name} is not a structure"