test/f1a-publication-probe.sgl

1;;; F1a publication fallback -- HTML and Typst, proved outside `sigil test`.

2;;;

3;;; WHY THIS FILE EXISTS AND WHY IT DOES NOT USE `(sigil test)`.

4;;;

5;;; The HTML renderer transitively needs `(sigil shell)`

6;;; (`render/html` -> `presentation` -> `verify` -> `(sigil shell)`), which does

7;;; not resolve inside this package's native test harness, so these two

8;;; renderings cannot be asserted from the model suite. They are asserted here

9;;; instead, as a direct script.

10;;;

11;;; AND `(sigil test)` MUST NOT BE USED IN A DIRECT SCRIPT. Measured, because

12;;; it is invisible: a direct `sigil <file>` run REGISTERS `test` forms and never

13;;; executes them. A file containing `(test "x" (assert-equal 1 2))` printed

14;;; nothing and exited 0. Written that way, this probe would have been green

15;;; forever while asserting nothing whatsoever -- the exact "marker proved the

16;;; arm RAN, not that it CHECKED" shape. So the harness below is hand-rolled,

17;;; and the gate proves it can fail on every single run via the self-test mode

18;;; at the bottom.

19(import (sigil core) (sigil fs) (sigil syntax) (folio doc)

20 (sigil doc publication) (sigil doc render html)

21 (sigil doc print) (sigil doc render typst))

23(load "test/fixtures/folio-pressure.sgl")

25;; ---------------------------------------------------------------------------

26;; A harness whose failure path is exercised every run

27;; ---------------------------------------------------------------------------

28(define checks-run 0)

29(define checks-failed 0)

30(define (check label ok?)

31 (set! checks-run (+ checks-run 1))

32 (if (not ok?)

33 (begin (set! checks-failed (+ checks-failed 1))

34 (display (string-append " FAIL: " label)) (newline))))

