test/test-idle-census.sgl

1;;; The 0.3.2 idle work: the census fast path, its yields, the parse cache

2;;; behind read-only tools, and task-notes answered from cached frontmatter.

3;;;

4;;; Every "outside edit" case writes a file the way a non-folio writer would

5;;; and checks the result against an independent full parse, so a fast path

6;;; that skips a real change fails here.

7;;;

8;;; Most tests set both settle windows to 0, so a file written a moment ago

9;;; can be trusted at once, and wait `granule` before each outside edit:

10;;; Linux stamps files from a coarse clock, and two writes inside one tick of

11;;; it can be indistinguishable (that is what the settle window guards; its

12;;; own tests run with it on).

13(import (sigil test)

14 (sigil async)

15 (sigil fs)

16 (sigil path)

17 (sigil sqlite)

18 (sigil string)

19 (sigil process)

20 (sigil list)

21 (sigil mcp server)

22 (sigil mcp protocol)

23 (folio store)

24 (folio note)

25 (folio links)

26 (folio project)

27 (folio task)

28 (folio query)

29 (folio index)

30 (folio filecache)

31 (folio tools))

33(census-settle-seconds 0)

34(file-cache-settle-seconds 0)

36(define (sh . args)

37 (assert-equal 0 (apply process-run args)))

39(define (granule) (sleep 0.05))

41(define (call-tool server name args)

42 (response->json

43 (mcp-server-handle-message server

44 (jsonrpc-request id: 1 method: "tools/call"

45 params: (dict name: name arguments: args)))))

47(define (note-text body) (string-append "---\ntags: []\n---\n\n" body "\n"))

49;; Two bodies of equal length: rewriting one with the other keeps the size.

50(define linked "# Source\n[[target]]")

51(define unlinked "# Source\n[[zzzzzz]]")

53(define (backlinks-match? store idx name)

54 (equal? (find-all-backlinks store name) (index-backlinks idx name)))

56(define (with-census-store thunk)

57 (call-with-temp-directory

58 (lambda (root)

59 (let* ((store (make-folio-store root))

60 (_ (store-ensure-dirs! store))

61 (notes (store-notes-dir store))

62 (source (path-join notes "source.md")))

63 (write-file-string (path-join notes "target.md") (note-text "# Target"))

64 (write-file-string source (note-text unlinked))

65 (let ((idx (make-folio-index store)))

66 (thunk root store idx source)

67 (sqlite-close (folio-index-db idx)))))))

69(define (with-settle seconds thunk)

70 (census-settle-seconds seconds)

71 (file-cache-settle-seconds seconds)

72 (guard (e (else (census-settle-seconds 0) (file-cache-settle-seconds 0) (raise e)))

73 (thunk)

74 (census-settle-seconds 0)

75 (file-cache-settle-seconds 0)))

