Nest lists instead of flattening them

Message

parse-list-item has always returned the item's INDENT as its third element, and list-loop has always thrown it away. Every list item at every depth was appended as a sibling, so

    - top
      - inner
        - deeper

produced three siblings in one ul. Silently: no error, no warning, a list came back, just the wrong one.

DELIBERATE GOLDEN BREAK -- bench/golden/block-edge.sxml changes.

The golden was not wrong about what it recorded. It faithfully encoded the behaviour of the parser it was generated from, and that parser had this defect. 0.9.2 replaced an interpreted PEG VM with hand-written scanners under a hard constraint of byte-identical output, gated against goldens taken from the pristine master parser -- so the rewrite reproduced the flattening exactly as it was asked to. Nobody ever decided nested lists should not work.

The diff is one construct in one corpus file; the other five corpus documents remain byte-identical:

  -  (ul (li "indented dash item") (li "deeper indented item"))
  +  (ul (li "indented dash item" (ul (li "deeper indented item"))))

Nesting is decided by the parent ITEM's CONTENT column, not by the list's marker indent. A first cut compared against the list indent and swallowed a 2-space dash item into a preceding "10. " ordered item, whose content begins at column 4. Every unit test used a plain 2-space indent that both rules satisfy, so only the bench corpus caught it.

A dedent step before re-parsing was written and then removed. It was measured across the whole corpus and four hand-built cases -- nested code, deep code, nested fence, over-indented item -- and changed nothing in any of them, because parse-list-item skips leading spaces and the block scanner tests for a list item before it tests for an indented code block. Removed rather than kept as unexercised code justified by a rationale that turned out to be false.

Two false friends made this look covered when it was not: the docs say "Lists nest inline formatting", and the 0.9.2 perf investigation lists "nested emphasis" in its edge-case corpus. Both mean inline nesting. The new tests pin both meanings in one group so the ambiguity cannot recur.

Tests 19 -> 27. Each branch sabotage-tested separately: reverting to the loose rule reddens the content-column tests, disabling the nest branch reddens all five nesting tests, and the flat-list test passes throughout as a positive control.

Consumers -- folio, press and slate all render markdown through this package and all three have been rendering nested lists flat. Each consumes the SXML and may need a follow-up to display a ul inside an li, which none of them has had reason to handle until now.

Changed

 bench/golden/block-edge.sxml        |   2 +-
 bench/golden/block-edge.sxml.actual |   1 +
 src/sigil/markdown.sgl              | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------
 test/test-markdown.sgl              | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 184 insertions(+), 26 deletions(-)

Diff

bench/golden/block-edge.sxmlmodified

@@ -1 +1 @@

−1

(document (p "####### Seven hashes is not a header #NoSpaceAfterHash is not a header") (h6 "Six hashes is a header") (p "#") (p "Paragraph then ####### seven hashes mid-paragraph stays paragraph") (p "-no space after dash") (ul (li "space after dash is a list - " "*" "no space star") (li "plus with space 1.no space after dot")) (ol (li "ordered with space") (li "multi digit ordered 1) paren ordered is not a list ")) (ul (li "indented dash item") (li "deeper indented item")) (p "Text before list") (ul (li "item right after paragraph")) (pre "tilde fence no lang") (pre (@ (lang "ruby")) "tilde fence with lang") (pre "four backtick fence") (pre (@ (lang "js")) "fence with lang js") (pre "indented three-space fence") (blockquote "quote level one quote no space after gt quote with " (strong "bold") " and " (code "code")) (hr) (hr) (p "Regular ending paragraph with trailing text."))

No newline at end of file

(document (p "####### Seven hashes is not a header #NoSpaceAfterHash is not a header") (h6 "Six hashes is a header") (p "#") (p "Paragraph then ####### seven hashes mid-paragraph stays paragraph") (p "-no space after dash") (ul (li "space after dash is a list - " "*" "no space star") (li "plus with space 1.no space after dot")) (ol (li "ordered with space") (li "multi digit ordered 1) paren ordered is not a list ")) (ul (li "indented dash item" (ul (li "deeper indented item")))) (p "Text before list") (ul (li "item right after paragraph")) (pre "tilde fence no lang") (pre (@ (lang "ruby")) "tilde fence with lang") (pre "four backtick fence") (pre (@ (lang "js")) "fence with lang js") (pre "indented three-space fence") (blockquote "quote level one quote no space after gt quote with " (strong "bold") " and " (code "code")) (hr) (hr) (p "Regular ending paragraph with trailing text."))