36(define (string-has? haystack needle)

37 (let ((h (string-length haystack)) (n (string-length needle)))

38 (let loop ((i 0))

39 (cond ((> (+ i n) h) #f)

40 ((string=? needle (substring haystack i (+ i n))) #t)

41 (else (loop (+ i 1)))))))

43;; ---------------------------------------------------------------------------

44;; Lower once, render three ways

45;; ---------------------------------------------------------------------------

46(define lowered (folio-document->publication pressure-project #f))

47(define plain-text (document->plain lowered))

48(define index (build-publication-index (list (make-publication-document "pressure" lowered))))

49(define html

50 (document->html-fragment lowered

51 (make-html-render-context index "pressure"

52 (lambda (target) (string-append "#" (publication-target-id target))) '() 2)))

53(define typst

54 (print-publication->typst

55 (make-print-publication "Pressure manuscript" #f '()

56 (list (make-publication-document "pressure" lowered)) '())))

58(define renderings (list (list "plain" plain-text) (list "html" html) (list "typst" typst)))

60(define (for-each-rendering proc)

61 (for-each (lambda (entry) (proc (car entry) (cadr entry))) renderings))

63;; Every rendering must be substantial. A renderer that returned "" would

64;; otherwise satisfy nothing below by having nothing in it -- the comparison

65;; that degenerates to comparing two nothings.

66(for-each-rendering

67 (lambda (name rendered)

68 (check (string-append name " rendering is non-trivial")

69 (> (string-length rendered) 800))))

71;; THE REQUIREMENT: a folio document must still say what it means when rendered

72;; by a backend that has never heard of a task.

73;; The status set is ENUMERATED FROM THE MODEL, not from the ones the

74;; manuscript happens to use, so a frozen value that is never rendered fails

75;; here rather than going unnoticed.

76(define every-status

77 (append (folio-task-statuses) (folio-container-statuses)

78 (folio-decision-statuses) (folio-question-statuses)))

79(for-each-rendering

80 (lambda (name rendered)

81 (for-each

82 (lambda (sym)

83 (let ((word (string-append "[" (symbol->string sym) "]")))

84 (check (string-append name " keeps status " word) (string-has? rendered word))))

85 every-status)))

87;; POSITIONAL, not merely present. Review's point: checking that each status

88;; word appears SOMEWHERE passes for a lowering that attached every status to

89;; the wrong item, or that emitted one footer listing all of them. These pin the

90;; status ADJACENT TO THE ID it belongs to, which no such lowering survives.

91(for-each

92 (lambda (pair)

93 (let ((phrase (string-append (car pair) " " (cadr pair))))

94 (for-each-rendering

95 (lambda (name rendered)

96 (check (string-append name " binds " phrase) (string-has? rendered phrase))))))

97 (list (list "Task t-f1a01" "[active]")

98 (list "Task t-f0a1" "[done]")

99 (list "Task t-f1a03" "[blocked]")

100 (list "Task t-f1a04" "[inbox]")

101 (list "Task t-f1a05" "[cancelled]")

102 (list "Decision d-two-grammars" "[accepted]")

103 (list "Decision d-flat-ids" "[superseded]")

104 (list "Decision d-compact-address" "[rejected]")

105 (list "Decision d-reopen-policy" "[proposed]")

106 (list "Question q-reopen" "[open]")

107 (list "Question q-subject-index" "[deferred]")

108 (list "Phase p-publication" "[paused]")

109 (list "Milestone m-first-edition" "[active]")))

110

111;; NEGATIVE CONTROL for the two blocks above: a status that belongs to no

112;; frozen set, and a correct status bound to the WRONG id, must both be absent.

113;; Without these, "the word is in the document" is all that was ever shown.

114(for-each-rendering

115 (lambda (name rendered)

116 (check (string-append name " has no unfrozen status") (not (string-has? rendered "[next]")))

117 (check (string-append name " does not bind t-f1a01 to done")

118 (not (string-has? rendered "Task t-f1a01 [done]")))))

119

120;; Identity survives, so a reader of the PDF can find the item in the source.

121(for-each-rendering

122 (lambda (name rendered)

123 (for-each

124 (lambda (id) (check (string-append name " keeps id " id) (string-has? rendered id)))

125 ;; `u-f0review` is the update id. It was absent from every rendering

126 ;; before review while the module claimed every semantic fact survives.

127 (list "t-f1a01" "t-f0a1" "d-two-grammars" "q-reopen" "m-first-edition"

128 "p-freeze-model" "u-f0review"))))

129

130;; NEGATIVE CONTROL for the id block above.

131(for-each-rendering

132 (lambda (name rendered)

133 (check (string-append name " invents no undeclared id")

134 (not (string-has? rendered "u-not-declared")))))

135

136;; Phase ordering is a semantic fact and must not become invisible.

137(for-each-rendering

138 (lambda (name rendered)

139 (check (string-append name " keeps phase order") (string-has? rendered "order 3"))))

140

141;; The two derived nodes render an explicit, named marker rather than nothing.

142(for-each-rendering

143 (lambda (name rendered)

144 (check (string-append name " marks the unresolved query")

145 (and (string-has? rendered unresolved-marker-prefix)

146 (string-has? rendered "q-ready-work")))

147 (check (string-append name " names the unresolved transclusion target")

148 (and (string-has? rendered "topics/instrument-failure-taxonomy")

149 (string-has? rendered "s-shape-15")))))

150

151;; SD-P2's node, end to end. In HTML it must be a real anchor with the safety

152;; attributes the renderer promises, not text that merely contains a URL.

153(for-each-rendering

154 (lambda (name rendered)

155 (check (string-append name " keeps the external href")

156 (string-has? rendered "https://codeberg.org/sigil/folio"))))

157(check "html emits a real external anchor with rel protection"

158 (and (string-has? html "<a href=\"https://codeberg.org/sigil/folio\"")

159 (string-has? html "rel=\"external noopener noreferrer\"")))

160(check "typst emits a link rather than bare text"

161 (string-has? typst "#link(\"https://codeberg.org/sigil/folio\""))

162

163;; Unicode must survive the whole chain, not just the model.

164(for-each-rendering

165 (lambda (name rendered)

166 (check (string-append name " keeps non-ASCII prose") (string-has? rendered "καλημέρα"))))

167

168;; POSITIVE CONTROL, both directions: remove the derived nodes and the markers

169;; must disappear from a real rendering. Without this, every marker assertion

170;; above would also pass for a renderer that printed the marker unconditionally.

171(define control-loc (locate-text "@task[\"t-note01\" status: ready priority: low]"))

172(define without-derived

173 (make-project "projects/control" "Control" 'active '()

174 (list (make-paragraph (list (make-text "nothing derived in here" control-loc)) control-loc))

175 control-loc))

176(define control-plain (document->plain (folio-document->publication without-derived #f)))

177(check "control rendering is itself non-trivial" (> (string-length control-plain) 30))

178(check "no marker appears when no derived node is present"

179 (not (string-has? control-plain unresolved-marker-prefix)))

180(check "no query id appears when no query is present"

181 (not (string-has? control-plain "q-ready-work")))

182

183;; ---------------------------------------------------------------------------

184;; Self-test: prove THIS harness can go red, on this run, before its green

185;; result is allowed to mean anything.

186;; ---------------------------------------------------------------------------

187(if (getenv "F1A_PROBE_SELFTEST")

188 (check "deliberate failure injected by F1A_PROBE_SELFTEST" #f))

189

190(display (string-append "F1A_PUBLICATION_PROBE checks=" (number->string checks-run)

191 " failed=" (number->string checks-failed)))

192(newline)

193(if (> checks-failed 0)

194 (error "F1A publication probe failed" checks-failed))