tools/check-task-notes-parity.sgl

1;;; Differential check of folio/task-notes on a DISPOSABLE copy of a real corpus.

2;;;

3;;; The reference is the pre-0.3.2 algorithm: parse every note, keep those whose

4;;; frontmatter `tasks:` holds the id. Every id any note mentions, a sample of

5;;; project task ids and some ids nobody uses are compared after each of: no

6;;; change, an outside frontmatter edit, an outside note move, a note-rename

7;;; through the tool, a task-move through the tool, and a deletion.

8(import (sigil fs)

9 (only (sigil async) sleep)

10 (sigil list)

11 (sigil path)

12 (sigil string)

13 (sigil time)

14 (sigil sqlite)

15 (sigil mcp server)

16 (sigil mcp protocol)

17 (folio store)

18 (folio note)

19 (folio task)

20 (folio query)

21 (folio index)

22 (folio filecache)

23 (folio tools))

25;; With the settle window on, a file changed by a round is never a cache hit

26;; in that round, so a wrong hit could not show. Run with it off, and wait one

27;; timestamp granule before each mutation so the signatures can differ.

28(file-cache-settle-seconds 0)

29(define (granule) (sleep 0.05))

31(define root (getenv "FOLIO_CORPUS"))

32(unless root (error "FOLIO_CORPUS must name a disposable corpus copy"))

33(when (string-contains? root "/Ops/folio") (error "refusing to run against a live store"))

34(define store (make-folio-store root))

35(define idx (make-folio-index store))

36(define server (mcp-server name: "task-notes-parity"))

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

39(define (wall-ms) (* 1000.0 (/ (current-jiffy) (jiffies-per-second))))

40(define (tool name args)

41 (response->json

42 (mcp-server-handle-message server

43 (jsonrpc-request id: 1 method: "tools/call" params: (dict name: name arguments: args)))))

45(define (reference-text notes task-id)

46 (let ((hits (filter (lambda (n) (member task-id (note-tasks n))) notes)))

47 (if (null? hits)

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

49 (string-append

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

51 (string-join

52 (map (lambda (n)

53 (let ((tags (note-tags n)))

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

55 (if (null? tags) ""

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

57 hits)

58 "\n")))))

60(define (unique strings)

61 (let loop ((rest strings) (seen (dict)) (out '()))

62 (cond ((null? rest) (reverse out))

63 ((dict-contains? seen (car rest)) (loop (cdr rest) seen out))

64 (else (loop (cdr rest) (dict-set seen (car rest) #t) (cons (car rest) out))))))

66(define (take-up-to lst n)

67 (if (or (null? lst) (= n 0)) '() (cons (car lst) (take-up-to (cdr lst) (- n 1)))))

69(define (ids-now notes)

70 (unique

71 (append (apply append (map note-tasks notes))

72 (take-up-to (filter (lambda (x) x) (map folio-task-id (all-tasks store))) 60)

73 '("t-0000" "t-ffffff" "nonexistent" ""))))

75(define (round! label)

76 (let* ((t0 (wall-ms))

77 (notes (all-notes store))

78 (ref-ms (- (wall-ms) t0))

79 (ids (ids-now notes))

80 (linked 0))

81 (for-each

82 (lambda (id)

83 (let ((expected (reference-text notes id))

84 (actual (task-notes-text store id)))

85 (unless (equal? expected actual)

86 (error "task-notes differs from the full parse" label id expected actual))

87 (unless (string-starts-with? actual "No notes") (set! linked (+ linked 1)))))

88 ids)

89 (let* ((t1 (wall-ms))

90 (_ (task-notes-text store (car ids)))

91 (one-ms (- (wall-ms) t1)))

92 (display (format "PARITY ~a ids=~a linked_ids=~a reference_parse_ms=~a cached_call_ms=~a\n"

93 label (length ids) linked (round ref-ms) (round one-ms))))

94 ids))

96;; First call from cold (fills the cache) against the old cost.

97(let* ((t0 (wall-ms)) (_ (task-notes-text store "t-0000")))

98 (display (format "COLD first_call_ms=~a\n" (round (- (wall-ms) t0)))))

100(round! "initial")

101

102;; A note that links tasks, for the mutations.

103(define linking

104 (let ((notes (filter (lambda (n) (and (pair? (note-tasks n))

105 (string-starts-with? (car (note-tasks n)) "t-")))

106 (all-notes store))))

107 (when (null? notes) (error "corpus has no task-linked notes"))

108 (car notes)))

109(define linking-name (folio-note-name linking))

110(define linking-task (car (note-tasks linking)))

111(display (format "MUTATE note=~a task=~a\n" linking-name linking-task))

112

113;; Outside edit: add a task id to a different, unlinked note's frontmatter.

114(define plain

115 (car (filter (lambda (n) (null? (note-tasks n))) (all-notes store))))

116(granule)

117(write-file-string (folio-note-file-path plain)

118 (string-append "---\ntasks:\n - " linking-task "\n---\n\n" (folio-note-body plain)))

119(round! "outside-edit")

120

121;; Outside move of the linking note into a new directory.

122(define moved-path (path-join (store-notes-dir store) "parity-moved" "moved-note.md"))

123(ensure-directory (path-join (store-notes-dir store) "parity-moved"))

124(granule)

125(rename-file (folio-note-file-path linking) moved-path)

126(round! "outside-move")

127

128;; Rename through the tool.

129(granule)

130(let ((reply (tool "folio/note-rename" (dict name: "parity-moved/moved-note"

131 new-name: "parity-moved/renamed-note"))))

132 (unless (string-contains? reply "Renamed") (error "note-rename failed" reply)))

133(round! "tool-rename")

134

135;; Move a linked task to another project through the tool (when it is a project task).

136(granule)

137(let* ((task (find (lambda (t) (equal? (folio-task-id t) linking-task)) (all-tasks store)))

138 (projects (store-project-files store))

139 (target (and task

140 (find (lambda (p) (not (equal? p (folio-task-source-file task)))) projects))))

141 (if (and task target)

142 (let ((reply (tool "folio/task-move"

143 (dict id: linking-task project: (path-stem (path-basename target))))))

144 (unless (string-contains? reply "Moved task") (error "task-move failed" reply))

145 (display (format "MOVED ~a to ~a\n" linking-task (path-basename target))))

146 (display (format "MOVED skipped: ~a is not a project task here\n" linking-task))))

147(round! "tool-task-move")

148

149;; Deletion.

150(granule)

151(delete-file (path-join (store-notes-dir store) "parity-moved" "renamed-note.md"))

152(round! "delete")

153

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

155(display "TASK-NOTES PARITY PASSED\n")