77(test-group "census fast path"

78 (test "an unchanged corpus skips the per-file census"

79 (with-census-store

80 (lambda (root store idx source)

81 (assert-equal 'reconciled (index-census-tick! idx))

82 (assert-equal 'unchanged (index-census-tick! idx))

83 (assert-equal 'unchanged (index-census-tick! idx)))))

85 (test "a same-second, same-size outside edit is reconciled"

86 (with-census-store

87 (lambda (root store idx source)

88 (index-census-tick! idx)

89 (assert-equal 'unchanged (index-census-tick! idx))

90 (assert-equal '() (index-backlinks idx "target"))

91 (granule)

92 (write-file-string source (note-text linked))

93 (assert-equal 'reconciled (index-census-tick! idx))

94 (assert-equal '(("source" . note)) (index-backlinks idx "target"))

95 (assert-true (backlinks-match? store idx "target")))))

97 (test "an edit whose mtime is restored with touch is reconciled (ctime moves)"

98 (with-census-store

99 (lambda (root store idx source)

100 (let ((stamp (path-join root "stamp")))

101 (index-census-tick! idx)

102 (assert-equal 'unchanged (index-census-tick! idx))

103 (write-file-string stamp "")

104 (sh "touch" "-r" source stamp)

105 (granule)

106 (write-file-string source (note-text linked))

107 (sh "touch" "-r" stamp source)

108 (assert-equal 'reconciled (index-census-tick! idx))

109 (assert-equal '(("source" . note)) (index-backlinks idx "target"))))))

110

111 (test "a replacement with the same size and mtime is reconciled (rename over)"

112 (with-census-store

113 (lambda (root store idx source)

114 (let ((staged (path-join root "staged.md")))

115 (index-census-tick! idx)

116 (assert-equal 'unchanged (index-census-tick! idx))

117 (granule)

118 (write-file-string staged (note-text linked))

119 (sh "touch" "-r" source staged)

120 (sh "mv" staged source)

121 (assert-equal 'reconciled (index-census-tick! idx))

122 (assert-equal '(("source" . note)) (index-backlinks idx "target"))))))

123

124 (test "a git checkout of an equal-size revision is reconciled"

125 (with-census-store

126 (lambda (root store idx source)

127 (let ((git (lambda args

128 (apply sh "git" "-C" root "-c" "user.name=t" "-c" "user.email=t@t"

129 args))))

130 (git "init" "-q")

131 (write-file-string source (note-text linked))

132 (git "add" "-A")

133 (git "commit" "-qm" "linked")

134 (write-file-string source (note-text unlinked))

135 (git "commit" "-qam" "unlinked")

136 (index-census-tick! idx)

137 (assert-equal 'unchanged (index-census-tick! idx))

138 (assert-equal '() (index-backlinks idx "target"))

139 (granule)

140 (git "checkout" "-q" "HEAD~1" "--" "notes/source.md")

141 (assert-equal 'reconciled (index-census-tick! idx))

142 (assert-equal '(("source" . note)) (index-backlinks idx "target"))))))

143

144 (test "rows another connection deletes are restored by the census it forces"

145 (with-census-store

146 (lambda (root store idx source)

147 (write-file-string source (note-text linked))

148 (index-census-tick! idx)

149 (assert-equal 'unchanged (index-census-tick! idx))

150 (assert-equal '(("source" . note)) (index-backlinks idx "target"))

151 (let ((other (sqlite-open (path-join root ".folio-index.db"))))

152 (assert-true (sqlite-run other "DELETE FROM note_links WHERE source = ?" source))

153 (assert-true (sqlite-run other "DELETE FROM link_sources WHERE path = ?" source))

154 (sqlite-close other))

155 (assert-equal '() (index-backlinks idx "target"))

156 (assert-equal 'reconciled (index-census-tick! idx))

157 (assert-equal '(("source" . note)) (index-backlinks idx "target"))

158 (assert-equal 'unchanged (index-census-tick! idx)))))

159

160 (test "an editor's dangling lock link keeps the fast path; a note symlink disables it"

161 (with-census-store

162 (lambda (root store idx source)

163 (let ((notes (store-notes-dir store))

164 (outside (path-join root "outside.md")))

165 (sh "ln" "-s" "user@host.1234:1700000000" (path-join notes ".#source.md"))

166 (index-census-tick! idx)

167 (assert-equal 'unchanged (index-census-tick! idx))

168 (write-file-string outside (note-text unlinked))

169 (sh "ln" "-s" outside (path-join notes "linked.md"))

170 (assert-equal 'reconciled (index-census-tick! idx))

171 (assert-equal 'reconciled (index-census-tick! idx))

172 ;; The walk follows the link, so its target's edit must be seen.

173 (granule)

174 (write-file-string outside (note-text linked))

175 (assert-equal 'reconciled (index-census-tick! idx))

176 (assert-equal '(("linked" . note)) (index-backlinks idx "target"))))))

177

178 (test "a symlink whose name holds a newline cannot pass as a hidden entry"

179 (with-census-store

180 (lambda (root store idx source)

181 (let ((outside (path-join root "outside.md")))

182 (write-file-string outside (note-text unlinked))

183 (sh "ln" "-s" outside (path-join (store-notes-dir store) "x\n.y.md"))

184 (assert-equal 'reconciled (index-census-tick! idx))

185 (assert-equal 'reconciled (index-census-tick! idx))))))

186

187 (test "a failure deferred until the file changes still arms the fast path"

188 (with-census-store

189 (lambda (root store idx source)

190 (index-census-tick! idx)

191 (granule)

192 (write-file-string source (note-text linked))

193 (sh "chmod" "000" source)

194 (assert-equal 'reconciled (index-census-tick! idx))

195 (assert-equal 'unchanged (index-census-tick! idx))

196 (granule)

197 (sh "chmod" "600" source)

198 (assert-equal 'reconciled (index-census-tick! idx))

199 (assert-equal '(("source" . note)) (index-backlinks idx "target"))

200 (assert-equal 'unchanged (index-census-tick! idx)))))

201

202 (test "a retryable failure (database busy) keeps every tick on the full census"

203 (with-census-store

204 (lambda (root store idx source)

205 (index-census-tick! idx)

206 (assert-equal 'unchanged (index-census-tick! idx))

207 (let ((budget (sqlite-busy-budget))

208 (other (sqlite-open (path-join root ".folio-index.db"))))

209 (sqlite-set-busy-budget! 0.2)

210 (granule)

211 (write-file-string source (note-text linked))

212 (assert-true (sqlite-exec other "BEGIN IMMEDIATE"))

213 (assert-equal 'reconciled (index-census-tick! idx))

214 (assert-equal '() (index-backlinks idx "target"))

215 (assert-equal 'reconciled (index-census-tick! idx))

216 (assert-true (sqlite-exec other "ROLLBACK"))

217 (sqlite-close other)

218 (sqlite-set-busy-budget! budget)

219 (assert-equal 'reconciled (index-census-tick! idx))

220 (assert-equal '(("source" . note)) (index-backlinks idx "target"))

221 (assert-equal 'unchanged (index-census-tick! idx))))))

222

223 ;; `sqlite-query` answers '() when the statement cannot run; the census must

224 ;; not take that for "no rows" and arm on it.

225 (test "a read query that fails keeps every tick on the full census"

226 (with-census-store

227 (lambda (root store idx source)

228 (index-census-tick! idx)

229 (assert-equal 'unchanged (index-census-tick! idx))

230 (let ((other (sqlite-open (path-join root ".folio-index.db"))))

231 (assert-true (sqlite-exec other "ALTER TABLE notes_meta RENAME TO notes_meta_away"))

232 (assert-equal 'reconciled (index-census-tick! idx))

233 (assert-equal 'reconciled (index-census-tick! idx))

234 (assert-true (sqlite-exec other "ALTER TABLE notes_meta_away RENAME TO notes_meta"))

235 (sqlite-close other))

236 (assert-equal 'reconciled (index-census-tick! idx))

237 (assert-equal 'unchanged (index-census-tick! idx)))))

238

239 ;; The projects/ walk reads dotfiles, so a hidden link there is followed and

240 ;; its target's edits are invisible to the listing.

241 (test "any symlink in projects/, hidden or not, disables the fast path"

242 (with-census-store

243 (lambda (root store idx source)

244 (let ((outside (path-join root "plan.md")))

245 (write-file-string outside "# Plan\n")

246 (sh "ln" "-s" outside (path-join (store-project-dir store) ".plan.md"))

247 (assert-equal 'reconciled (index-census-tick! idx))

248 (assert-equal 'reconciled (index-census-tick! idx))))))

249

250 (test "an unsettled listing is not trusted until its newest time is old enough"

251 (with-settle 1

252 (lambda ()

253 (with-census-store

254 (lambda (root store idx source)

255 (assert-equal 'reconciled (index-census-tick! idx))

256 (assert-equal 'reconciled (index-census-tick! idx))

257 (sleep 1.2)

258 (assert-equal 'reconciled (index-census-tick! idx))

259 (assert-equal 'unchanged (index-census-tick! idx)))))))

260

261 (test "a full census with no per-file work still yields to other tasks"

262 (call-with-temp-directory

263 (lambda (root)

264 (let* ((store (make-folio-store root))

265 (_ (store-ensure-dirs! store))

266 (idx (make-folio-index store))

267 (done #f)

268 (turns 0))

269 (let loop ((i 0))

270 (when (< i 200)

271 (write-file-string (path-join (store-notes-dir store) (format "n~a.md" i))

272 (note-text (format "# N~a\n[[n0]]" i)))

273 (loop (+ i 1))))

274 (index-census-tick! idx)

275 (let ((second (index-census-tick! idx)))

276 (display (format "yield test: second tick=~a\n" second))

277 (assert-equal 'unchanged second))

278 ;; Another connection commits: the next tick runs the full census,

279 ;; but every file is current, so the pacer's yields are the only ones.

280 (let ((other (sqlite-open (path-join root ".folio-index.db"))))

281 (assert-true (sqlite-run other "UPDATE notes_meta SET indexed_at = indexed_at + 1"))

282 (sqlite-close other))

283 (with-async

284 (go (set! done (index-census-tick! idx)))

285 (go (let loop ()

286 (unless done

287 (set! turns (+ turns 1))

288 (yield)

289 (loop)))))

290 (display (format "yield test: tick=~a turns=~a\n" done turns))

291 (assert-equal 'reconciled done)

292 ;; 200 files with a yield every 32: at least 6 turns for the other task.

293 (assert-true (>= turns 6))

294 (assert-true (backlinks-match? store idx "n0"))

295 (sqlite-close (folio-index-db idx)))))))

296

297(test-group "parse cache"

298 (test "an unchanged file is computed once and the value reused"

299 (call-with-temp-directory

300 (lambda (root)

301 (let ((cache (make-file-cache))

302 (path (path-join root "f.md"))

303 (calls 0))

304 (write-file-string path "one")

305 (let* ((compute (lambda (p) (set! calls (+ calls 1)) (read-file-string p)))

306 (a (file-cache-ref cache path compute))

307 (b (file-cache-ref cache path compute)))

308 (assert-equal "one" a)

309 (assert-true (eq? a b))

310 (assert-equal 1 calls)

311 (assert-equal 1 (file-cache-size cache)))))))

312

313 (test "same-second same-size write, restored mtime, rename-over and git checkout all recompute"

314 (call-with-temp-directory

315 (lambda (root)

316 (let* ((cache (make-file-cache))

317 (path (path-join root "f.md"))

318 (stamp (path-join root "stamp"))

319 (staged (path-join root "staged"))

320 (read (lambda () (file-cache-ref cache path read-file-string)))

321 (git (lambda args

322 (apply sh "git" "-C" root "-c" "user.name=t" "-c" "user.email=t@t"

323 args))))

324 (write-file-string path "aaaa")

325 (assert-equal "aaaa" (read))

326 ;; Same second, same size, in place.

327 (granule)

328 (write-file-string path "bbbb")

329 (assert-equal "bbbb" (read))

330 ;; Same size, mtime put back: ctime still moves.

331 (write-file-string stamp "")

332 (sh "touch" "-r" path stamp)

333 (granule)

334 (write-file-string path "cccc")

335 (sh "touch" "-r" stamp path)

336 (assert-equal "cccc" (read))

337 ;; Replaced by a file with the same size and mtime: a new inode.

338 (granule)

339 (write-file-string staged "dddd")

340 (sh "touch" "-r" path staged)

341 (sh "mv" staged path)

342 (assert-equal "dddd" (read))

343 ;; git checkout of an equal-size revision.

344 (git "init" "-q")

345 (git "add" "f.md")

346 (git "commit" "-qm" "d")

347 (granule)

348 (write-file-string path "eeee")

349 (assert-equal "eeee" (read))

350 (granule)

351 (git "checkout" "-q" "--" "f.md")

352 (assert-equal "dddd" (read))))))

353

354 (test "a recently written file is not cached until it settles"

355 (with-settle 1

356 (lambda ()

357 (call-with-temp-directory

358 (lambda (root)

359 (let* ((cache (make-file-cache))

360 (path (path-join root "f.md"))

361 (calls 0)

362 (read (lambda () (file-cache-ref cache path

363 (lambda (p) (set! calls (+ calls 1)) (read-file-string p))))))

364 (write-file-string path "fresh")

365 (read) (read)

366 (assert-equal 2 calls)

367 (assert-equal 0 (file-cache-size cache))

368 (sleep 1.2)

369 (read) (read)

370 (assert-equal 3 calls)

371 (assert-equal 1 (file-cache-size cache))))))))

372

373 (test "a compute that rewrites the file or raises caches nothing; prune drops vanished paths"

374 (call-with-temp-directory

375 (lambda (root)

376 (let ((cache (make-file-cache))

377 (path (path-join root "f.md"))

378 (other (path-join root "g.md")))

379 (write-file-string path "1111")

380 (granule)

381 (assert-equal "1111"

382 (file-cache-ref cache path

383 (lambda (p) (let ((v (read-file-string p))) (write-file-string p "2222") v))))

384 (assert-equal 0 (file-cache-size cache))

385 (assert-equal "2222" (file-cache-ref cache path read-file-string))

386 (assert-true (guard (e (else #t))

387 (file-cache-ref cache other (lambda (p) (error "boom")))

388 #f))

389 (write-file-string other "g")

390 (assert-equal "g" (file-cache-ref cache other read-file-string))

391 (assert-equal 2 (file-cache-size cache))

392 (file-cache-prune! cache root (list path))

393 (assert-equal 1 (file-cache-size cache))))))

394

395 (test "tasks, projects and status follow equal-size outside edits of a project file"

396 (call-with-temp-directory

397 (lambda (root)

398 (let* ((store (make-folio-store root))

399 (_ (store-ensure-dirs! store))

400 (project (path-join (store-project-dir store) "p.md"))

401 (body (lambda (word status)

402 (format "---\nstatus: ~a\n---\n\n# P\n\n## Tasks\n\n- [ ] ~a {id: t-1111}\n"

403 status word)))

404 (texts (lambda () (map folio-task-text (all-tasks store)))))

405 (write-file-string project (body "alpha" "active"))

406 (assert-equal '("alpha") (texts))

407 (granule)

408 (write-file-string project (body "bravo" "active"))

409 (assert-equal '("bravo") (texts))

410 (assert-equal '("active") (map project-status (all-projects store)))

411 (granule)

412 (write-file-string project (body "bravo" "paused"))

413 (assert-equal '("paused") (map project-status (all-projects store)))

414 (assert-equal 0 (dict-ref (folio-status store) active-project-count:)))))))

415

416;; The reply task-notes gave before 0.3.2: a full parse of every note.

417(define (reference-task-notes store task-id)

418 (let ((notes (filter (lambda (n) (member task-id (note-tasks n))) (all-notes store))))

419 (if (null? notes)

420 (format "No notes linked to task ~a." task-id)

421 (string-append

422 (format "Notes linked to ~a (~a):\n\n" task-id (length notes))

423 (string-join

424 (map (lambda (n)

425 (let ((tags (note-tags n)))

426 (string-append (format " ~a" (folio-note-name n))

427 (if (null? tags) ""

428 (format " [~a]" (string-join tags ", "))))))

429 notes)

430 "\n")))))

431

432(define (assert-task-notes-parity store ids)

433 (for-each

434 (lambda (id) (assert-equal (reference-task-notes store id) (task-notes-text store id)))

435 ids))

436

437(test-group "task-notes from cached frontmatter"

438 (test "matches a full parse across create, outside edits, rename, task move and delete"

439 (call-with-temp-directory

440 (lambda (root)

441 (let* ((store (make-folio-store root))

442 (_ (store-ensure-dirs! store))

443 (idx (make-folio-index store))

444 (server (mcp-server name: "task-notes-test"))

445 (ids '("t-aaaa" "t-bbbb" "t-cccc" "t-none" "42"))

446 (notes-dir (store-notes-dir store))

447 (project (path-join (store-project-dir store) "p.md")))

448 (register-folio-tools! server store idx)

449 (write-file-string project

450 "---\nstatus: active\n---\n\n# P\n\n## Tasks\n\n- [ ] A {id: t-aaaa}\n- [ ] B {id: t-bbbb}\n")

451 (write-file-string (path-join (store-project-dir store) "q.md")

452 "---\nstatus: active\n---\n\n# Q\n\n## Tasks\n\n")

453 (note-create! store "brief-a" '("brief") "About A." '("t-aaaa"))

454 (note-create! store "nested/both" '("brief" "x") "Both." '("t-aaaa" "t-bbbb"))

455 (note-create! store "plain" '() "No tasks.")

456 ;; Malformed tasks: values, handled the same way by both answers.

457 (write-file-string (path-join notes-dir "scalar.md") "---\ntasks: t-aaaa\n---\n\nScalar.\n")

458 (write-file-string (path-join notes-dir "number.md") "---\ntasks: 42\n---\n\nNumber.\n")

459 (write-file-string (path-join notes-dir "nested.md")

460 "---\ntasks:\n - [t-bbbb]\n - t-cccc\n---\n\nNested.\n")

461 (write-file-string (path-join notes-dir "empty.md") "---\ntasks:\n---\n\nEmpty.\n")

462 (write-file-string (path-join notes-dir "odd-tags.md")

463 "---\ntags: [7, x]\ntasks: [t-aaaa]\n---\n\nOdd tags.\n")

464 (assert-task-notes-parity store ids)

465 ;; Outside edit: same-size swap of a task id in the frontmatter.

466 (let ((path (path-join notes-dir "brief-a.md")))

467 (granule)

468 (write-file-string path "---\ntags: [brief]\ntasks: [t-cccc]\n---\n\nAbout A.\n")

469 (assert-task-notes-parity store ids)

470 (granule)

471 (write-file-string path "---\ntags: [brief]\ntasks: [t-bbbb]\n---\n\nAbout A.\n")

472 (assert-task-notes-parity store ids))

473 ;; Rename through the tool, and an outside rename.

474 (assert-true (string-contains?

475 (call-tool server "folio/note-rename"

476 (dict name: "nested/both" new-name: "renamed/both"))

477 "Renamed"))

478 (assert-task-notes-parity store ids)

479 (sh "mv" (path-join notes-dir "plain.md") (path-join notes-dir "plain2.md"))

480 (assert-task-notes-parity store ids)

481 ;; Moving a task between projects keeps its id and its notes.

482 (assert-true (string-contains?

483 (call-tool server "folio/task-move" (dict id: "t-aaaa" project: "q"))

484 "Moved task"))

485 (assert-task-notes-parity store ids)

486 (assert-true (string-contains? (task-notes-text store "t-aaaa") "renamed/both"))

487 ;; Deleting a note drops it.

488 (delete-file (path-join notes-dir "brief-a.md"))

489 (assert-task-notes-parity store ids)

490 (sqlite-close (folio-index-db idx))))))

491

492 (test "the same file is named by the store that reads it"

493 (call-with-temp-directory

494 (lambda (root)

495 (let* ((outer (make-folio-store root))

496 (_ (store-ensure-dirs! outer))

497 (inner-root (path-join (store-notes-dir outer) "inner"))

498 (_ (ensure-directory inner-root))

499 (inner (make-folio-store inner-root)))

500 (store-ensure-dirs! inner)

501 (write-file-string (path-join (store-notes-dir inner) "n.md")

502 "---\ntasks: [t-dddd]\n---\n\nInner.\n")

503 (assert-true (string-contains? (task-notes-text outer "t-dddd") " inner/notes/n"))

504 (assert-true (string-contains? (task-notes-text inner "t-dddd") " n"))

505 (assert-false (string-contains? (task-notes-text inner "t-dddd") "inner/notes/n")))))))