3e2124bb48
This PR upstreams the Verso parser and adds preliminary support for Verso in docstrings. This will allow the compiler to check examples and cross-references in documentation. After a `stage0` update, a follow-up PR will add the appropriate attributes that allow the feature to be used. The parser tests from Verso also remain to be upstreamed, and user-facing documentation will be added once the feature has been used on more internals.
116 lines
3.9 KiB
Text
116 lines
3.9 KiB
Text
/-
|
||
Copyright (c) 2025 Lean FRO. All rights reserved.
|
||
Released under Apache 2.0 license as described in the file LICENSE.
|
||
|
||
Author: David Thrane Christiansen
|
||
-/
|
||
import Lean.DocString.Parser
|
||
|
||
/-!
|
||
This file tests the Verso parser.
|
||
|
||
Input files are expected to be snippets of code; their filename picks which parser is used.
|
||
-/
|
||
|
||
open Lean Doc Parser
|
||
|
||
def ppSyntax (stx : Syntax) : Std.Format := .nest 2 <| stx.formatStx (some 50) false
|
||
|
||
open Std Format in
|
||
def ppStack (elts : Array Syntax) (number : Bool := false) : Format := Id.run do
|
||
let mut stk : Format := .nil
|
||
if h : elts.size = 0 then
|
||
stk := " empty"
|
||
else if elts.size = 1 then
|
||
stk := " " ++ ppSyntax elts[0]
|
||
else
|
||
for h : i in [0:elts.size] do
|
||
let tm := ppSyntax (elts[i])
|
||
let num := if number then .text s!"[{i}] " else .nil
|
||
stk := stk ++ .group (" • " ++ num ++ nest 2 (.group tm)) ++ line
|
||
pure stk
|
||
|
||
def test (p : ParserFn) (input : String) : IO String := do
|
||
let ictx := mkInputContext input "<input>"
|
||
let env : Environment ← mkEmptyEnvironment
|
||
let pmctx : ParserModuleContext := {env := env, options := {}}
|
||
let s' := p.run ictx pmctx (getTokenTable env) (mkParserState input)
|
||
let stk := ppStack <| s'.stxStack.extract 0 s'.stxStack.size
|
||
|
||
let remaining : String :=
|
||
if s'.pos ≥ input.endPos then "All input consumed."
|
||
else s!"Remaining:\n{repr (input.extract s'.pos input.endPos)}"
|
||
|
||
if s'.allErrors.isEmpty then
|
||
return s!"Success! Final stack:\n{stk.pretty 50}\n{remaining}"
|
||
else if let #[(p, _, err)] := s'.allErrors then
|
||
return s!"Failure @{p} ({ictx.fileMap.toPosition p}): {toString err}\n\
|
||
Final stack:\n\
|
||
{stk.pretty 50}\n\
|
||
Remaining: {repr $ input.extract p input.endPos}"
|
||
else
|
||
let mut errors := ""
|
||
for (p, _, e) in s'.allErrors.qsort errLt do
|
||
errors :=
|
||
errors ++
|
||
s!" @{p} ({ictx.fileMap.toPosition p}): {toString e}\n" ++
|
||
s!" {repr <| input.extract p input.endPos}\n"
|
||
return s!"{s'.allErrors.size} failures:\n{errors}\nFinal stack:\n{stk.pretty 50}"
|
||
where
|
||
errLt (x y : String.Pos × SyntaxStack × Error) : Bool :=
|
||
let (p1, _, e1) := x
|
||
let (p2, _, e2) := y
|
||
p1 < p2 || p1 == p2 && toString e1 < toString e2
|
||
|
||
/--
|
||
The test case's filename determines which parser will be used to test it.
|
||
-/
|
||
def testConfigs : List (String × ParserFn):= [
|
||
("metadataBlock", metadataBlock),
|
||
("arg_val", val),
|
||
("arg", arg),
|
||
("args", args),
|
||
("nameAndArgs", nameAndArgs),
|
||
("inlineTextChar", inlineTextChar),
|
||
("manyInlineTextChar", (asStringFn (many1Fn inlineTextChar))),
|
||
("text", text),
|
||
("emph", (emph {})),
|
||
("code", code),
|
||
("role", (role {})),
|
||
("oneInline", (inline {})),
|
||
("codeBlock", (codeBlock {})),
|
||
("header", (header {})),
|
||
("blocks", (blocks {})),
|
||
("recoverBlock", (recoverBlock (block {}))),
|
||
("recoverBlocks", (recoverBlock (blocks {}))),
|
||
("directive", (directive {})),
|
||
("blockOpener", (ignoreFn blockOpener)),
|
||
("lookaheadUnorderedListIndicator",
|
||
lookaheadUnorderedListIndicator {} (fun type => fakeAtom s! "{repr type}")),
|
||
("lookaheadOrderedListIndicator",
|
||
lookaheadOrderedListIndicator {} (fun type i => fakeAtom s! "{repr type} {i}")),
|
||
("block", (block {})),
|
||
("document", document),
|
||
]
|
||
|
||
def main : List String → IO UInt32
|
||
| [inputFile] => do
|
||
let inputFile : System.FilePath := inputFile
|
||
if inputFile.isAbsolute then
|
||
IO.eprintln s!"Expected a relative path, got {inputFile}"
|
||
return 2
|
||
unless (← inputFile.pathExists) do
|
||
IO.eprintln s!"File not found: {inputFile}"
|
||
return 3
|
||
let [file] := inputFile.components
|
||
| IO.eprintln "Expected file in current directory"
|
||
return 4
|
||
let kind := file.takeWhile (· != '_')
|
||
let some p := testConfigs.lookup kind
|
||
| IO.eprintln s!"Not found in test configs: {kind}"
|
||
return 5
|
||
IO.print <| ← test p (← IO.FS.readFile inputFile)
|
||
return 0
|
||
| args => do
|
||
IO.eprintln s!"Expected precisely one argument, got {args}"
|
||
return 1
|