chore: style, change $ to <|

main
Henrik Böving 2022-07-23 13:01:25 +02:00
parent d44871c6f5
commit ed4cee2eae
28 changed files with 96 additions and 105 deletions

View File

@ -34,21 +34,21 @@ don't have to carry them around as files.
-/ -/
@[termElab includeStr] def includeStrImpl : TermElab := λ stx _ => do @[termElab includeStr] def includeStrImpl : TermElab := λ stx _ => do
let str := stx[1].isStrLit?.get! let str := stx[1].isStrLit?.get!
let srcPath := FilePath.mk $ ←getFileName let srcPath := FilePath.mk <| ←getFileName
let currentDir ← IO.currentDir let currentDir ← IO.currentDir
-- HACK: Currently we cannot get current file path in VSCode, we have to traversely find the matched subdirectory in the current directory. -- HACK: Currently we cannot get current file path in VSCode, we have to traversely find the matched subdirectory in the current directory.
if let some path ← match srcPath.parent with if let some path ← match srcPath.parent with
| some p => pure $ some $ p / str | some p => pure <| some <| p / str
| none => do | none => do
let foundDir ← traverseDir currentDir λ p => p / str |>.pathExists let foundDir ← traverseDir currentDir λ p => p / str |>.pathExists
pure $ foundDir.map (· / str) pure <| foundDir.map (· / str)
then then
if ←path.pathExists then if ←path.pathExists then
if ←path.isDir then if ←path.isDir then
throwError s!"{str} is a directory" throwError s!"{str} is a directory"
else else
let content ← FS.readFile path let content ← FS.readFile path
pure $ mkStrLit content pure <| mkStrLit content
else else
throwError s!"{path} does not exist as a file" throwError s!"{path} does not exist as a file"
else else

View File

