test/test-migrate-buried.sgl

1;;; folio/migrate-buried -- explicit recovery of buried items.

2;;;

3;;; Fixtures are built from the REAL estate shapes found in the 2026-08-06

4;;; census (22 buried ids): the t-a979a6 post-phantom-move tail (shape B),

5;;; the inbox-add! headless-head shape (shape A), the papercuts fence shape,

6;;; the phantom-pair shape that produced t-6c4269/t-a979a6, and the

7;;; guix-essentials tool-fragment shape. Refusal is always preferred over a

8;;; guess; a conversion deletes nothing and is verified with the INDEPENDENT

9;;; scanner before it is accepted.

11(import (sigil test)

12 (sigil struct)

13 (sigil string)

14 (sigil list)

15 (sigil dict)

16 (sigil fs)

17 (folio store)

18 (folio task)

19 (folio inbox)

20 (folio integrity)

21 (folio migrate)

22 (folio tools))

24(define (write-inbox! store content)

25 (write-file-string (store-inbox-path store) content))

27(define (inbox-content store)

28 (read-file-string (store-inbox-path store)))

30;; The t-a979a6 tail as it sat in the live inbox: comment block above,

31;; multi-paragraph prose block with the id on its last line, NO head.

32(define a979a6-tail

33 (string-join

34 (list "# Inbox"

35 ""

36 "<!--"

37 "Emptied 2026-08-02."

38 "-->"

39 ""

40 "TWO OBLIGATIONS ON WHOEVER CLOSES THIS, both in jobs/enclave.run:"

41 ""

42 "(1) RE-MEASURE AND TIGHTEN THE JOB TIMEOUT. The margin covers a"

43 "step that has never completed."

44 ""

45 "(2) REMOVE THE XFAIL EXEMPTION. It will XPASS loudly."

46 ""

47 "See tasks/kiln-enclave-job for the family. {id: t-a979a6, tags: enclave ci, priority: medium}")

48 "\n"))

