src/ledger.sgl — sigil-ledger

1;;; (ledger) - hledger Journal File Reader/Writer

2;;;

3;;; Read and write hledger journal files. Parses transactions, postings,

4;;; amounts with commodities, tags, and cost notation. Supports appending

5;;; new transactions and deduplicating by reference ID.

6;;;

7;;; ## Basic Usage

8;;;

9;;; ```scheme

10;;; (import (ledger))

11;;;

12;;; ;; Read a journal file

13;;; (define txns (read-journal "main.journal"))

14;;;

15;;; ;; Write transactions to a file

16;;; (write-journal "output.journal" txns)

17;;;

18;;; ;; Append new transactions (common case for imports)

19;;; (append-transactions "main.journal" new-txns)

20;;;

21;;; ;; Deduplicate by reference ID tag

22;;; (define unique (deduplicate-transactions new-txns existing-txns))

23;;; ```

25(define-library (ledger)

26 (import (sigil string)

27 (sigil io)

28 (sigil fs)

29 (sigil struct))

30 (export

31 ;; Records

32 journal-amount

33 journal-amount?

34 journal-amount-quantity

35 journal-amount-commodity

36 journal-amount-sign-before-commodity

38 journal-cost

39 journal-cost?

40 journal-cost-type

41 journal-cost-amount

43 journal-posting

44 journal-posting?

45 journal-posting-account

46 journal-posting-amount

47 journal-posting-cost

48 journal-posting-comment

49 journal-posting-tags

50 journal-posting-balance-assertion

51 journal-posting-balance-assertion-type

53 journal-transaction

54 journal-transaction?

55 journal-transaction-date

56 journal-transaction-status

57 journal-transaction-code

58 journal-transaction-description

59 journal-transaction-comment

60 journal-transaction-tags

61 journal-transaction-postings

63 ;; Parsing

64 read-journal

65 parse-journal

67 ;; Writing

68 write-journal

69 format-transaction

70 format-transactions

72 ;; Appending & deduplication

73 append-transactions

74 deduplicate-transactions)

76 (begin

78 ;; ========== Records ==========

80 (define-struct journal-amount

81 (quantity default: 0)

82 (commodity default: "")

83 (sign-before-commodity default: #f)) ; #t when parsed from "-$50" form

85 (define-struct journal-cost

86 (type default: 'per-unit) ; 'per-unit (@) or 'total (@@)

87 (amount default: #f)) ; journal-amount

89 (define-struct journal-posting

90 (account default: "")

91 (amount default: #f) ; journal-amount or #f (inferred)

92 (cost default: #f) ; journal-cost or #f

93 (comment default: "")

94 (tags default: '()) ; alist of (name . value)

95 (balance-assertion default: #f) ; journal-amount or #f

96 (balance-assertion-type default: "=")) ; "=", "==", or "=*"

98 (define-struct journal-transaction

99 (date default: "")

100 (status default: "") ; "" (unmarked), "!" (pending), "*" (cleared)

101 (code default: "") ; optional code in parentheses

102 (description default: "")

103 (comment default: "")

104 (tags default: '()) ; alist of (name . value)

105 (postings default: '())) ; list of journal-posting

106

107 ;; ========== Journal Writing ==========

108

109 ;;; Format a journal-amount as a string.

110 ;;;

111 ;;; Handles both left-symbol (e.g. "$100.00") and right-symbol

112 ;;; (e.g. "100.00 EUR") commodities. Symbols containing only

113 ;;; common currency characters are placed adjacent to the number;

114 ;;; alphabetic commodity codes are placed after with a space.

115 (define (format-amount amt)

116 (if (not amt)

117 ""

118 (let ((qty (journal-amount-quantity amt))

119 (comm (journal-amount-commodity amt))

120 (sign-before (journal-amount-sign-before-commodity amt)))

121 (if (string-empty? comm)

122 (format-number qty)

123 (if (currency-symbol? comm)

124 ;; Preserve original sign placement for round-trip fidelity

125 (if (and sign-before (< qty 0))

126 (str "-" comm (format-number (- qty)))

127 (str comm (format-number qty)))

128 (str (format-number qty) " " comm))))))

129

130 ;;; Check if a commodity string is a currency symbol (like $, EUR, etc.)

131 ;;; Currency symbols go before the number, alpha codes go after.

132 (define (currency-symbol? s)

133 (and (not (string-empty? s))

134 (let ((c (string-ref s 0)))

135 (or (char=? c #\$)

136 (char=? c (integer->char 163)) ; pound

137 (char=? c (integer->char 165)) ; yen

138 (char=? c (integer->char 8364)) ; euro sign

139 ))))

140

141 ;;; Format a number for journal output.

142 ;;; Ensures at least 2 decimal places for currency amounts.

143 (define (format-number n)

144 (if (integer? n)

145 (str (number->string n) ".00")

146 (let ((s (number->string n)))

147 ;; Ensure at least 2 decimal places

148 (let ((dot-pos (string-find s ".")))

149 (if dot-pos

150 (let ((decimals (- (string-length s) dot-pos 1)))

151 (if (< decimals 2)

152 (str s (string-repeat "0" (- 2 decimals)))

153 s))

154 (str s ".00"))))))

155

156 ;;; Format a cost notation string.

157 (define (format-cost cost)

158 (if (not cost)

159 ""

160 (let ((type (journal-cost-type cost))

161 (amt (journal-cost-amount cost)))

162 (if (eq? type 'total)

163 (str " @@ " (format-amount amt))

164 (str " @ " (format-amount amt))))))

165

166 ;;; Format tags as a comment string fragment.

167 ;;; Returns a string like "; tag1:val1, tag2:val2" or "" if no tags.

168 (define (format-tags tags)

169 (if (or (not tags) (null? tags))

170 ""

171 (string-join (map (lambda (tag)

172 (if (string-empty? (cdr tag))

173 (str (car tag) ":")

174 (str (car tag) ": " (cdr tag))))

175 tags)

176 ", ")))

177

178 ;;; Format a single posting as a journal line.

179 (define (format-posting posting)

180 (let* ((account (journal-posting-account posting))

181 (amt (journal-posting-amount posting))

182 (cost (journal-posting-cost posting))

183 (comment (journal-posting-comment posting))

184 (tags (journal-posting-tags posting))

185 (bal (journal-posting-balance-assertion posting))

186 (amount-str (if amt (format-amount amt) ""))

187 (cost-str (format-cost cost))

188 (bal-str (if bal

189 (str " " (journal-posting-balance-assertion-type posting)

190 " " (format-amount bal))

191 ""))

192 ;; Combine tags and comment

193 (tag-str (format-tags tags))

194 (comment-parts (cond

195 ((and (not (string-empty? comment))

196 (not (string-empty? tag-str)))

197 (str " ; " comment ", " tag-str))

198 ((not (string-empty? comment))

199 (str " ; " comment))

200 ((not (string-empty? tag-str))

201 (str " ; " tag-str))

202 (else ""))))

203 (if (string-empty? amount-str)

204 (str " " account comment-parts)

205 (str " " account " " amount-str cost-str bal-str comment-parts))))

206

207 ;;; Format a single transaction as a journal string.

208 ;;;

209 ;;; ```scheme

210 ;;; (format-transaction

211 ;;; (journal-transaction

212 ;;; date: "2026-03-15"

213 ;;; status: "*"

214 ;;; description: "Grocery store"

215 ;;; postings: (list

216 ;;; (journal-posting account: "expenses:food" amount: (journal-amount quantity: 47.23 commodity: "USD"))

217 ;;; (journal-posting account: "assets:checking"))))

218 ;;; ```

219 (define (format-transaction txn)

220 (let* ((date (journal-transaction-date txn))

221 (status (journal-transaction-status txn))

222 (code (journal-transaction-code txn))

223 (desc (journal-transaction-description txn))

224 (comment (journal-transaction-comment txn))

225 (tags (journal-transaction-tags txn))

226 (postings (journal-transaction-postings txn))

227 ;; Build header line

228 (header (str date

229 (if (string-empty? status) "" (str " " status))

230 (if (string-empty? code) "" (str " (" code ")"))

231 (if (string-empty? desc) "" (str " " desc))))

232 ;; Transaction-level comment/tags

233 (tag-str (format-tags tags))

234 (txn-comment (cond

235 ((and (not (string-empty? comment))

236 (not (string-empty? tag-str)))

237 (str "\n ; " comment ", " tag-str))

238 ((not (string-empty? comment))

239 (str "\n ; " comment))

240 ((not (string-empty? tag-str))

241 (str "\n ; " tag-str))

242 (else "")))

243 ;; Format postings

244 (posting-lines (map format-posting postings)))

245 (string-join (cons (str header txn-comment) posting-lines) "\n")))

246

247 ;;; Format a list of transactions as a complete journal string.

248 (define (format-transactions txns)

249 (string-join (map format-transaction txns) "\n\n"))

250

251 ;;; Write a list of transactions to a journal file.

252 ;;;

253 ;;; Creates or overwrites the file with valid hledger journal format.

254 (define (write-journal path txns)

255 (write-file-string path (str (format-transactions txns) "\n")))

256

257 ;;; Append transactions to an existing journal file.

258 ;;;

259 ;;; Adds new transactions to the end of the file, separated by

260 ;;; blank lines. Creates the file if it doesn't exist.

261 (define (append-transactions path txns)

262 (if (null? txns)

263 #t

264 (let ((new-content (format-transactions txns)))

265 (guard (exn (else (write-file-string path (str new-content "\n"))))

266 (let ((existing (read-file-string path)))

267 (write-file-string path

268 (str (string-trim-end existing) "\n\n" new-content "\n")))))))

269

270 ;; ========== Journal Parsing ==========

271

272 ;;; Read and parse an hledger journal file.

273 ;;;

274 ;;; Returns a list of journal-transaction records.

275 ;;;

276 ;;; ```scheme

277 ;;; (define txns (read-journal "main.journal"))

278 ;;; (journal-transaction-date (car txns)) ; => "2026-03-15"

279 ;;; ```

280 (define (read-journal path)

281 (parse-journal (read-file-string path)))

282

283 ;;; Parse a journal string into a list of transactions.

284 ;;;

285 ;;; Handles dates, status flags, descriptions, postings with

286 ;;; amounts and commodities, comments, tags, cost notation,

287 ;;; and balance assertions.

288 (define (parse-journal text)

289 (let ((lines (string-split text "\n")))

290 (parse-lines lines '())))

291

292 ;; Parse lines into transactions, accumulating results

293 (define (parse-lines lines acc)

294 (if (null? lines)

295 (reverse acc)

296 (let ((line (car lines)))

297 (if (transaction-start? line)

298 ;; Found a transaction header — gather its lines

299 (let ((result (gather-transaction-lines (cdr lines) '())))

300 (let ((posting-lines (car result))

301 (remaining (cdr result)))

302 (let ((txn (parse-transaction line posting-lines)))

303 (parse-lines remaining (cons txn acc)))))

304 ;; Skip non-transaction lines (comments, directives, blank)

305 (parse-lines (cdr lines) acc)))))

306

307 ;; Check if a line starts a transaction (begins with a date)

308 (define (transaction-start? line)

309 (and (>= (string-length line) 10)

310 (char-numeric? (string-ref line 0))

311 (char-numeric? (string-ref line 1))

312 (char-numeric? (string-ref line 2))

313 (char-numeric? (string-ref line 3))

314 (date-separator? (string-ref line 4))

315 (char-numeric? (string-ref line 5))

316 (char-numeric? (string-ref line 6))

317 (date-separator? (string-ref line 7))

318 (char-numeric? (string-ref line 8))

319 (char-numeric? (string-ref line 9))))

320

321 (define (date-separator? c)

322 (or (char=? c #\-) (char=? c #\/) (char=? c #\.)))

323

324 ;; Gather continuation lines (indented or blank) for a transaction

325 (define (gather-transaction-lines lines acc)

326 (if (null? lines)

327 (cons (reverse acc) '())

328 (let* ((line (car lines))

329 (trimmed (string-trim line)))

330 (if (or (string-empty? trimmed)

331 (and (> (string-length line) 0)

332 (or (char=? (string-ref line 0) #\space)

333 (char=? (string-ref line 0) #\tab))))

334 ;; Skip blank lines within transaction, collect indented lines

335 (if (string-empty? trimmed)

336 ;; Blank line — could be end of transaction, peek ahead

337 (if (and (pair? (cdr lines))

338 (> (string-length (cadr lines)) 0)

339 (or (char=? (string-ref (cadr lines) 0) #\space)

340 (char=? (string-ref (cadr lines) 0) #\tab)))

341 ;; Next line is indented, continue

342 (gather-transaction-lines (cdr lines) acc)

343 ;; End of transaction

344 (cons (reverse acc) (cdr lines)))

345 (gather-transaction-lines (cdr lines) (cons line acc)))

346 ;; Non-indented, non-blank line = new transaction or directive

347 (cons (reverse acc) lines)))))

348

349 ;; Parse a transaction from its header line and posting lines

350 (define (parse-transaction header-line posting-lines)

351 (let* ((header (parse-transaction-header header-line))

352 (txn-comment-and-tags (extract-header-comments posting-lines))

353 (txn-comment (car txn-comment-and-tags))

354 (txn-tags (cadr txn-comment-and-tags))

355 (real-posting-lines (caddr txn-comment-and-tags))

356 (postings (map parse-posting real-posting-lines)))

357 (journal-transaction

358 date: (car header)

359 status: (cadr header)

360 code: (caddr header)

361 description: (cadddr header)

362 comment: txn-comment

363 tags: txn-tags

364 postings: postings)))

365

366 ;; Extract transaction-level comments (indented ; lines before postings with accounts)

367 (define (extract-header-comments lines)

368 (let loop ((remaining lines) (comment "") (tags '()))

369 (if (null? remaining)

370 (list comment tags '())

371 (let ((line (string-trim (car remaining))))

372 (if (and (> (string-length line) 0)

373 (char=? (string-ref line 0) #\;))

374 ;; Comment line

375 (let* ((comment-text (string-trim (substring line 1 (string-length line))))

376 (parsed-tags (parse-tags-from-comment comment-text))

377 (new-comment (if (string-empty? comment)

378 comment-text

379 (str comment ", " comment-text)))

380 (new-tags (append tags parsed-tags)))

381 (loop (cdr remaining) new-comment new-tags))

382 ;; Not a comment, these are posting lines

383 (list comment tags remaining))))))

384

385 ;; Parse the transaction header line

386 ;; Format: DATE [STATUS] [(CODE)] DESCRIPTION

387 (define (parse-transaction-header line)

388 (let* ((date (substring line 0 10))

389 (rest (string-trim (substring line 10 (string-length line))))

390 ;; Parse status

391 (status-result (parse-status rest))

392 (status (car status-result))

393 (rest2 (cdr status-result))

394 ;; Parse code

395 (code-result (parse-code rest2))

396 (code (car code-result))

397 (rest3 (cdr code-result))

398 ;; Remaining is description

399 (description (string-trim rest3)))

400 (list date status code description)))

401

402 ;; Parse optional status flag (* or !)

403 (define (parse-status text)

404 (let ((s (string-trim text)))

405 (if (string-empty? s)

406 (cons "" s)

407 (let ((c (string-ref s 0)))

408 (cond

409 ((char=? c #\*)

410 (cons "*" (string-trim (substring s 1 (string-length s)))))

411 ((char=? c #\!)

412 (cons "!" (string-trim (substring s 1 (string-length s)))))

413 (else

414 (cons "" s)))))))

415

416 ;; Parse optional code in parentheses

417 (define (parse-code text)

418 (let ((s (string-trim text)))

419 (if (and (> (string-length s) 0) (char=? (string-ref s 0) #\())

420 (let ((close (string-find s ")")))

421 (if close

422 (cons (substring s 1 close)

423 (string-trim (substring s (+ close 1) (string-length s))))

424 (cons "" s)))

425 (cons "" s))))

426

427 ;; Parse a posting line

428 (define (parse-posting line)

429 (let* ((trimmed (string-trim line))

430 ;; Split off inline comment

431 (comment-split (split-inline-comment trimmed))

432 (main-part (car comment-split))

433 (comment-text (cdr comment-split))

434 (posting-tags (if (string-empty? comment-text)

435 '()

436 (parse-tags-from-comment comment-text)))

437 ;; Parse the main part: account amount [cost] [= assertion]

438 ;; Returns (account amount cost assertion assertion-type)

439 (parsed (parse-posting-parts main-part))

440 (p-account (car parsed))

441 (p-amount (cadr parsed))

442 (p-cost (caddr parsed))

443 (p-assertion (cadddr parsed))

444 (p-assertion-type (list-ref parsed 4)))

445 (journal-posting

446 account: p-account

447 amount: p-amount

448 cost: p-cost

449 comment: comment-text

450 tags: posting-tags

451 balance-assertion: p-assertion

452 balance-assertion-type: p-assertion-type)))

453

454 ;; Split a line at the first inline comment (;), respecting the

455 ;; hledger rule that ; must be preceded by 2+ spaces

456 (define (split-inline-comment text)

457 (let ((len (string-length text)))

458 (let loop ((i 0))

459 (if (>= i len)

460 (cons text "")

461 (if (and (char=? (string-ref text i) #\;)

462 (>= i 2)

463 (char=? (string-ref text (- i 1)) #\space)

464 (char=? (string-ref text (- i 2)) #\space))

465 (cons (string-trim-end (substring text 0 (- i 2)))

466 (string-trim (substring text (+ i 1) len)))

467 (loop (+ i 1)))))))

468

469 ;; Parse tags from a comment string like "tag1:val1, tag2:val2"

470 (define (parse-tags-from-comment text)

471 (let ((parts (string-split text ",")))

472 (let loop ((rest parts) (tags '()))

473 (if (null? rest)

474 (reverse tags)

475 (let ((part (string-trim (car rest))))

476 (let ((colon (string-find part ":")))

477 (if colon

478 (let ((name (string-trim (substring part 0 colon)))

479 (value (string-trim (substring part (+ colon 1) (string-length part)))))

480 (loop (cdr rest) (cons (cons name value) tags)))

481 (loop (cdr rest) tags))))))))

482

483 ;; Parse posting parts: account, amount, cost, balance assertion

484 ;; The account and amount are separated by 2+ spaces

485 (define (parse-posting-parts text)

486 (let ((trimmed (string-trim text)))

487 ;; Find the split point: 2+ consecutive spaces

488 (let ((split-pos (find-double-space trimmed)))

489 (if (not split-pos)

490 ;; No amount — just an account (amount inferred)

491 (list trimmed #f #f #f "=")

492 (let* ((account (string-trim (substring trimmed 0 split-pos)))

493 (amount-part (string-trim (substring trimmed split-pos (string-length trimmed)))))

494 ;; Parse amount part which may include cost and balance assertion

495 (parse-amount-cost-assertion account amount-part))))))

496

497 ;; Find position of first occurrence of 2+ consecutive spaces

498 (define (find-double-space text)

499 (let ((len (string-length text)))

500 (let loop ((i 0))

501 (if (>= (+ i 1) len)

502 #f

503 (if (and (char=? (string-ref text i) #\space)

504 (char=? (string-ref text (+ i 1)) #\space))

505 i

506 (loop (+ i 1)))))))

507

508 ;; Parse amount, optional cost (@/@@), and optional balance assertion (=, ==, =*)

509 ;; Returns (account amount cost assertion assertion-type)

510 (define (parse-amount-cost-assertion account text)

511 (let* (;; Check for balance assertion first

512 (assertion-split (split-balance-assertion text))

513 (amount-cost-part (car assertion-split))

514 (assertion (cadr assertion-split))

515 (assertion-type (caddr assertion-split))

516 ;; Check for cost notation

517 (cost-split (split-cost amount-cost-part))

518 (amount-str (string-trim (car cost-split)))

519 (cost (cdr cost-split))

520 ;; Parse the amount

521 (amount (parse-amount-string amount-str)))

522 (list account amount cost assertion assertion-type)))

523

524 ;; Split off balance assertion (=, ==, or =* amount) from end

525 ;; Returns (amount-cost-part assertion-amount assertion-type)

526 (define (split-balance-assertion text)

527 (let ((eq-pos (find-assertion-equals text)))

528 (if eq-pos

529 ;; Determine assertion type: ==, =*, or = and skip accordingly

530 (let* ((next-char (if (< (+ eq-pos 1) (string-length text))

531 (string-ref text (+ eq-pos 1))

532 #f))

533 (assertion-type (cond

534 ((and next-char (char=? next-char #\=)) "==")

535 ((and next-char (char=? next-char #\*)) "=*")

536 (else "=")))

537 (skip (if (string=? assertion-type "=") 1 2))

538 (assertion-str (string-trim (substring text (+ eq-pos skip) (string-length text)))))

539 (list (string-trim (substring text 0 eq-pos))

540 (parse-amount-string assertion-str)

541 assertion-type))

542 (list text #f "="))))

543

544 ;; Find the = for balance assertion, distinguishing from ==, =* and @@/@ signs

545 ;; Returns position of first = or #f

546 (define (find-assertion-equals text)

547 (let ((len (string-length text)))

548 (let loop ((i (- len 1)))

549 (if (< i 0)

550 #f

551 (let ((c (string-ref text i)))

552 (if (char=? c #\=)

553 ;; Check it's not part of == (strict assertion)

554 (if (and (> i 0) (char=? (string-ref text (- i 1)) #\=))

555 ;; == strict assertion — return position of first =

556 (- i 1)

557 i)

558 ;; Check for =* — the * comes after =, so look for = before *

559 (if (and (char=? c #\*)

560 (> i 0)

561 (char=? (string-ref text (- i 1)) #\=))

562 ;; =* inclusive assertion — return position of =

563 (- i 1)

564 (loop (- i 1)))))))))

565

566 ;; Split off cost notation (@ or @@) from amount string

567 (define (split-cost text)

568 (let ((total-pos (string-find text " @@ "))

569 (unit-pos (string-find text " @ ")))

570 (cond

571 ;; @@ (total cost) — check first to avoid matching @ within @@

572 ((and total-pos (or (not unit-pos) (<= total-pos unit-pos)))

573 (let* ((amount-part (substring text 0 total-pos))

574 (cost-str (string-trim (substring text (+ total-pos 4) (string-length text))))

575 (cost-amount (parse-amount-string cost-str)))

576 (cons amount-part

577 (journal-cost type: 'total amount: cost-amount))))

578 ;; @ (per-unit cost)

579 (unit-pos

580 (let* ((amount-part (substring text 0 unit-pos))

581 (cost-str (string-trim (substring text (+ unit-pos 3) (string-length text))))

582 (cost-amount (parse-amount-string cost-str)))

583 (cons amount-part

584 (journal-cost type: 'per-unit amount: cost-amount))))

585 ;; No cost

586 (else

587 (cons text #f)))))

588

589 ;; Parse an amount string like "$100.00", "100.00 EUR", "-50", "100.00"

590 (define (parse-amount-string text)

591 (let ((s (string-trim text)))

592 (if (string-empty? s)

593 #f

594 (cond

595 ;; Left-symbol commodity: $100.00

596 ((left-commodity-char? (string-ref s 0))

597 (parse-left-commodity s))

598 ;; Negative with left-symbol: -$50

599 ((and (> (string-length s) 1)

600 (char=? (string-ref s 0) #\-)

601 (left-commodity-char? (string-ref s 1)))

602 (parse-negative-left-commodity s))

603 ;; Number possibly followed by commodity

604 (else

605 (parse-right-commodity s))))))

606

607 ;; Reuse currency-symbol? — check first char of a 1-char string

608 (define (left-commodity-char? c)

609 (currency-symbol? (string c)))

610

611 ;; Parse "$100.00" style

612 (define (parse-left-commodity text)

613 (let* ((commodity (substring text 0 1))

614 (num-str (strip-digit-groups (substring text 1 (string-length text))))

615 (qty (string->number num-str)))

616 (if qty

617 (journal-amount quantity: qty commodity: commodity)

618 (journal-amount quantity: 0 commodity: text))))

619

620 ;; Parse "-$100.00" style

621 (define (parse-negative-left-commodity text)

622 (let* ((commodity (substring text 1 2))

623 (num-str (strip-digit-groups (substring text 2 (string-length text))))

624 (qty (string->number num-str)))

625 (if qty

626 (journal-amount quantity: (- qty) commodity: commodity

627 sign-before-commodity: #t)

628 (journal-amount quantity: 0 commodity: text))))

629

630 ;; Parse "100.00 EUR" or just "100.00" style

631 (define (parse-right-commodity text)

632 (let ((s (string-trim text)))

633 ;; Find where number ends and commodity begins

634 (let ((split (find-number-end s)))

635 (if split

636 (let* ((num-str (strip-digit-groups (string-trim (substring s 0 split))))

637 (comm (string-trim (substring s split (string-length s))))

638 (qty (string->number num-str)))

639 (if qty

640 (journal-amount quantity: qty commodity: comm)

641 (journal-amount quantity: 0 commodity: s)))

642 ;; Try as plain number

643 (let ((qty (string->number (strip-digit-groups s))))

644 (if qty

645 (journal-amount quantity: qty commodity: "")

646 (journal-amount quantity: 0 commodity: s)))))))

647

648 ;; Find the index where the number portion ends in a string

649 ;; Numbers can contain digits, ., -, +, and , (as group separator)

650 (define (find-number-end text)

651 (let ((len (string-length text)))

652 (let loop ((i 0) (found-digit #f))

653 (if (>= i len)

654 (if found-digit #f i) ; all number or no number

655 (let ((c (string-ref text i)))

656 (if (or (char-numeric? c)

657 (char=? c #\.)

658 (char=? c #\,)

659 (and (char=? c #\-) (= i 0))

660 (and (char=? c #\+) (= i 0)))

661 (loop (+ i 1) #t)

662 (if found-digit

663 i ; end of number

664 (loop (+ i 1) #f))))))))

665

666 ;; Strip digit group separators (commas used as thousands separators)

667 (define (strip-digit-groups text)

668 (string-replace text "," ""))

669

670 ;; ========== Deduplication ==========

671

672 ;;; Filter out transactions that already exist in an existing journal.

673 ;;;

674 ;;; Deduplication is based on a "ref" tag in transaction comments.

675 ;;; Transactions without a ref tag are always included.

676 ;;;

677 ;;; ```scheme

678 ;;; (define existing (read-journal "main.journal"))

679 ;;; (define new-txns (list ...))

680 ;;; (define unique (deduplicate-transactions new-txns existing))

681 ;;; ```

682 (define (deduplicate-transactions new-txns existing-txns)

683 (let ((existing-refs (collect-refs existing-txns)))

684 (filter (lambda (txn)

685 (let ((ref (find-ref txn)))

686 (or (not ref)

687 (not (member ref existing-refs)))))

688 new-txns)))

689

690 ;; Collect all "ref" tag values from a list of transactions

691 (define (collect-refs txns)

692 (let loop ((rest txns) (refs '()))

693 (if (null? rest)

694 refs

695 (let ((ref (find-ref (car rest))))

696 (loop (cdr rest)

697 (if ref (cons ref refs) refs))))))

698

699 ;; Find the "ref" tag value in a transaction (checks both txn and posting tags)

700 (define (find-ref txn)

701 (let ((txn-ref (assoc "ref" (journal-transaction-tags txn))))

702 (if txn-ref

703 (cdr txn-ref)

704 ;; Check posting tags

705 (let loop ((postings (journal-transaction-postings txn)))

706 (if (null? postings)

707 #f

708 (let ((posting-ref (assoc "ref" (journal-posting-tags (car postings)))))

709 (if posting-ref

710 (cdr posting-ref)

711 (loop (cdr postings)))))))))))