No newline at end of file

bench/golden/block-edge.sxml.actualadded

@@ -0,0 +1 @@

(document (p "####### Seven hashes is not a header #NoSpaceAfterHash is not a header") (h6 "Six hashes is a header") (p "#") (p "Paragraph then ####### seven hashes mid-paragraph stays paragraph") (p "-no space after dash") (ul (li "space after dash is a list - " "*" "no space star") (li "plus with space 1.no space after dot")) (ol (li "ordered with space") (li "multi digit ordered 1) paren ordered is not a list ")) (ul (li "indented dash item" (ul (li "deeper indented item")))) (p "Text before list") (ul (li "item right after paragraph")) (pre "tilde fence no lang") (pre (@ (lang "ruby")) "tilde fence with lang") (pre "four backtick fence") (pre (@ (lang "js")) "fence with lang js") (pre "indented three-space fence") (blockquote "quote level one quote no space after gt quote with " (strong "bold") " and " (code "code")) (hr) (hr) (p "Regular ending paragraph with trailing text."))

No newline at end of file

src/sigil/markdown.sglmodified

@@ -294,6 +294,26 @@

294

(substring line (+ k 2) len))

295

#f))))))

296

+297

;; The column at which a list item's content begins: its indent plus

+298

;; the width of its marker plus the single following space. A following

+299

;; item nests only if it reaches this column -- comparing against the

+300

;; LIST's indent instead would swallow a shallower item of a different

+301

;; type into the previous one.

+302

(define (item-content-col item-info)

+303

(let ((indent (caddr item-info)))

+304

(if (eq? (car item-info) 'unordered)

+305

(+ indent 2)

+306

(+ indent (string-length (cadr item-info)) 2))))

+307

+308

;; Split one list item's lines into the item's own text and any nested

+309

;; block content. The nested part begins at the first line that itself

+310

;; classifies as a list item.

+311

(define (split-item-lines lines)

+312

(let loop ((seen '()) (rest lines))

+313

(cond ((null? rest) (cons (reverse seen) '()))

+314

((parse-list-item (car rest)) (cons (reverse seen) rest))

+315

(else (loop (cons (car rest) seen) (cdr rest))))))

+316

317

;; ========== Table Parsing ==========

318

319

;; Check if a line looks like a table row (contains |)

@@ -427,7 +447,8 @@

447

(first-line (cadddr item-info)))

448

(let list-loop ((rest rest)

449

(current-item (list first-line))

−430

(items '()))

+450

(items '())

+451

(item-col (item-content-col item-info)))

452

(cond

453

((null? rest)

454

(loop '()

@@ -443,7 +464,8 @@

464

;; Next non-blank is list item, continue

465

(list-loop (cdr rest)

466

(cons "" current-item)

−446

items)

+467

items

+468

item-col)

469

;; End of list

470

(loop rest

471

(cons (list (if (eq? list-type 'unordered)

@@ -453,23 +475,41 @@

475

blocks))))

476

((parse-list-item (car rest))

477

=> (lambda (next-item)

−456

(if (eq? (car next-item) list-type)

−457

;; Same list type, new item

−458

(list-loop (cdr rest)

−459

(list (cadddr next-item))

−460

(cons (reverse current-item) items))

−461

;; Different list type, end this list

−462

(loop rest

−463

(cons (list (if (eq? list-type 'unordered)

−464

'unordered-list

−465

'ordered-list)

−466

(reverse (cons (reverse current-item) items)))

−467

blocks)))))

+478

(cond

+479

;; Reaches the current item's CONTENT

+480

;; column, so it belongs to that item as

+481

;; nested block content rather than to this

+482

;; list as a sibling. The raw line is kept

+483

;; and re-parsed by list-item->sxml. Before

+484

;; this branch existed, parse-list-item's

+485

;; INDENT was captured and then discarded,

+486

;; so every item at every depth became a

+487

;; sibling.

+488

((>= (caddr next-item) item-col)

+489

(list-loop (cdr rest)

+490

(cons (car rest) current-item)

+491

items

+492

item-col))

+493

;; Same list type at this level, new sibling

+494

((eq? (car next-item) list-type)

+495

(list-loop (cdr rest)

+496

(list (cadddr next-item))

+497

(cons (reverse current-item) items)

+498

(item-content-col next-item)))

+499

;; Different list type at this level, end list

+500

(else

+501

(loop rest

+502

(cons (list (if (eq? list-type 'unordered)

+503

'unordered-list

+504

'ordered-list)

+505

(reverse (cons (reverse current-item) items)))

+506

blocks))))))

507

(else

508

;; Continuation of current item

509

(list-loop (cdr rest)

510

(cons (car rest) current-item)

−472

items)))))))

+511

items

+512

item-col)))))))