50(test-group "shape B: the headless tail (t-a979a6)"

52 (test "dry run proposes the conversion and writes NOTHING"

53 (call-with-temp-directory

54 (lambda (dir)

55 (let ((store (make-folio-store dir)))

56 (write-inbox! store a979a6-tail)

57 (let ((out ((make-tool-migrate-buried store) (dict))))

58 (assert-true (string-contains? out "DRY RUN"))

59 (assert-true (string-contains? out "convert t-a979a6"))

60 (assert-true (string-contains? out "@@")) ;; a unified diff

61 (assert-equal a979a6-tail (inbox-content store)))))))

63 (test "apply surfaces the id; content, comment and counts all verified"

64 (call-with-temp-directory

65 (lambda (dir)

66 (let ((store (make-folio-store dir)))

67 (write-inbox! store a979a6-tail)

68 (let ((out ((make-tool-migrate-buried store) (dict apply: #t))))

69 (assert-true (string-contains? out "Applied"))

70 (let ((tasks (read-inbox store))

71 (content (inbox-content store)))

72 (assert-equal 1 (length tasks))

73 (assert-equal "t-a979a6" (folio-task-id (car tasks)))

74 ;; the whole prose block became the task's text

75 (assert-true (string-contains? (folio-task-text (car tasks))

76 "TWO OBLIGATIONS"))

77 (assert-true (string-contains? (folio-task-text (car tasks))

78 "XFAIL EXEMPTION"))

79 (assert-true (string-contains? (folio-task-text (car tasks))

80 "See tasks/kiln-enclave-job for the family."))

81 ;; the comment block is untouched

82 (assert-true (string-contains? content "Emptied 2026-08-02."))

83 ;; nothing deleted: same line count as before

84 (assert-equal (length (string-split a979a6-tail "\n"))

85 (length (string-split content "\n")))

86 ;; and the listing is clean afterwards

87 (assert-false (string-contains?

88 ((make-tool-inbox store) (dict))

89 "INTEGRITY")))))))))

91(test-group "shape A: headless checkbox head above the body"

93 (test "metadata moves to the head; body is indented under it"

94 (call-with-temp-directory

95 (lambda (dir)

96 (let ((store (make-folio-store dir)))

97 (write-inbox! store

98 (string-join

99 (list "# Inbox"

100 "- [ ] tighten sigil test discovery"

101 ""

102 "Current behavior: it walks into deps."

103 ""

104 "Cross-link the observation. {id: t-5506, tags: sigil, priority: medium}")

105 "\n"))

106 ((make-tool-migrate-buried store) (dict apply: #t))

107 (let ((tasks (read-inbox store)))

108 (assert-equal 1 (length tasks))

109 (assert-equal "t-5506" (folio-task-id (car tasks)))

110 (assert-equal

111 (string-join

112 (list "tighten sigil test discovery"

113 ""

114 "Current behavior: it walks into deps."

115 ""

116 "Cross-link the observation.")

117 "\n")

118 (folio-task-text (car tasks)))

119 (assert-equal "medium"

120 (cdr (assoc 'priority

121 (folio-task-metadata (car tasks)))))))))))

122

123(test-group "the papercuts fence shape"

124

125 ;; t-da90: an unowned fence block between a REAL task above and the

126 ;; buried item's metadata line. The real task must be untouched; the

127 ;; fence content is claimable because it belongs to no visible task.

128 (test "recovers around a fence without touching the real task above"

129 (call-with-temp-directory

130 (lambda (dir)

131 (let ((store (make-folio-store dir)))

132 (write-inbox! store

133 (string-join

134 (list "# Inbox"

135 "- [ ] REGISTRY CEILING makes slate unbuildable {id: t-0e70b6, priority: high}"

136 "```"

137 " COMPILE sigil/package.sgl"

138 "```"

139 "for each module: show a single NATIVE line. {id: t-da90, tags: sigil build}")

140 "\n"))

141 ((make-tool-migrate-buried store) (dict apply: #t))

142 (let ((tasks (read-inbox store))

143 (content (inbox-content store)))

144 (assert-equal 2 (length tasks))

145 ;; the real task's line is byte-identical

146 (assert-true (string-contains? content

147 "- [ ] REGISTRY CEILING makes slate unbuildable {id: t-0e70b6, priority: high}"))

148 ;; t-da90 is visible and owns its fence content

149 (let ((recovered (cadr tasks)))

150 (assert-equal "t-da90" (folio-task-id recovered))

151 (assert-true (string-contains? (folio-task-text recovered)

152 "COMPILE sigil/package.sgl"))

153 (assert-true (string-contains? (folio-task-text recovered)

154 "for each module")))))))))

155

156(test-group "refusals: never guess"

157

158 ;; The exact t-6c4269 / t-a979a6 pair: a phantom head minted by

159 ;; ensure-task-id (bare {id: ...}, no other metadata) above the tail

160 ;; carrying the real id. Recovery is a MERGE of two tasks -- a human's

161 ;; call, never migration's.

162 (test "a bare-id phantom head above the tail is refused"

163 (call-with-temp-directory

164 (lambda (dir)

165 (let ((store (make-folio-store dir)))

166 (let ((content

167 (string-join

168 (list "# Inbox"

169 "- [ ] TWO OBLIGATIONS ON WHOEVER CLOSES THIS: {id: t-6c4269}"

170 ""

171 "(1) RE-MEASURE THE TIMEOUT."

172 ""

173 "See the family. {id: t-a979a6, tags: enclave}")

174 "\n")))

175 (write-inbox! store content)

176 (let ((out ((make-tool-migrate-buried store) (dict apply: #t))))

177 (assert-true (string-contains? out "refuse t-a979a6"))

178 (assert-true (string-contains? out "phantom"))

179 ;; refused means UNTOUCHED, even under apply: true

180 (assert-equal content (inbox-content store))))))))

181

182 ;; The guix-essentials tool-fragment shape: the metadata does not close on

183 ;; its own line. Reconstructing it would be inventing content.

184 (test "a tool-fragment shape is refused, not reconstructed"

185 (call-with-temp-directory

186 (lambda (dir)

187 (let ((store (make-folio-store dir)))

188 (let ((content

189 (string-join

190 (list "# Inbox"

191 "- [ ] deploy.sh hardcodes the server"

192 "<priority>medium</priority>"

193 "<tags>infra deploy-script</tags>"

194 " {id: t-336b, tags: infra deploy-script</tags>"

195 "</invoke>, priority: medium}")

196 "\n")))

197 (write-inbox! store content)

198 (let ((out ((make-tool-migrate-buried store) (dict apply: #t))))

199 (assert-true (string-contains? out "refuse t-336b"))

200 (assert-equal content (inbox-content store))))))))

201

202 (test "a clean store reports nothing to migrate"

203 (call-with-temp-directory

204 (lambda (dir)

205 (let ((store (make-folio-store dir)))

206 (inbox-add! store "an ordinary item" '((id . "t-ok01")))

207 (let ((out ((make-tool-migrate-buried store) (dict))))

208 (assert-true (string-contains? out "No buried task ids"))))))))