@ -55,7 +55,7 @@ def Token.toHtml (t : Token) : AlectryonM Html := do
-- TODO: render docstring -- TODO: render docstring
let mut parts := #[] let mut parts := #[]
if let some tyi := t.typeinfo then if let some tyi := t.typeinfo then
parts := parts.push $ ←tyi.toHtml parts := parts.push <| ←tyi.toHtml
parts := parts.push t.processSemantic parts := parts.push t.processSemantic
@ -218,6 +218,6 @@ def moduleToHtml (module : Process.Module) (inkPath : System.FilePath) (sourceFi
let baseCtx ← readThe SiteBaseContext let baseCtx ← readThe SiteBaseContext
let (html, _) := render |>.run ctx baseCtx let (html, _) := render |>.run ctx baseCtx
pure html pure html
| .error err => throw $ IO.userError s!"Error while parsing LeanInk Output: {err}" | .error err => throw <| IO.userError s!"Error while parsing LeanInk Output: {err}"
end DocGen4.Output.LeanInk end DocGen4.Output.LeanInk

View File

@ -33,8 +33,8 @@ def runInk (inkPath : System.FilePath) (sourceFilePath : System.FilePath) : IO J
match Json.parse output with match Json.parse output with
| .ok out => pure out | .ok out => pure out
| .error err => | .error err =>
throw $ IO.userError s!"LeanInk returned invalid JSON for file: {sourceFilePath}:\n{err}" throw <| IO.userError s!"LeanInk returned invalid JSON for file: {sourceFilePath}:\n{err}"
| code => | code =>
throw $ IO.userError s!"LeanInk exited with code {code} for file: {sourceFilePath}:\n{←inkProcess.stderr.readToEnd}" throw <| IO.userError s!"LeanInk exited with code {code} for file: {sourceFilePath}:\n{←inkProcess.stderr.readToEnd}"
end DocGen4.Output.LeanInk end DocGen4.Output.LeanInk

View File

@ -21,7 +21,7 @@ as well as all the dependencies.
-/ -/
def lakeSetup (imports : List String) : IO (Except UInt32 Lake.Workspace) := do def lakeSetup (imports : List String) : IO (Except UInt32 Lake.Workspace) := do
let (leanInstall?, lakeInstall?) ← Lake.findInstall? let (leanInstall?, lakeInstall?) ← Lake.findInstall?
match ←(EIO.toIO' $ Lake.mkLoadConfig {leanInstall?, lakeInstall?}) with match ←(EIO.toIO' <| Lake.mkLoadConfig {leanInstall?, lakeInstall?}) with
| .ok config => | .ok config =>
let ws : Lake.Workspace ← Lake.loadWorkspace config |>.run Lake.MonadLog.eio let ws : Lake.Workspace ← Lake.loadWorkspace config |>.run Lake.MonadLog.eio
let libraryLeanGitHash := ws.env.lean.githash let libraryLeanGitHash := ws.env.lean.githash
@ -30,16 +30,16 @@ def lakeSetup (imports : List String) : IO (Except UInt32 Lake.Workspace) := do
let ctx ← Lake.mkBuildContext ws let ctx ← Lake.mkBuildContext ws
(ws.root.buildImportsAndDeps imports *> pure ()) |>.run Lake.MonadLog.eio ctx (ws.root.buildImportsAndDeps imports *> pure ()) |>.run Lake.MonadLog.eio ctx
initSearchPath (←findSysroot) ws.leanPaths.oleanPath initSearchPath (←findSysroot) ws.leanPaths.oleanPath
pure $ Except.ok ws pure <| Except.ok ws
| .error err => | .error err =>
throw $ IO.userError err.toString throw <| IO.userError err.toString
def envOfImports (imports : List Name) : IO Environment := do def envOfImports (imports : List Name) : IO Environment := do
importModules (imports.map (Import.mk · false)) Options.empty importModules (imports.map (Import.mk · false)) Options.empty
def loadInit (imports : List Name) : IO Hierarchy := do def loadInit (imports : List Name) : IO Hierarchy := do
let env ← envOfImports imports let env ← envOfImports imports
pure $ Hierarchy.fromArray env.header.moduleNames pure <| Hierarchy.fromArray env.header.moduleNames
/-- /--
Load a list of modules from the current Lean search path into an `Environment` Load a list of modules from the current Lean search path into an `Environment`

View File

@ -90,7 +90,7 @@ def htmlOutputResults (baseConfig : SiteBaseContext) (result : AnalyzerResult) (
--let sourceSearchPath := ((←Lean.findSysroot) / "src" / "lean") :: ws.root.srcDir :: ws.leanSrcPath --let sourceSearchPath := ((←Lean.findSysroot) / "src" / "lean") :: ws.root.srcDir :: ws.leanSrcPath
let sourceSearchPath := ws.root.srcDir :: ws.leanSrcPath let sourceSearchPath := ws.root.srcDir :: ws.leanSrcPath
discard $ htmlOutputDeclarationDatas result |>.run config baseConfig discard <| htmlOutputDeclarationDatas result |>.run config baseConfig
for (modName, module) in result.moduleInfo.toArray do for (modName, module) in result.moduleInfo.toArray do
let fileDir := moduleNameToDirectory basePath modName let fileDir := moduleNameToDirectory basePath modName
@ -99,7 +99,7 @@ def htmlOutputResults (baseConfig : SiteBaseContext) (result : AnalyzerResult) (
-- The last component is the file name, so we drop it from the depth to root. -- The last component is the file name, so we drop it from the depth to root.
let baseConfig := { baseConfig with depthToRoot := modName.components.dropLast.length } let baseConfig := { baseConfig with depthToRoot := modName.components.dropLast.length }
let moduleHtml := moduleToHtml module |>.run config baseConfig let moduleHtml := moduleToHtml module |>.run config baseConfig
FS.createDirAll $ fileDir FS.createDirAll fileDir
FS.writeFile filePath moduleHtml.toString FS.writeFile filePath moduleHtml.toString
if let some inkPath := inkPath then if let some inkPath := inkPath then
if let some inputPath ← Lean.SearchPath.findModuleWithExt sourceSearchPath "lean" module.name then if let some inputPath ← Lean.SearchPath.findModuleWithExt sourceSearchPath "lean" module.name then

View File

@ -75,7 +75,7 @@ def getRoot : BaseHtmlM String := do
def getHierarchy : BaseHtmlM Hierarchy := do pure (←read).hierarchy def getHierarchy : BaseHtmlM Hierarchy := do pure (←read).hierarchy
def getCurrentName : BaseHtmlM (Option Name) := do pure (←read).currentName def getCurrentName : BaseHtmlM (Option Name) := do pure (←read).currentName
def getResult : HtmlM AnalyzerResult := do pure (←read).result def getResult : HtmlM AnalyzerResult := do pure (←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 pure <| (←read).sourceLinker module range
def leanInkEnabled? : HtmlM Bool := do pure (←read).leanInkEnabled def leanInkEnabled? : HtmlM Bool := do pure (←read).leanInkEnabled
/-- /--
@ -93,7 +93,7 @@ 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" pure <| (← 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.
@ -106,7 +106,7 @@ 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" pure <| (← 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.
@ -149,7 +149,7 @@ 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 pure <| (←moduleNameToLink module) ++ "#" ++ name.toString
/-- /--
Returns the HTML doc-gen4 link to a declaration name. Returns the HTML doc-gen4 link to a declaration name.
@ -163,7 +163,7 @@ 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 pure <| (←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"
@ -185,7 +185,7 @@ only `+` should be linked, taking care of this is what this function is
responsible for. responsible for.
-/ -/
def splitWhitespaces (s : String) : (String × String × String) := Id.run do def splitWhitespaces (s : String) : (String × String × String) := Id.run do
let front := "".pushn ' ' $ s.offsetOfPos (s.find (!Char.isWhitespace ·)) let front := "".pushn ' ' <| s.offsetOfPos (s.find (!Char.isWhitespace ·))
let mut s := s.trimLeft let mut s := s.trimLeft
let back := "".pushn ' ' (s.length - s.offsetOfPos (s.find Char.isWhitespace)) let back := "".pushn ' ' (s.length - s.offsetOfPos (s.find Char.isWhitespace))
s := s.trimRight s := s.trimRight
@ -199,7 +199,7 @@ 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
| TaggedText.text t => pure #[Html.escape t] | TaggedText.text t => pure #[Html.escape t]
| TaggedText.append tt => tt.foldlM (λ acc t => do pure $ acc ++ (←infoFormatToHtml t)) #[] | TaggedText.append tt => tt.foldlM (λ acc t => do pure <| acc ++ (←infoFormatToHtml t)) #[]
| TaggedText.tag a t => | TaggedText.tag a t =>
match a.info.val.info with match a.info.val.info with
| Info.ofTermInfo i => | Info.ofTermInfo i =>
@ -207,7 +207,7 @@ partial def infoFormatToHtml (i : CodeWithInfos) : HtmlM (Array Html) := do
| Expr.const name _ => | Expr.const name _ =>
match t with match t with
| TaggedText.text t => | TaggedText.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] pure #[Html.text front, elem, Html.text back]
| _ => | _ =>

View File

@ -161,7 +161,7 @@ def autoLink (el : Element) : HtmlM Element := do
match link? with match link? with
| some link => | some link =>
let attributes := Std.RBMap.empty.insert "href" link let attributes := Std.RBMap.empty.insert "href" link
pure [Content.Element $ Element.Element "a" attributes #[Content.Character s]] pure [Content.Element <| Element.Element "a" attributes #[Content.Character s]]
| none => | none =>
let sHead := s.dropRightWhile (λ c => c ≠ '.') let sHead := s.dropRightWhile (λ c => c ≠ '.')
let sTail := s.takeRightWhile (λ c => c ≠ '.') let sTail := s.takeRightWhile (λ c => c ≠ '.')
@ -171,7 +171,7 @@ def autoLink (el : Element) : HtmlM Element := do
let attributes := Std.RBMap.empty.insert "href" link' let attributes := Std.RBMap.empty.insert "href" link'
pure [ pure [
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] pure [Content.Character s]
@ -204,7 +204,7 @@ def docStringToHtml (s : String) : HtmlM (Array Html) := do
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 (← modifyElement x)) pure (Html.text <| toString (← modifyElement x))
| _ => pure #[Html.text rendered] | _ => pure #[Html.text rendered]
end Output end Output

View File

@ -11,7 +11,8 @@ namespace Output
open scoped DocGen4.Jsx open scoped DocGen4.Jsx
def index : BaseHtmlM Html := do templateExtends (baseHtml "Index") $ pure $ def index : BaseHtmlM Html := do templateExtends (baseHtml "Index") <|
pure <|
<main> <main>
<a id="top"></a> <a id="top"></a>
<h1> Welcome to the documentation page </h1> <h1> Welcome to the documentation page </h1>

View File

@ -65,7 +65,7 @@ and name.
-/ -/
def docInfoHeader (doc : DocInfo) : HtmlM Html := do def docInfoHeader (doc : DocInfo) : HtmlM Html := do
let mut nodes := #[] let mut nodes := #[]
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}>
@ -168,7 +168,7 @@ 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 pure <| 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
@ -207,7 +207,7 @@ 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 (λ i => moduleMemberToHtml module.name i)
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

@ -49,7 +49,7 @@ 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> pure <div class="module_list">[list]</div>
/-- /--

View File

@ -14,7 +14,8 @@ open scoped DocGen4.Jsx
/-- /--
Render the 404 page. Render the 404 page.
-/ -/
def notFound : BaseHtmlM Html := do templateExtends (baseHtml "404") $ pure $ def notFound : BaseHtmlM Html := do templateExtends (baseHtml "404") <|
pure <|
<main> <main>
<h1>404 Not Found</h1> <h1>404 Not Found</h1>
<p> Unfortunately, the page you were looking for is no longer here. </p> <p> Unfortunately, the page you were looking for is no longer here. </p>

View File

@ -27,7 +27,7 @@ def getGithubBaseUrl (gitUrl : String) : String := Id.run do
url := url.dropRight 4 url := url.dropRight 4
pure s!"https://github.com/{url}" pure s!"https://github.com/{url}"
else if url.endsWith ".git" then else if url.endsWith ".git" then
pure $ url.dropRight 4 pure <| url.dropRight 4
else else
pure url pure url
@ -70,7 +70,7 @@ def sourceLinker (ws : Lake.Workspace) : IO (Name → Option DeclarationRange
| _ => ("https://example.com", "master") | _ => ("https://example.com", "master")
gitMap := gitMap.insert dep.name value gitMap := gitMap.insert dep.name value
pure $ λ module range => pure λ 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

@ -104,7 +104,7 @@ def translateAttrs (attrs : Array (TSyntax `DocGen4.Jsx.jsxAttr)) : MacroM (TSyn
| `(jsxAttr| $n:jsxAttrName=$v:jsxAttrVal) => | `(jsxAttr| $n:jsxAttrName=$v:jsxAttrVal) =>
let n ← match n with let n ← match n with
| `(jsxAttrName| $n:str) => pure n | `(jsxAttrName| $n:str) => pure n
| `(jsxAttrName| $n:ident) => pure $ quote (toString n.getId) | `(jsxAttrName| $n:ident) => pure <| quote (toString n.getId)
| _ => Macro.throwUnsupported | _ => Macro.throwUnsupported
let v ← match v with let v ← match v with
| `(jsxAttrVal| {$v}) => pure v | `(jsxAttrVal| {$v}) => pure v
@ -128,7 +128,7 @@ private def htmlHelper (n : Syntax) (children : Array Syntax) (m : Syntax) : Mac
| `(jsxChild|$e:jsxElement) => `(($cs).push ($e:jsxElement : Html)) | `(jsxChild|$e:jsxElement) => `(($cs).push ($e:jsxElement : Html))
| _ => Macro.throwUnsupported | _ => Macro.throwUnsupported
let tag := toString n.getId let tag := toString n.getId
pure $ (tag, cs) pure <| (tag, cs)
macro_rules macro_rules
| `(<$n $attrs* />) => do | `(<$n $attrs* />) => do

View File

@ -47,6 +47,6 @@ def Process.Module.toJson (module : Process.Module) : HtmlM Json := do
instances := instances instances := instances
imports := module.imports.map Name.toString imports := module.imports.map Name.toString
} }
pure $ ToJson.toJson jsonMod pure <| ToJson.toJson jsonMod
end DocGen4.Output end DocGen4.Output

View File

@ -79,15 +79,6 @@ def getDocString : ModuleMember → Option String
end ModuleMember end ModuleMember
def getRelevantModules (imports : List Name) : MetaM (HashSet Name) := do
let env ← getEnv
let mut relevant := .empty
for module in env.header.moduleNames do
for import in imports do
if import == module then
relevant := relevant.insert module
pure relevant
inductive AnalyzeTask where inductive AnalyzeTask where
| loadAll (load : List Name) : AnalyzeTask | loadAll (load : List Name) : AnalyzeTask
| loadAllLimitAnalysis (analyze : List Name) : AnalyzeTask | loadAllLimitAnalysis (analyze : List Name) : AnalyzeTask
@ -104,7 +95,7 @@ def getAllModuleDocs (relevantModules : Array Name) : MetaM (HashMap Name Module
let some modIdx := env.getModuleIdx? module | unreachable! let some modIdx := env.getModuleIdx? module | unreachable!
let moduleData := env.header.moduleData.get! modIdx let moduleData := env.header.moduleData.get! modIdx
let imports := moduleData.imports.map Import.module let imports := moduleData.imports.map Import.module
res := res.insert module $ Module.mk module modDocs imports res := res.insert module <| Module.mk module modDocs imports
pure res pure res
/-- /--
@ -113,9 +104,9 @@ of this `MetaM` run and mentioned by the `AnalyzeTask`.
-/ -/
def process (task : AnalyzeTask) : MetaM (AnalyzerResult × Hierarchy) := do def process (task : AnalyzeTask) : MetaM (AnalyzerResult × Hierarchy) := do
let env ← getEnv let env ← getEnv
let relevantModules match task with let relevantModules := match task with
| .loadAll _ => pure $ HashSet.fromArray env.header.moduleNames | .loadAll _ => HashSet.fromArray env.header.moduleNames
| .loadAllLimitAnalysis analysis => getRelevantModules analysis | .loadAllLimitAnalysis analysis => HashSet.fromArray analysis.toArray
let allModules := env.header.moduleNames let allModules := env.header.moduleNames
let mut res ← getAllModuleDocs relevantModules.toArray let mut res ← getAllModuleDocs relevantModules.toArray

View File

@ -101,11 +101,11 @@ def parametricAttributes : Array ParametricAttrWrapper := #[⟨externAttr⟩,
def getTags (decl : Name) : MetaM (Array String) := do def getTags (decl : Name) : MetaM (Array String) := do
let env ← getEnv let env ← getEnv
pure $ tagAttributes.filter (TagAttribute.hasTag · env decl) |>.map (λ t => t.attr.name.toString) pure <| tagAttributes.filter (TagAttribute.hasTag · env decl) |>.map (λ t => t.attr.name.toString)
def getValuesAux {α : Type} {attrKind : Type → Type} [va : ValueAttr attrKind] [Inhabited α] [ToString α] (decl : Name) (attr : attrKind α) : MetaM (Option String) := do def getValuesAux {α : Type} {attrKind : Type → Type} [va : ValueAttr attrKind] [Inhabited α] [ToString α] (decl : Name) (attr : attrKind α) : MetaM (Option String) := do
let env ← getEnv let env ← getEnv
pure $ va.getValue attr env decl pure <| va.getValue attr env decl
def getValues {attrKind : Type → Type} [ValueAttr attrKind] (decl : Name) (attrs : Array (ValueAttrWrapper attrKind)) : MetaM (Array String) := do def getValues {attrKind : Type → Type} [ValueAttr attrKind] (decl : Name) (attrs : Array (ValueAttrWrapper attrKind)) : MetaM (Array String) := do
let env ← getEnv let env ← getEnv
@ -122,12 +122,12 @@ def getDefaultInstance (decl : Name) (className : Name) : MetaM (Option String)
let insts ← getDefaultInstances className let insts ← getDefaultInstances className
for (inst, prio) in insts do for (inst, prio) in insts do
if inst == decl then if inst == decl then
return some $ s!"defaultInstance {prio}" return some s!"defaultInstance {prio}"
pure none pure none
def hasSimp (decl : Name) : MetaM (Option String) := do def hasSimp (decl : Name) : MetaM (Option String) := do
let thms ← simpExtension.getTheorems let thms ← simpExtension.getTheorems
pure $ pure <|
if thms.isLemma decl then if thms.isLemma decl then
some "simp" some "simp"
else else
@ -135,7 +135,7 @@ def hasSimp (decl : Name) : MetaM (Option String) := do
def hasCsimp (decl : Name) : MetaM (Option String) := do def hasCsimp (decl : Name) : MetaM (Option String) := do
let env ← getEnv let env ← getEnv
pure $ pure <|
if Compiler.hasCSimpAttribute env decl then if Compiler.hasCSimpAttribute env decl then
some "csimp" some "csimp"
else else
@ -163,6 +163,6 @@ def getAllAttributes (decl : Name) : MetaM (Array String) := do
let enums ← getEnumValues decl let enums ← getEnumValues decl
let parametric ← getParametricValues decl let parametric ← getParametricValues decl
let customs ← getCustomAttrs decl let customs ← getCustomAttrs decl
pure $ customs ++ tags ++ enums ++ parametric pure <| customs ++ tags ++ enums ++ parametric
end DocGen4 end DocGen4

View File

@ -14,6 +14,6 @@ open Lean Meta
def AxiomInfo.ofAxiomVal (v : AxiomVal) : MetaM AxiomInfo := do def AxiomInfo.ofAxiomVal (v : AxiomVal) : MetaM AxiomInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
pure $ AxiomInfo.mk info v.isUnsafe pure <| AxiomInfo.mk info v.isUnsafe
end DocGen4.Process end DocGen4.Process

View File

@ -176,9 +176,9 @@ def prettyPrintTerm (expr : Expr) : MetaM CodeWithInfos := do
fileMap := default, fileMap := default,
ngen := ← getNGen ngen := ← getNGen
} }
pure $ tagExprInfos ctx infos tt pure <| tagExprInfos ctx infos tt
def isInstance (declName : Name) : MetaM Bool := do def isInstance (declName : Name) : MetaM Bool := do
pure $ (instanceExtension.getState (←getEnv)).instanceNames.contains declName pure <| (instanceExtension.getState (←getEnv)).instanceNames.contains declName
end DocGen4.Process end DocGen4.Process

View File

@ -45,13 +45,13 @@ def DefinitionInfo.ofDefinitionVal (v : DefinitionVal) : MetaM DefinitionInfo :=
match eqs? with match eqs? with
| some eqs => | some eqs =>
let prettyEqs ← eqs.mapM processEq let prettyEqs ← eqs.mapM processEq
pure $ DefinitionInfo.mk info isUnsafe v.hints prettyEqs isNonComput pure <| DefinitionInfo.mk info isUnsafe v.hints prettyEqs isNonComput
| none => | none =>
let eq ← prettyPrintTerm $ stripArgs (←valueToEq v) let eq ← prettyPrintTerm <| stripArgs (←valueToEq v)
pure $ DefinitionInfo.mk info isUnsafe v.hints (some #[eq]) isNonComput pure <| DefinitionInfo.mk info isUnsafe v.hints (some #[eq]) isNonComput
catch err => catch err =>
IO.println s!"WARNING: Failed to calculate equational lemmata for {v.name}: {←err.toMessageData.toString}" IO.println s!"WARNING: Failed to calculate equational lemmata for {v.name}: {←err.toMessageData.toString}"
pure $ DefinitionInfo.mk info isUnsafe v.hints none isNonComput pure <| DefinitionInfo.mk info isUnsafe v.hints none isNonComput
end DocGen4.Process end DocGen4.Process

View File

@ -103,8 +103,8 @@ def isBlackListed (declName : Name) : MetaM Bool := do
| some _ => | some _ =>
let env ← getEnv let env ← getEnv
pure (declName.isInternal) pure (declName.isInternal)
<||> (pure $ isAuxRecursor env declName) <||> (pure <| isAuxRecursor env declName)
<||> (pure $ isNoConfusion env declName) <||> (pure <| isNoConfusion env declName)
<||> isRec declName <||> isRec declName
<||> isMatcher declName <||> isMatcher declName
-- TODO: Evaluate whether filtering out declarations without range is sensible -- TODO: Evaluate whether filtering out declarations without range is sensible
@ -134,10 +134,10 @@ def ofConstant : (Name × ConstantInfo) → MetaM (Option DocInfo) := λ (name,
| ConstantInfo.thmInfo i => pure <| some <| theoremInfo (←TheoremInfo.ofTheoremVal i) | ConstantInfo.thmInfo i => pure <| some <| theoremInfo (←TheoremInfo.ofTheoremVal i)
| ConstantInfo.opaqueInfo i => pure <| some <| opaqueInfo (←OpaqueInfo.ofOpaqueVal i) | ConstantInfo.opaqueInfo i => pure <| some <| opaqueInfo (←OpaqueInfo.ofOpaqueVal i)
| ConstantInfo.defnInfo i => | ConstantInfo.defnInfo i =>
if ← (isProjFn i.name) then if ←isProjFn i.name then
pure none pure none
else else
if (←isInstance i.name) then if ←isInstance i.name then
let info ← InstanceInfo.ofDefinitionVal i let info ← InstanceInfo.ofDefinitionVal i
pure <| some <| instanceInfo info pure <| some <| instanceInfo info
else else
@ -156,9 +156,7 @@ def ofConstant : (Name × ConstantInfo) → MetaM (Option DocInfo) := λ (name,
else else
pure <| some <| inductiveInfo (←InductiveInfo.ofInductiveVal i) pure <| some <| inductiveInfo (←InductiveInfo.ofInductiveVal i)
-- we ignore these for now -- we ignore these for now
| ConstantInfo.ctorInfo i => pure none | ConstantInfo.ctorInfo _ | ConstantInfo.recInfo _ | ConstantInfo.quotInfo _ => pure none
| ConstantInfo.recInfo i => pure none
| ConstantInfo.quotInfo i => pure none
def getKindDescription : DocInfo → String def getKindDescription : DocInfo → String
| axiomInfo i => if i.isUnsafe then "unsafe axiom" else "axiom" | axiomInfo i => if i.isUnsafe then "unsafe axiom" else "axiom"
@ -179,7 +177,7 @@ def getKindDescription : DocInfo → String
modifiers := modifiers.push "noncomputable" modifiers := modifiers.push "noncomputable"
modifiers := modifiers.push "def" modifiers := modifiers.push "def"
pure $ String.intercalate " " modifiers.toList pure <| String.intercalate " " modifiers.toList
| instanceInfo i => Id.run do | instanceInfo i => Id.run do
let mut modifiers := #[] let mut modifiers := #[]
if i.isUnsafe then if i.isUnsafe then
@ -188,7 +186,7 @@ def getKindDescription : DocInfo → String
modifiers := modifiers.push "noncomputable" modifiers := modifiers.push "noncomputable"
modifiers := modifiers.push "instance" modifiers := modifiers.push "instance"
pure $ String.intercalate " " modifiers.toList pure <| String.intercalate " " modifiers.toList
| inductiveInfo i => if i.isUnsafe then "unsafe inductive" else "inductive" | inductiveInfo i => if i.isUnsafe then "unsafe inductive" else "inductive"
| structureInfo _ => "structure" | structureInfo _ => "structure"
| classInfo _ => "class" | classInfo _ => "class"

View File

@ -57,28 +57,28 @@ def getChildren : Hierarchy → HierarchyMap
def isFile : Hierarchy → Bool def isFile : Hierarchy → Bool
| node _ f _ => f | node _ f _ => f
partial def insert! (h : Hierarchy) (n : Name) : Hierarchy := Id.run $ do partial def insert! (h : Hierarchy) (n : Name) : Hierarchy := Id.run do
let hn := h.getName let hn := h.getName
let mut cs := h.getChildren let mut cs := h.getChildren
if getNumParts hn + 1 == getNumParts n then if getNumParts hn + 1 == getNumParts n then
match cs.find Name.cmp n with match cs.find Name.cmp n with
| none => | none =>
node hn h.isFile (cs.insert Name.cmp n $ empty n true) node hn h.isFile (cs.insert Name.cmp n <| empty n true)
| some (node _ true _) => h | some (node _ true _) => h
| some (node _ false ccs) => | some (node _ false ccs) =>
cs := cs.erase Name.cmp n cs := cs.erase Name.cmp n
node hn h.isFile (cs.insert Name.cmp n $ node n true ccs) node hn h.isFile (cs.insert Name.cmp n <| node n true ccs)
else else
let leveledName := getNLevels n (getNumParts hn + 1) let leveledName := getNLevels n (getNumParts hn + 1)
match cs.find Name.cmp leveledName with match cs.find Name.cmp leveledName with
| some nextLevel => | some nextLevel =>
cs := cs.erase Name.cmp leveledName cs := cs.erase Name.cmp leveledName
-- BUG? -- BUG?
node hn h.isFile $ cs.insert Name.cmp leveledName (nextLevel.insert! n) node hn h.isFile <| cs.insert Name.cmp leveledName (nextLevel.insert! n)
| none => | none =>
let child := (insert! (empty leveledName false) n) let child := (insert! (empty leveledName false) n)
node hn h.isFile $ cs.insert Name.cmp leveledName child node hn h.isFile <| cs.insert Name.cmp leveledName child
partial def fromArray (names : Array Name) : Hierarchy := partial def fromArray (names : Array Name) : Hierarchy :=
names.foldl insert! (empty anonymous false) names.foldl insert! (empty anonymous false)
@ -106,7 +106,7 @@ partial def fromDirectoryAux (dir : System.FilePath) (previous : Name) : IO (Arr
if (←entry.path.isDir) then if (←entry.path.isDir) then
children := children ++ (←fromDirectoryAux entry.path (.str previous entry.fileName)) children := children ++ (←fromDirectoryAux entry.path (.str previous entry.fileName))
else else
children := children.push $ .str previous (entry.fileName.dropRight ".html".length) children := children.push <| .str previous (entry.fileName.dropRight ".html".length)
pure children pure children
def fromDirectory (dir : System.FilePath) : IO Hierarchy := do def fromDirectory (dir : System.FilePath) : IO Hierarchy := do
@ -114,7 +114,7 @@ def fromDirectory (dir : System.FilePath) : IO Hierarchy := do
for entry in ←System.FilePath.readDir dir do for entry in ←System.FilePath.readDir dir do
if !baseDirBlackList.contains entry.fileName && (←entry.path.isDir) then if !baseDirBlackList.contains entry.fileName && (←entry.path.isDir) then
children := children ++ (←fromDirectoryAux entry.path (.mkSimple entry.fileName)) children := children ++ (←fromDirectoryAux entry.path (.mkSimple entry.fileName))
pure $ Hierarchy.fromArray children pure <| Hierarchy.fromArray children
end Hierarchy end Hierarchy
end DocGen4 end DocGen4

View File

@ -22,6 +22,6 @@ def InductiveInfo.ofInductiveVal (v : InductiveVal) : MetaM InductiveInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
let env ← getEnv let env ← getEnv
let ctors ← v.ctors.mapM (λ name => do NameInfo.ofTypedName name (←getConstructorType name)) let ctors ← v.ctors.mapM (λ name => do NameInfo.ofTypedName name (←getConstructorType name))
pure $ InductiveInfo.mk info ctors v.isUnsafe pure <| InductiveInfo.mk info ctors v.isUnsafe
end DocGen4.Process end DocGen4.Process

View File

@ -17,8 +17,8 @@ def InstanceInfo.ofDefinitionVal (v : DefinitionVal) : MetaM InstanceInfo := do
let info ← DefinitionInfo.ofDefinitionVal v let info ← DefinitionInfo.ofDefinitionVal v
let some className := getClassName (←getEnv) v.type | unreachable! let some className := getClassName (←getEnv) v.type | unreachable!
if let some instAttr ← getDefaultInstance v.name className then if let some instAttr ← getDefaultInstance v.name className then
pure $ InstanceInfo.mk { info with attrs := info.attrs.push instAttr } className pure <| InstanceInfo.mk { info with attrs := info.attrs.push instAttr } className
else else
pure $ InstanceInfo.mk info className pure <| InstanceInfo.mk info className
end DocGen4.Process end DocGen4.Process

View File

@ -35,11 +35,11 @@ partial def typeToArgsType (e : Expr) : (Array (Name × Expr × BinderInfo) × E
def Info.ofConstantVal (v : ConstantVal) : MetaM Info := do def Info.ofConstantVal (v : ConstantVal) : MetaM Info := do
let (args, type) := typeToArgsType v.type let (args, type) := typeToArgsType v.type
let args ← args.mapM (λ (n, e, b) => do pure $ Arg.mk n (←prettyPrintTerm e) b) let args ← args.mapM (λ (n, e, b) => do pure <| Arg.mk n (←prettyPrintTerm e) b)
let nameInfo ← NameInfo.ofTypedName v.name type let nameInfo ← NameInfo.ofTypedName v.name type
match ←findDeclarationRanges? v.name with match ←findDeclarationRanges? v.name with
-- TODO: Maybe selection range is more relevant? Figure this out in the future -- TODO: Maybe selection range is more relevant? Figure this out in the future
| some range => pure $ Info.mk nameInfo args range.range (←getAllAttributes v.name) | some range => pure <| Info.mk nameInfo args range.range (←getAllAttributes v.name)
| none => panic! s!"{v.name} is a declaration without position" | none => panic! s!"{v.name} is a declaration without position"
end DocGen4.Process end DocGen4.Process

View File

@ -18,9 +18,9 @@ def OpaqueInfo.ofOpaqueVal (v : OpaqueVal) : MetaM OpaqueInfo := do
let env ← getEnv let env ← getEnv
let isPartial := env.find? (Compiler.mkUnsafeRecName v.name) |>.isSome let isPartial := env.find? (Compiler.mkUnsafeRecName v.name) |>.isSome
if isPartial then if isPartial then
pure $ OpaqueInfo.mk info t DefinitionSafety.partial pure <| OpaqueInfo.mk info t DefinitionSafety.partial
else else
let safety := if v.isUnsafe then DefinitionSafety.unsafe else DefinitionSafety.safe let safety := if v.isUnsafe then DefinitionSafety.unsafe else DefinitionSafety.safe
pure $ OpaqueInfo.mk info t safety pure <| OpaqueInfo.mk info t safety
end DocGen4.Process end DocGen4.Process

View File

@ -17,7 +17,7 @@ def dropArgs (type : Expr) (n : Nat) : (Expr × List (Name × Expr)) :=
match type, n with match type, n with
| e, 0 => (e, []) | e, 0 => (e, [])
| Expr.forallE name type body _, x + 1 => | Expr.forallE name type body _, x + 1 =>
let body := body.instantiate1 $ mkFVar ⟨name⟩ let body := body.instantiate1 <| mkFVar ⟨name⟩
let next := dropArgs body x let next := dropArgs body x
{ next with snd := (name, type) :: next.snd} { next with snd := (name, type) :: next.snd}
| e, x + 1 => panic! s!"No forallE left" | e, x + 1 => panic! s!"No forallE left"
@ -28,8 +28,8 @@ def getFieldTypes (struct : Name) (ctor : ConstructorVal) (parents : Nat) : Meta
let (_, fields) := dropArgs fieldFunction (ctor.numFields - parents) let (_, fields) := dropArgs fieldFunction (ctor.numFields - parents)
let mut fieldInfos := #[] let mut fieldInfos := #[]
for (name, type) in fields do for (name, type) in fields do
fieldInfos := fieldInfos.push $ ←NameInfo.ofTypedName (struct.append name) type fieldInfos := fieldInfos.push <| ←NameInfo.ofTypedName (struct.append name) type
pure $ fieldInfos pure <| fieldInfos
def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
@ -39,9 +39,9 @@ def StructureInfo.ofInductiveVal (v : InductiveVal) : MetaM StructureInfo := do
match getStructureInfo? env v.name with match getStructureInfo? env v.name with
| some i => | some i =>
if i.fieldNames.size - parents.size > 0 then if i.fieldNames.size - parents.size > 0 then
pure $ StructureInfo.mk info (←getFieldTypes v.name ctor parents.size) parents (←NameInfo.ofTypedName ctor.name ctor.type) pure <| StructureInfo.mk info (←getFieldTypes v.name ctor parents.size) parents (←NameInfo.ofTypedName ctor.name ctor.type)
else else
pure $ StructureInfo.mk info #[] parents (←NameInfo.ofTypedName ctor.name ctor.type) pure <| StructureInfo.mk info #[] parents (←NameInfo.ofTypedName ctor.name ctor.type)
| none => panic! s!"{v.name} is not a structure" | none => panic! s!"{v.name} is not a structure"
end DocGen4.Process end DocGen4.Process

View File

@ -14,6 +14,6 @@ open Lean Meta
def TheoremInfo.ofTheoremVal (v : TheoremVal) : MetaM TheoremInfo := do def TheoremInfo.ofTheoremVal (v : TheoremVal) : MetaM TheoremInfo := do
let info ← Info.ofConstantVal v.toConstantVal let info ← Info.ofConstantVal v.toConstantVal
pure $ TheoremInfo.mk info pure <| TheoremInfo.mk info
end DocGen4.Process end DocGen4.Process

View File

@ -9,15 +9,15 @@ def findLeanInk? (p : Parsed) : IO (Option System.FilePath) := do
| some ink => | some ink =>
let inkPath := System.FilePath.mk ink.value let inkPath := System.FilePath.mk ink.value
if ←inkPath.pathExists then if ←inkPath.pathExists then
pure $ some inkPath pure <| some inkPath
else else
throw $ IO.userError "Invalid path to LeanInk binary provided" throw <| IO.userError "Invalid path to LeanInk binary provided"
| none => pure none | none => pure none
def getTopLevelModules (p : Parsed) : IO (List String) := do def getTopLevelModules (p : Parsed) : IO (List String) := do
let topLevelModules := p.variableArgsAs! String |>.toList let topLevelModules := p.variableArgsAs! String |>.toList
if topLevelModules.length == 0 then if topLevelModules.length == 0 then
throw $ IO.userError "No topLevelModules provided." throw <| IO.userError "No topLevelModules provided."
pure topLevelModules pure topLevelModules
def runSingleCmd (p : Parsed) : IO UInt32 := do def runSingleCmd (p : Parsed) : IO UInt32 := do
@ -42,7 +42,7 @@ def runIndexCmd (p : Parsed) : IO UInt32 := do
def runDocGenCmd (p : Parsed) : IO UInt32 := do def runDocGenCmd (p : Parsed) : IO UInt32 := do
let modules : List String := p.variableArgsAs! String |>.toList let modules : List String := p.variableArgsAs! String |>.toList
if modules.length == 0 then if modules.length == 0 then
throw $ IO.userError "No modules provided." throw <| IO.userError "No modules provided."
let res ← lakeSetup modules let res ← lakeSetup modules
match res with match res with