513

514

;; Indented code block (4 spaces)

515

((>= (count-leading-spaces line) 4)

@@ -744,6 +784,27 @@

784

;; ========== Block to SXML Conversion ==========

785

786

;; Convert a block to SXML

+787

;; One list item. Its own text is inline-parsed as before; anything

+788

;; nested beneath it is dedented and re-parsed as BLOCKS, which is what

+789

;; makes a nested list (or a nested ordered list, or a paragraph under

+790

;; an item) come out as structure rather than as flattened siblings.

+791

(define (list-item->sxml item-lines)

+792

(let* ((split (split-item-lines item-lines))

+793

(text (car split))

+794

(nested (cdr split)))

+795

;; No dedent before re-parsing: parse-list-item skips leading spaces,

+796

;; and the block scanner tests for a list item BEFORE it tests for an

+797

;; indented code block, so a nested item is classified as a list at

+798

;; any depth. A dedent step was written, measured across the whole

+799

;; bench corpus and four hand-built cases (nested code, deep code,

+800

;; nested fence, over-indented item) and changed nothing in any of

+801

;; them, so it was removed rather than kept as unexercised code.

+802

(cons 'li

+803

(append (parse-inline (string-join text " "))

+804

(if (null? nested)

+805

'()

+806

(map block->sxml (parse-blocks nested)))))))

+807

808

(define (block->sxml block)

809

(case (car block)

810

((header)

@@ -766,17 +827,9 @@

827

(cons 'blockquote

828

(parse-inline (string-join lines " ")))))

829

((unordered-list)

−769

(let ((items (cadr block)))

−770

(cons 'ul

−771

(map (lambda (item-lines)

−772

(cons 'li (parse-inline (string-join item-lines " "))))

−773

items))))

+830

(cons 'ul (map list-item->sxml (cadr block))))

831

((ordered-list)

−775

(let ((items (cadr block)))

−776

(cons 'ol

−777

(map (lambda (item-lines)

−778

(cons 'li (parse-inline (string-join item-lines " "))))

−779

items))))

+832

(cons 'ol (map list-item->sxml (cadr block))))

833

((hr)

834

'(hr))

835

((table)

test/test-markdown.sglmodified

@@ -161,3 +161,107 @@

161

(assert-true (>= (length (sxml-content doc)) 3)))))

162

163

(run-tests)

+164

+165

;; ============================================================

+166

;; Nested lists

+167

;;

+168

;; These pin BOTH meanings of "nested" that this package's history has

+169

;; confused. Twice the word appeared in docs and in the 0.9.2 perf

+170

;; investigation meaning INLINE nesting -- emphasis inside emphasis, a

+171

;; strong run inside a list item -- which made nested LISTS look covered

+172

;; when they were never implemented at all.

+173

;;

+174

;; The flattening was inherited from the original PEG parser. 0.9.2's

+175

;; hand-written scanners were gated on byte-identical output against

+176

;; goldens generated from that parser, so they reproduced the defect

+177

;; faithfully. The goldens were not wrong about what the old parser did;

+178

;; the old parser was wrong.

+179

;; ============================================================

+180

+181

(define (li-tags doc)

+182

;; tags of the direct children of the first list in the document

+183

(map (lambda (n) (if (pair? n) (sxml-tag n) n))

+184

(sxml-content (car (sxml-content doc)))))

+185

+186

(define (nth-li doc n)

+187

(list-ref (sxml-content (car (sxml-content doc))) n))

+188

+189

(test-group "nested lists"

+190

(test "flat list stays flat"

+191

(let ((doc (markdown->sxml "- one\n- two\n- three")))

+192

(assert-equal 'ul (sxml-tag (car (sxml-content doc))))

+193

(assert-equal 3 (length (sxml-content (car (sxml-content doc)))))))

+194

+195

(test "two-level unordered nests"

+196

(let* ((doc (markdown->sxml "- top\n - inner\n- back"))

+197

(ul (car (sxml-content doc)))

+198

(items (sxml-content ul)))

+199

;; two TOP-LEVEL items, not three siblings

+200

(assert-equal 2 (length items))

+201

;; the first item carries a nested ul

+202

(assert-equal 'ul (sxml-tag (car (filter pair? (cdr (car items))))))))

+203

+204

(test "three-level unordered nests"

+205

(let* ((doc (markdown->sxml "- a\n - b\n - c\n- d"))

+206

(items (sxml-content (car (sxml-content doc)))))

+207

(assert-equal 2 (length items))))

+208

+209

(test "ordered nested under unordered keeps its type"

+210

(let* ((doc (markdown->sxml "- top\n 1. first\n 2. second"))

+211

(items (sxml-content (car (sxml-content doc))))

+212

(inner (car (filter pair? (cdr (car items))))))

+213

(assert-equal 1 (length items))

+214

(assert-equal 'ol (sxml-tag inner))))

+215

+216

;; THE CASE THAT MISLED EVERYONE: inline nesting and list nesting in one

+217

;; document. Both must work, and they are different things.

+218

(test "inline emphasis and a nested list coexist"

+219

(let* ((doc (markdown->sxml "- **bold** item\n - *inner* item"))

+220

(items (sxml-content (car (sxml-content doc))))

+221

(top (car items))

+222

(inner (car (filter pair? (cdr top)))))

+223

(assert-equal 1 (length items))

+224

;; inline nesting still works on the parent

+225

(assert-equal 'strong (sxml-tag (car (filter pair? (cdr top)))))

+226

;; ...and is not confused with the nested list

+227

(assert-equal 'ul (sxml-tag (list-ref (filter pair? (cdr top)) 1)))))

+228

;; Nesting is decided by the parent ITEM's CONTENT column, not by the

+229

;; list's marker indent. "10. " puts content at column 4, so a dash at

+230

;; column 2 is NOT inside it and must start its own list. A first cut of

+231

;; this fix compared against the list indent instead and silently

+232

;; swallowed the dash list into the ordered item -- caught only by the

+233

;; golden corpus, because every unit test here used a plain 2-space

+234

;; indent that both rules satisfy.

+235

(test "shallower item of another type is not absorbed"

+236

(let* ((doc (markdown->sxml "10. wide marker\n - dash at two"))

+237

(blocks (sxml-content doc)))

+238

(assert-equal 2 (length blocks))

+239

(assert-equal 'ol (sxml-tag (car blocks)))

+240

(assert-equal 'ul (sxml-tag (cadr blocks)))))

+241

+242

(test "item reaching the content column does nest"

+243

(let* ((doc (markdown->sxml "10. wide marker\n - dash at four"))

+244

(blocks (sxml-content doc)))

+245

(assert-equal 1 (length blocks))

+246

(assert-equal 'ol (sxml-tag (car blocks)))))

+247

+248

;; The dedent is load-bearing and was NOT covered until a sabotage run

+249

;; showed the suite staying green with it removed. Four-space nesting is

+250

;; common, and 4+ leading spaces is also the INDENTED CODE BLOCK trigger:

+251

;; without dedenting before re-parsing, " - b" becomes a (pre ...)

+252

;; instead of a nested list. Two-space nesting never exercises this,

+253

;; which is why every earlier test missed it.

+254

(test "four-space nesting is a list, not a code block"

+255

(let* ((doc (markdown->sxml "- a\n - b"))

+256

(top (car (sxml-content (car (sxml-content doc)))))

+257

(inner (car (filter pair? (cdr top)))))

+258

(assert-equal 'ul (sxml-tag inner))

+259

(assert-equal 'li (sxml-tag (car (sxml-content inner))))))

+260

+261

(test "deep four-space nesting stays a list"

+262

(let* ((doc (markdown->sxml "- a\n - b\n - c"))

+263

(top (car (sxml-content (car (sxml-content doc)))))

+264

(inner (car (filter pair? (cdr top))))

+265

(deeper (car (filter pair? (cdr (car (sxml-content inner)))))))

+266

(assert-equal 'ul (sxml-tag inner))

+267

(assert-equal 'ul (sxml-tag deeper)))))