Commit0169200bRecorded25 Mar 2026Repositorysigil-ledger

Implement sigil-ledger library for hledger journal files

Message

Core (sigil ledger) module provides:

  • Record types for transactions, postings, amounts, and costs
  • Journal parser handling dates, status flags, codes, descriptions, amounts with commodities, cost notation (@/@@), balance assertions, inline comments, and tags
  • Journal writer producing valid hledger format
  • Transaction deduplication by reference ID tag
  • File read/write/append operations

Report module (sigil ledger report) wraps hledger CLI for:

  • Balance, register, and income statement reports
  • JSON output parsing via hledger print
  • Flexible query and option passing

Includes 29 tests covering formatting, parsing, round-tripping, cost notation, balance assertions, tags, and deduplication.

Changed
 .gitignore                  |   2 +
 package.sgl                 |   3 +-
 src/sigil/ledger.sgl        | 675 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/ledger/report.sgl | 176 +++++++++++++++++++++++++++++++++++++++++++
 test/test-ledger.sgl        | 387 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 1242 insertions(+), 1 deletion(-)
Diff
.gitignoreadded
@@ -0,0 +1,2 @@
+1
build/
+2
.mcp.json
package.sglmodified
@@ -28,7 +28,8 @@
28
dependencies: (list
29
(from-git url: sigil-repo package: "sigil-stdlib")
30
(from-git url: sigil-repo package: "sigil-json")
−31
(from-git url: sigil-repo package: "sigil-log"))
+31
(from-git url: sigil-repo package: "sigil-log")
+32
(from-git url: sigil-repo package: "sigil-test"))
33
34
tasks: (list
35
(task
src/sigil/ledger.sgladded
@@ -0,0 +1,675 @@
+1
;;; (sigil 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 (sigil 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
;;; ```
+24
+25
(define-library (sigil 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
+37
journal-cost
+38
journal-cost?
+39
journal-cost-type
+40
journal-cost-amount
+41
+42
journal-posting
+43
journal-posting?
+44
journal-posting-account
+45
journal-posting-amount
+46
journal-posting-cost
+47
journal-posting-comment
+48
journal-posting-tags
+49
journal-posting-balance-assertion
+50
+51
journal-transaction
+52
journal-transaction?
+53
journal-transaction-date
+54
journal-transaction-status
+55
journal-transaction-code
+56
journal-transaction-description
+57
journal-transaction-comment
+58
journal-transaction-tags
+59
journal-transaction-postings
+60
+61
;; Parsing
+62
read-journal
+63
parse-journal
+64
+65
;; Writing
+66
write-journal
+67
format-transaction
+68
format-transactions
+69
+70
;; Appending & deduplication
+71
append-transactions
+72
deduplicate-transactions)
+73
+74
(begin
+75
+76
;; ========== Records ==========
+77
+78
(define-struct journal-amount
+79
(quantity default: 0)
+80
(commodity default: ""))
+81
+82
(define-struct journal-cost
+83
(type default: 'per-unit) ; 'per-unit (@) or 'total (@@)
+84
(amount default: #f)) ; journal-amount
+85
+86
(define-struct journal-posting
+87
(account default: "")
+88
(amount default: #f) ; journal-amount or #f (inferred)
+89
(cost default: #f) ; journal-cost or #f
+90
(comment default: "")
+91
(tags default: '()) ; alist of (name . value)
+92
(balance-assertion default: #f)) ; journal-amount or #f
+93
+94
(define-struct journal-transaction
+95
(date default: "")
+96
(status default: "") ; "" (unmarked), "!" (pending), "*" (cleared)
+97
(code default: "") ; optional code in parentheses
+98
(description default: "")
+99
(comment default: "")
+100
(tags default: '()) ; alist of (name . value)
+101
(postings default: '())) ; list of journal-posting
+102
+103
;; ========== Journal Writing ==========
+104
+105
;;; Format a journal-amount as a string.
+106
;;;
+107
;;; Handles both left-symbol (e.g. "$100.00") and right-symbol
+108
;;; (e.g. "100.00 EUR") commodities. Symbols containing only
+109
;;; common currency characters are placed adjacent to the number;
+110
;;; alphabetic commodity codes are placed after with a space.
+111
(define (format-amount amt)
+112
(if (not amt)
+113
""
+114
(let ((qty (journal-amount-quantity amt))
+115
(comm (journal-amount-commodity amt)))
+116
(if (string-empty? comm)
+117
(format-number qty)
+118
(if (currency-symbol? comm)
+119
(str comm (format-number qty))
+120
(str (format-number qty) " " comm))))))
+121
+122
;;; Check if a commodity string is a currency symbol (like $, EUR, etc.)
+123
;;; Currency symbols go before the number, alpha codes go after.
+124
(define (currency-symbol? s)
+125
(and (not (string-empty? s))
+126
(let ((c (string-ref s 0)))
+127
(or (char=? c #\$)
+128
(char=? c (integer->char 163)) ; pound
+129
(char=? c (integer->char 165)) ; yen
+130
(char=? c (integer->char 8364)) ; euro sign
+131
))))
+132
+133
;;; Format a number for journal output.
+134
;;; Ensures at least 2 decimal places for currency amounts.
+135
(define (format-number n)
+136
(if (integer? n)
+137
(str (number->string n) ".00")
+138
(let ((s (number->string n)))
+139
;; Ensure at least 2 decimal places
+140
(let ((dot-pos (string-find s ".")))
+141
(if dot-pos
+142
(let ((decimals (- (string-length s) dot-pos 1)))
+143
(if (< decimals 2)
+144
(str s (string-repeat "0" (- 2 decimals)))
+145
s))
+146
(str s ".00"))))))
+147
+148
;;; Format a cost notation string.
+149
(define (format-cost cost)
+150
(if (not cost)
+151
""
+152
(let ((type (journal-cost-type cost))
+153
(amt (journal-cost-amount cost)))
+154
(if (eq? type 'total)
+155
(str " @@ " (format-amount amt))
+156
(str " @ " (format-amount amt))))))
+157
+158
;;; Format tags as a comment string fragment.
+159
;;; Returns a string like "; tag1:val1, tag2:val2" or "" if no tags.
+160
(define (format-tags tags)
+161
(if (or (not tags) (null? tags))
+162
""
+163
(string-join (map (lambda (tag)
+164
(if (string-empty? (cdr tag))
+165
(str (car tag) ":")
+166
(str (car tag) ": " (cdr tag))))
+167
tags)
+168
", ")))
+169
+170
;;; Format a single posting as a journal line.
+171
(define (format-posting posting)
+172
(let* ((account (journal-posting-account posting))
+173
(amt (journal-posting-amount posting))
+174
(cost (journal-posting-cost posting))
+175
(comment (journal-posting-comment posting))
+176
(tags (journal-posting-tags posting))
+177
(bal (journal-posting-balance-assertion posting))
+178
(amount-str (if amt (format-amount amt) ""))
+179
(cost-str (format-cost cost))
+180
(bal-str (if bal
+181
(str " = " (format-amount bal))
+182
""))
+183
;; Combine tags and comment
+184
(tag-str (format-tags tags))
+185
(comment-parts (cond
+186
((and (not (string-empty? comment))
+187
(not (string-empty? tag-str)))
+188
(str " ; " comment ", " tag-str))
+189
((not (string-empty? comment))
+190
(str " ; " comment))
+191
((not (string-empty? tag-str))
+192
(str " ; " tag-str))
+193
(else ""))))
+194
(if (string-empty? amount-str)
+195
(str " " account comment-parts)
+196
(str " " account " " amount-str cost-str bal-str comment-parts))))
+197
+198
;;; Format a single transaction as a journal string.
+199
;;;
+200
;;; ```scheme
+201
;;; (format-transaction
+202
;;; (journal-transaction
+203
;;; date: "2026-03-15"
+204
;;; status: "*"
+205
;;; description: "Grocery store"
+206
;;; postings: (list
+207
;;; (journal-posting account: "expenses:food" amount: (journal-amount quantity: 47.23 commodity: "USD"))
+208
;;; (journal-posting account: "assets:checking"))))
+209
;;; ```
+210
(define (format-transaction txn)
+211
(let* ((date (journal-transaction-date txn))
+212
(status (journal-transaction-status txn))
+213
(code (journal-transaction-code txn))
+214
(desc (journal-transaction-description txn))
+215
(comment (journal-transaction-comment txn))
+216
(tags (journal-transaction-tags txn))
+217
(postings (journal-transaction-postings txn))
+218
;; Build header line
+219
(header (str date
+220
(if (string-empty? status) "" (str " " status))
+221
(if (string-empty? code) "" (str " (" code ")"))
+222
(if (string-empty? desc) "" (str " " desc))))
+223
;; Transaction-level comment/tags
+224
(tag-str (format-tags tags))
+225
(txn-comment (cond
+226
((and (not (string-empty? comment))
+227
(not (string-empty? tag-str)))
+228
(str "\n ; " comment ", " tag-str))
+229
((not (string-empty? comment))
+230
(str "\n ; " comment))
+231
((not (string-empty? tag-str))
+232
(str "\n ; " tag-str))
+233
(else "")))
+234
;; Format postings
+235
(posting-lines (map format-posting postings)))
+236
(string-join (cons (str header txn-comment) posting-lines) "\n")))
+237
+238
;;; Format a list of transactions as a complete journal string.
+239
(define (format-transactions txns)
+240
(string-join (map format-transaction txns) "\n\n"))
+241
+242
;;; Write a list of transactions to a journal file.
+243
;;;
+244
;;; Creates or overwrites the file with valid hledger journal format.
+245
(define (write-journal path txns)
+246
(write-file-string path (str (format-transactions txns) "\n")))
+247
+248
;;; Append transactions to an existing journal file.
+249
;;;
+250
;;; Adds new transactions to the end of the file, separated by
+251
;;; blank lines. Creates the file if it doesn't exist.
+252
(define (append-transactions path txns)
+253
(if (null? txns)
+254
#t
+255
(let ((new-content (format-transactions txns)))
+256
(guard (exn (else (write-file-string path (str new-content "\n"))))
+257
(let ((existing (read-file-string path)))
+258
(write-file-string path
+259
(str (string-trim-end existing) "\n\n" new-content "\n")))))))
+260
+261
;; ========== Journal Parsing ==========
+262
+263
;;; Read and parse an hledger journal file.
+264
;;;
+265
;;; Returns a list of journal-transaction records.
+266
;;;
+267
;;; ```scheme
+268
;;; (define txns (read-journal "main.journal"))
+269
;;; (journal-transaction-date (car txns)) ; => "2026-03-15"
+270
;;; ```
+271
(define (read-journal path)
+272
(parse-journal (read-file-string path)))
+273
+274
;;; Parse a journal string into a list of transactions.
+275
;;;
+276
;;; Handles dates, status flags, descriptions, postings with
+277
;;; amounts and commodities, comments, tags, cost notation,
+278
;;; and balance assertions.
+279
(define (parse-journal text)
+280
(let ((lines (string-split text "\n")))
+281
(parse-lines lines '())))
+282
+283
;; Parse lines into transactions, accumulating results
+284
(define (parse-lines lines acc)
+285
(if (null? lines)
+286
(reverse acc)
+287
(let ((line (car lines)))
+288
(if (transaction-start? line)
+289
;; Found a transaction header — gather its lines
+290
(let ((result (gather-transaction-lines (cdr lines) '())))
+291
(let ((posting-lines (car result))
+292
(remaining (cdr result)))
+293
(let ((txn (parse-transaction line posting-lines)))
+294
(parse-lines remaining (cons txn acc)))))
+295
;; Skip non-transaction lines (comments, directives, blank)
+296
(parse-lines (cdr lines) acc)))))
+297
+298
;; Check if a line starts a transaction (begins with a date)
+299
(define (transaction-start? line)
+300
(and (>= (string-length line) 10)
+301
(char-numeric? (string-ref line 0))
+302
(char-numeric? (string-ref line 1))
+303
(char-numeric? (string-ref line 2))
+304
(char-numeric? (string-ref line 3))
+305
(date-separator? (string-ref line 4))
+306
(char-numeric? (string-ref line 5))
+307
(char-numeric? (string-ref line 6))
+308
(date-separator? (string-ref line 7))
+309
(char-numeric? (string-ref line 8))
+310
(char-numeric? (string-ref line 9))))
+311
+312
(define (date-separator? c)
+313
(or (char=? c #\-) (char=? c #\/) (char=? c #\.)))
+314
+315
;; Gather continuation lines (indented or blank) for a transaction
+316
(define (gather-transaction-lines lines acc)
+317
(if (null? lines)
+318
(cons (reverse acc) '())
+319
(let* ((line (car lines))
+320
(trimmed (string-trim line)))
+321
(if (or (string-empty? trimmed)
+322
(and (> (string-length line) 0)
+323
(or (char=? (string-ref line 0) #\space)
+324
(char=? (string-ref line 0) #\tab))))
+325
;; Skip blank lines within transaction, collect indented lines
+326
(if (string-empty? trimmed)
+327
;; Blank line — could be end of transaction, peek ahead
+328
(if (and (pair? (cdr lines))
+329
(> (string-length (cadr lines)) 0)
+330
(or (char=? (string-ref (cadr lines) 0) #\space)
+331
(char=? (string-ref (cadr lines) 0) #\tab)))
+332
;; Next line is indented, continue
+333
(gather-transaction-lines (cdr lines) acc)
+334
;; End of transaction
+335
(cons (reverse acc) (cdr lines)))
+336
(gather-transaction-lines (cdr lines) (cons line acc)))
+337
;; Non-indented, non-blank line = new transaction or directive
+338
(cons (reverse acc) lines)))))
+339
+340
;; Parse a transaction from its header line and posting lines
+341
(define (parse-transaction header-line posting-lines)
+342
(let* ((header (parse-transaction-header header-line))
+343
(txn-comment-and-tags (extract-header-comments posting-lines))
+344
(txn-comment (car txn-comment-and-tags))
+345
(txn-tags (cadr txn-comment-and-tags))
+346
(real-posting-lines (caddr txn-comment-and-tags))
+347
(postings (map parse-posting real-posting-lines)))
+348
(journal-transaction
+349
date: (car header)
+350
status: (cadr header)
+351
code: (caddr header)
+352
description: (cadddr header)
+353
comment: txn-comment
+354
tags: txn-tags
+355
postings: postings)))
+356
+357
;; Extract transaction-level comments (indented ; lines before postings with accounts)
+358
(define (extract-header-comments lines)
+359
(let loop ((remaining lines) (comment "") (tags '()))
+360
(if (null? remaining)
+361
(list comment tags '())
+362
(let ((line (string-trim (car remaining))))
+363
(if (and (> (string-length line) 0)
+364
(char=? (string-ref line 0) #\;))
+365
;; Comment line
+366
(let* ((comment-text (string-trim (substring line 1 (string-length line))))
+367
(parsed-tags (parse-tags-from-comment comment-text))
+368
(new-comment (if (string-empty? comment)
+369
comment-text
+370
(str comment ", " comment-text)))
+371
(new-tags (append tags parsed-tags)))
+372
(loop (cdr remaining) new-comment new-tags))
+373
;; Not a comment, these are posting lines
+374
(list comment tags remaining))))))
+375
+376
;; Parse the transaction header line
+377
;; Format: DATE [STATUS] [(CODE)] DESCRIPTION
+378
(define (parse-transaction-header line)
+379
(let* ((date (substring line 0 10))
+380
(rest (string-trim (substring line 10 (string-length line))))
+381
;; Parse status
+382
(status-result (parse-status rest))
+383
(status (car status-result))
+384
(rest2 (cdr status-result))
+385
;; Parse code
+386
(code-result (parse-code rest2))
+387
(code (car code-result))
+388
(rest3 (cdr code-result))
+389
;; Remaining is description
+390
(description (string-trim rest3)))
+391
(list date status code description)))
+392
+393
;; Parse optional status flag (* or !)
+394
(define (parse-status text)
+395
(let ((s (string-trim text)))
+396
(if (string-empty? s)
+397
(cons "" s)
+398
(let ((c (string-ref s 0)))
+399
(cond
+400
((char=? c #\*)
+401
(cons "*" (string-trim (substring s 1 (string-length s)))))
+402
((char=? c #\!)
+403
(cons "!" (string-trim (substring s 1 (string-length s)))))
+404
(else
+405
(cons "" s)))))))
+406
+407
;; Parse optional code in parentheses
+408
(define (parse-code text)
+409
(let ((s (string-trim text)))
+410
(if (and (> (string-length s) 0) (char=? (string-ref s 0) #\())
+411
(let ((close (string-find s ")")))
+412
(if close
+413
(cons (substring s 1 close)
+414
(string-trim (substring s (+ close 1) (string-length s))))
+415
(cons "" s)))
+416
(cons "" s))))
+417
+418
;; Parse a posting line
+419
(define (parse-posting line)
+420
(let* ((trimmed (string-trim line))
+421
;; Split off inline comment
+422
(comment-split (split-inline-comment trimmed))
+423
(main-part (car comment-split))
+424
(comment-text (cdr comment-split))
+425
(posting-tags (if (string-empty? comment-text)
+426
'()
+427
(parse-tags-from-comment comment-text)))
+428
;; Parse the main part: account amount [cost] [= assertion]
+429
(parsed (parse-posting-parts main-part)))
+430
(journal-posting
+431
account: (car parsed)
+432
amount: (cadr parsed)
+433
cost: (caddr parsed)
+434
comment: comment-text
+435
tags: posting-tags
+436
balance-assertion: (cadddr parsed))))
+437
+438
;; Split a line at the first inline comment (;), respecting the
+439
;; hledger rule that ; must be preceded by 2+ spaces
+440
(define (split-inline-comment text)
+441
(let ((len (string-length text)))
+442
(let loop ((i 0))
+443
(if (>= i len)
+444
(cons text "")
+445
(if (and (char=? (string-ref text i) #\;)
+446
(>= i 2)
+447
(char=? (string-ref text (- i 1)) #\space)
+448
(char=? (string-ref text (- i 2)) #\space))
+449
(cons (string-trim-end (substring text 0 (- i 2)))
+450
(string-trim (substring text (+ i 1) len)))
+451
(loop (+ i 1)))))))
+452
+453
;; Parse tags from a comment string like "tag1:val1, tag2:val2"
+454
(define (parse-tags-from-comment text)
+455
(let ((parts (string-split text ",")))
+456
(let loop ((rest parts) (tags '()))
+457
(if (null? rest)
+458
(reverse tags)
+459
(let ((part (string-trim (car rest))))
+460
(let ((colon (string-find part ":")))
+461
(if colon
+462
(let ((name (string-trim (substring part 0 colon)))
+463
(value (string-trim (substring part (+ colon 1) (string-length part)))))
+464
(loop (cdr rest) (cons (cons name value) tags)))
+465
(loop (cdr rest) tags))))))))
+466
+467
;; Parse posting parts: account, amount, cost, balance assertion
+468
;; The account and amount are separated by 2+ spaces
+469
(define (parse-posting-parts text)
+470
(let ((trimmed (string-trim text)))
+471
;; Find the split point: 2+ consecutive spaces
+472
(let ((split-pos (find-double-space trimmed)))
+473
(if (not split-pos)
+474
;; No amount — just an account (amount inferred)
+475
(list trimmed #f #f #f)
+476
(let* ((account (string-trim (substring trimmed 0 split-pos)))
+477
(amount-part (string-trim (substring trimmed split-pos (string-length trimmed)))))
+478
;; Parse amount part which may include cost and balance assertion
+479
(parse-amount-cost-assertion account amount-part))))))
+480
+481
;; Find position of first occurrence of 2+ consecutive spaces
+482
(define (find-double-space text)
+483
(let ((len (string-length text)))
+484
(let loop ((i 0))
+485
(if (>= (+ i 1) len)
+486
#f
+487
(if (and (char=? (string-ref text i) #\space)
+488
(char=? (string-ref text (+ i 1)) #\space))
+489
i
+490
(loop (+ i 1)))))))
+491
+492
;; Parse amount, optional cost (@/@@), and optional balance assertion (=)
+493
(define (parse-amount-cost-assertion account text)
+494
(let* (;; Check for balance assertion first
+495
(assertion-split (split-balance-assertion text))
+496
(amount-cost-part (car assertion-split))
+497
(assertion (cdr assertion-split))
+498
;; Check for cost notation
+499
(cost-split (split-cost amount-cost-part))

Showing the first 500 of 676 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.

src/sigil/ledger/report.sgladded
@@ -0,0 +1,176 @@
+1
;;; (sigil ledger report) - hledger CLI Report Generation
+2
;;;
+3
;;; Run hledger CLI commands and parse their output for reports.
+4
;;; Uses `--output-format json` where available for structured data.
+5
;;;
+6
;;; ## Basic Usage
+7
;;;
+8
;;; ```scheme
+9
;;; (import (sigil ledger report))
+10
;;;
+11
;;; ;; Get account balances
+12
;;; (hledger-balance "main.journal" "assets")
+13
;;;
+14
;;; ;; Get transaction register
+15
;;; (hledger-register "main.journal" "expenses" begin: "2026-01")
+16
;;;
+17
;;; ;; Income statement
+18
;;; (hledger-income-statement "main.journal" period: "monthly")
+19
;;;
+20
;;; ;; Run any hledger command
+21
;;; (hledger-command "accounts" file: "main.journal")
+22
;;; ```
+23
+24
(define-library (sigil ledger report)
+25
(import (sigil string)
+26
(sigil io)
+27
(sigil process)
+28
(sigil json))
+29
(export
+30
hledger-available?
+31
hledger-command
+32
hledger-balance
+33
hledger-register
+34
hledger-income-statement
+35
hledger-print-json)
+36
+37
(begin
+38
+39
;;; Check if hledger is available on PATH.
+40
(define (hledger-available?)
+41
(command-exists? "hledger"))
+42
+43
(define (ensure-hledger!)
+44
(unless (hledger-available?)
+45
(error "hledger is not installed or not on PATH")))
+46
+47
;;; Run an arbitrary hledger command and return its output as a string.
+48
;;;
+49
;;; The `file:` keyword specifies the journal file.
+50
;;; Additional arguments are passed through to hledger.
+51
;;;
+52
;;; ```scheme
+53
;;; (hledger-command "accounts" file: "main.journal")
+54
;;; ; => "assets:checking\nassets:savings\n..."
+55
;;;
+56
;;; (hledger-command "bal" file: "main.journal" args: '("assets" "--tree"))
+57
;;; ; => balance report as text
+58
;;; ```
+59
(define (hledger-command command (keys: (file #f) (args '())))
+60
(ensure-hledger!)
+61
(let ((cmd-args (if file
+62
(cons command (cons "-f" (cons file args)))
+63
(cons command args))))
+64
(apply process-output->string "hledger" cmd-args)))
+65
+66
;; Internal: run a report command with parsed query/option args
+67
(define (run-report command file rest)
+68
(ensure-hledger!)
+69
(let* ((query-and-opts (parse-report-args rest))
+70
(query (car query-and-opts))
+71
(opts (cdr query-and-opts))
+72
(args (build-report-args command file query opts)))
+73
(apply process-output->string "hledger" args)))
+74
+75
;;; Run `hledger bal` and return the output.
+76
;;;
+77
;;; ```scheme
+78
;;; (hledger-balance "main.journal")
+79
;;; (hledger-balance "main.journal" "assets")
+80
;;; (hledger-balance "main.journal" "expenses"
+81
;;; begin: "2026-01" end: "2026-04" depth: 2 tree: #t)
+82
;;; ```
+83
(define (hledger-balance file . rest)
+84
(run-report "bal" file rest))
+85
+86
;;; Run `hledger reg` and return the output.
+87
;;;
+88
;;; ```scheme
+89
;;; (hledger-register "main.journal" "expenses:food")
+90
;;; (hledger-register "main.journal" begin: "2026-03")
+91
;;; ```
+92
(define (hledger-register file . rest)
+93
(run-report "reg" file rest))
+94
+95
;;; Run `hledger is` (income statement) and return the output.
+96
;;;
+97
;;; ```scheme
+98
;;; (hledger-income-statement "main.journal")
+99
;;; (hledger-income-statement "main.journal" period: "monthly")
+100
;;; ```
+101
(define (hledger-income-statement file . rest)
+102
(run-report "is" file rest))
+103
+104
;;; Run `hledger print -O json` and return parsed JSON.
+105
;;;
+106
;;; Returns the hledger JSON representation of transactions,
+107
;;; parsed into Sigil dicts/arrays.
+108
;;;
+109
;;; ```scheme
+110
;;; (define txns (hledger-print-json "main.journal"))
+111
;;; ```
+112
(define (hledger-print-json file . rest)
+113
(ensure-hledger!)
+114
(let* ((query-and-opts (parse-report-args rest))
+115
(query (car query-and-opts))
+116
(opts (cdr query-and-opts))
+117
(args (build-report-args "print" file query
+118
(cons (cons output-format: "json") opts))))
+119
(let ((output (apply process-output->string "hledger" args)))
+120
(if (string-empty? (string-trim output))
+121
#[]
+122
(json-decode output)))))
+123
+124
;; Parse variadic report arguments into (query . opts) pair
+125
(define (parse-report-args args)
+126
(let loop ((rest args) (query '()) (opts '()))
+127
(if (null? rest)
+128
(cons (reverse query) (reverse opts))
+129
(let ((arg (car rest)))
+130
(cond
+131
((keyword? arg)
+132
(if (null? (cdr rest))
+133
(cons (reverse query) (reverse opts))
+134
(loop (cddr rest) query
+135
(cons (cons arg (cadr rest)) opts))))
+136
((string? arg)
+137
(loop (cdr rest) (cons arg query) opts))
+138
(else
+139
(loop (cdr rest) query opts)))))))
+140
+141
;; Build hledger argument list from parsed report options
+142
(define (build-report-args command file query opts)
+143
(let ((base (list command "-f" file)))
+144
(let ((with-opts (fold-right
+145
(lambda (opt acc)
+146
(let ((key (car opt))
+147
(val (cdr opt)))
+148
(cond
+149
((eq? key begin:)
+150
(cons "-b" (cons val acc)))
+151
((eq? key end:)
+152
(cons "-e" (cons val acc)))
+153
((eq? key period:)
+154
(cons "-p" (cons val acc)))
+155
((eq? key depth:)
+156
(cons "--depth" (cons (if (number? val) (number->string val) val) acc)))
+157
((eq? key tree:)
+158
(if val (cons "--tree" acc) acc))
+159
((eq? key monthly:)
+160
(if val (cons "-M" acc) acc))
+161
((eq? key quarterly:)
+162
(if val (cons "-Q" acc) acc))
+163
((eq? key yearly:)
+164
(if val (cons "-Y" acc) acc))
+165
((eq? key output-format:)
+166
(cons "-O" (cons val acc)))
+167
((eq? key cost:)
+168
(if val (cons "-B" acc) acc))
+169
((eq? key market:)
+170
(if val (cons "-V" acc) acc))
+171
((eq? key exchange:)
+172
(cons "-X" (cons val acc)))
+173
(else acc))))
+174
'()
+175
opts)))
+176
(append base with-opts query))))))
test/test-ledger.sgladded
@@ -0,0 +1,387 @@
+1
;;; Test suite for (sigil ledger)
+2
+3
(import (sigil test)
+4
(sigil string)
+5
(sigil ledger))
+6
+7
;; ========== Transaction Formatting ==========
+8
+9
(test-group "format-transaction - basic"
+10
(test "format simple transaction"
+11
(let ((txn (journal-transaction
+12
date: "2026-03-15"
+13
status: "*"
+14
description: "Grocery store"
+15
postings: (list
+16
(journal-posting
+17
account: "expenses:food:groceries"
+18
amount: (journal-amount quantity: 47.23 commodity: "USD"))
+19
(journal-posting
+20
account: "assets:checking")))))
+21
(assert-equal
+22
"2026-03-15 * Grocery store\n expenses:food:groceries 47.23 USD\n assets:checking"
+23
(format-transaction txn))))
+24
+25
(test "format transaction with pending status"
+26
(let ((txn (journal-transaction
+27
date: "2026-03-15"
+28
status: "!"
+29
description: "Pending purchase"
+30
postings: (list
+31
(journal-posting
+32
account: "expenses:food"
+33
amount: (journal-amount quantity: 10 commodity: "USD"))
+34
(journal-posting
+35
account: "assets:checking")))))
+36
(assert-equal
+37
"2026-03-15 ! Pending purchase\n expenses:food 10.00 USD\n assets:checking"
+38
(format-transaction txn))))
+39
+40
(test "format transaction with no status"
+41
(let ((txn (journal-transaction
+42
date: "2026-03-15"
+43
description: "Some purchase"
+44
postings: (list
+45
(journal-posting
+46
account: "expenses:food"
+47
amount: (journal-amount quantity: 10 commodity: "USD"))
+48
(journal-posting
+49
account: "assets:checking")))))
+50
(assert-equal
+51
"2026-03-15 Some purchase\n expenses:food 10.00 USD\n assets:checking"
+52
(format-transaction txn)))))
+53
+54
(test-group "format-transaction - code and description"
+55
(test "format transaction with code"
+56
(let ((txn (journal-transaction
+57
date: "2026-03-15"
+58
status: "*"
+59
code: "ref-001"
+60
description: "Whole Foods | groceries"
+61
postings: (list
+62
(journal-posting
+63
account: "expenses:food"
+64
amount: (journal-amount quantity: 47.23 commodity: "$"))
+65
(journal-posting
+66
account: "assets:checking")))))
+67
(assert-equal
+68
"2026-03-15 * (ref-001) Whole Foods | groceries\n expenses:food $47.23\n assets:checking"
+69
(format-transaction txn)))))
+70
+71
(test-group "format-transaction - tags"
+72
(test "format transaction with tags"
+73
(let ((txn (journal-transaction
+74
date: "2026-03-15"
+75
status: "*"
+76
description: "Dinner"
+77
tags: (list (cons "trip" "hawaii"))
+78
postings: (list
+79
(journal-posting
+80
account: "expenses:meals"
+81
amount: (journal-amount quantity: 85 commodity: "$"))
+82
(journal-posting
+83
account: "assets:checking")))))
+84
(assert-equal
+85
"2026-03-15 * Dinner\n ; trip: hawaii\n expenses:meals $85.00\n assets:checking"
+86
(format-transaction txn))))
+87
+88
(test "format posting with inline tags"
+89
(let ((txn (journal-transaction
+90
date: "2026-03-15"
+91
status: "*"
+92
description: "Test"
+93
postings: (list
+94
(journal-posting
+95
account: "expenses:food"
+96
amount: (journal-amount quantity: 50 commodity: "USD")
+97
tags: (list (cons "receipt" "scan-001")))
+98
(journal-posting
+99
account: "assets:checking")))))
+100
(assert-equal
+101
"2026-03-15 * Test\n expenses:food 50.00 USD ; receipt: scan-001\n assets:checking"
+102
(format-transaction txn)))))
+103
+104
(test-group "format-transaction - cost notation"
+105
(test "format total cost (@@)"
+106
(let ((txn (journal-transaction
+107
date: "2026-03-15"
+108
status: "*"
+109
description: "Currency conversion"
+110
postings: (list
+111
(journal-posting
+112
account: "assets:wise:eur"
+113
amount: (journal-amount quantity: -500 commodity: "EUR"))
+114
(journal-posting
+115
account: "assets:wise:usd"
+116
amount: (journal-amount quantity: 540 commodity: "USD")
+117
cost: (journal-cost
+118
type: 'total
+119
amount: (journal-amount quantity: 500 commodity: "EUR")))))))
+120
(assert-equal
+121
"2026-03-15 * Currency conversion\n assets:wise:eur -500.00 EUR\n assets:wise:usd 540.00 USD @@ 500.00 EUR"
+122
(format-transaction txn))))
+123
+124
(test "format per-unit cost (@)"
+125
(let ((txn (journal-transaction
+126
date: "2026-03-15"
+127
status: "*"
+128
description: "Currency conversion"
+129
postings: (list
+130
(journal-posting
+131
account: "assets:wise:eur"
+132
amount: (journal-amount quantity: 100 commodity: "EUR")
+133
cost: (journal-cost
+134
type: 'per-unit
+135
amount: (journal-amount quantity: 1.08 commodity: "USD")))
+136
(journal-posting
+137
account: "assets:wise:usd")))))
+138
(assert-equal
+139
"2026-03-15 * Currency conversion\n assets:wise:eur 100.00 EUR @ 1.08 USD\n assets:wise:usd"
+140
(format-transaction txn)))))
+141
+142
(test-group "format-transaction - balance assertions"
+143
(test "format balance assertion"
+144
(let ((txn (journal-transaction
+145
date: "2026-03-15"
+146
status: "*"
+147
description: "Deposit"
+148
postings: (list
+149
(journal-posting
+150
account: "assets:checking"
+151
amount: (journal-amount quantity: 3000 commodity: "$")
+152
balance-assertion: (journal-amount quantity: 5000 commodity: "$"))
+153
(journal-posting
+154
account: "income:salary")))))
+155
(assert-equal
+156
"2026-03-15 * Deposit\n assets:checking $3000.00 = $5000.00\n income:salary"
+157
(format-transaction txn)))))
+158
+159
(test-group "format-transactions"
+160
(test "format multiple transactions"
+161
(let ((txns (list
+162
(journal-transaction
+163
date: "2026-03-15"
+164
status: "*"
+165
description: "Groceries"
+166
postings: (list
+167
(journal-posting
+168
account: "expenses:food"
+169
amount: (journal-amount quantity: 47.23 commodity: "USD"))
+170
(journal-posting
+171
account: "assets:checking")))
+172
(journal-transaction
+173
date: "2026-03-16"
+174
status: "*"
+175
description: "Gas"
+176
postings: (list
+177
(journal-posting
+178
account: "expenses:transport"
+179
amount: (journal-amount quantity: 30 commodity: "USD"))
+180
(journal-posting
+181
account: "assets:checking"))))))
+182
(assert-equal
+183
"2026-03-15 * Groceries\n expenses:food 47.23 USD\n assets:checking\n\n2026-03-16 * Gas\n expenses:transport 30.00 USD\n assets:checking"
+184
(format-transactions txns)))))
+185
+186
;; ========== Journal Parsing ==========
+187
+188
(test-group "parse-journal - basic"
+189
(test "parse simple transaction"
+190
(let* ((text "2026-03-15 * Grocery store\n expenses:food $47.23\n assets:checking\n")
+191
(txns (parse-journal text)))
+192
(assert-equal 1 (length txns))
+193
(let ((txn (car txns)))
+194
(assert-equal "2026-03-15" (journal-transaction-date txn))
+195
(assert-equal "*" (journal-transaction-status txn))
+196
(assert-equal "Grocery store" (journal-transaction-description txn))
+197
(assert-equal 2 (length (journal-transaction-postings txn))))))
+198
+199
(test "parse transaction with pending status"
+200
(let* ((text "2026-03-15 ! Pending purchase\n expenses:food $10.00\n assets:checking\n")
+201
(txns (parse-journal text)))
+202
(assert-equal "!" (journal-transaction-status (car txns)))))
+203
+204
(test "parse transaction with no status"
+205
(let* ((text "2026-03-15 Some purchase\n expenses:food $10.00\n assets:checking\n")
+206
(txns (parse-journal text)))
+207
(assert-equal "" (journal-transaction-status (car txns)))
+208
(assert-equal "Some purchase" (journal-transaction-description (car txns)))))
+209
+210
(test "parse transaction with code"
+211
(let* ((text "2026-03-15 * (ref-001) Whole Foods\n expenses:food $47.23\n assets:checking\n")
+212
(txns (parse-journal text)))
+213
(let ((txn (car txns)))
+214
(assert-equal "ref-001" (journal-transaction-code txn))
+215
(assert-equal "Whole Foods" (journal-transaction-description txn)))))
+216
+217
(test "parse multiple transactions"
+218
(let* ((text (str "2026-03-15 * Groceries\n"
+219
" expenses:food $47.23\n"
+220
" assets:checking\n"
+221
"\n"
+222
"2026-03-16 * Gas\n"
+223
" expenses:transport $30.00\n"
+224
" assets:checking\n"))
+225
(txns (parse-journal text)))
+226
(assert-equal 2 (length txns))
+227
(assert-equal "Groceries" (journal-transaction-description (car txns)))
+228
(assert-equal "Gas" (journal-transaction-description (cadr txns))))))
+229
+230
(test-group "parse-journal - amounts"
+231
(test "parse left-symbol commodity"
+232
(let* ((text "2026-03-15 * Test\n expenses:food $47.23\n assets:checking\n")
+233
(txns (parse-journal text))
+234
(posting (car (journal-transaction-postings (car txns)))))
+235
(assert-equal "$" (journal-amount-commodity (journal-posting-amount posting)))
+236
(assert-equal 47.23 (journal-amount-quantity (journal-posting-amount posting)))))
+237
+238
(test "parse right-symbol commodity"
+239
(let* ((text "2026-03-15 * Test\n assets:wise:eur 100.00 EUR\n assets:checking\n")
+240
(txns (parse-journal text))
+241
(posting (car (journal-transaction-postings (car txns)))))
+242
(assert-equal "EUR" (journal-amount-commodity (journal-posting-amount posting)))
+243
(assert-equal 100.0 (journal-amount-quantity (journal-posting-amount posting)))))
+244
+245
(test "parse negative amount"
+246
(let* ((text "2026-03-15 * Test\n assets:wise:eur -500.00 EUR\n assets:checking\n")
+247
(txns (parse-journal text))
+248
(posting (car (journal-transaction-postings (car txns)))))
+249
(assert-equal -500.0 (journal-amount-quantity (journal-posting-amount posting)))))
+250
+251
(test "parse inferred amount posting"
+252
(let* ((text "2026-03-15 * Test\n expenses:food $50.00\n assets:checking\n")
+253
(txns (parse-journal text))
+254
(posting (cadr (journal-transaction-postings (car txns)))))
+255
(assert-false (journal-posting-amount posting)))))
+256
+257
(test-group "parse-journal - cost notation"
+258
(test "parse per-unit cost"
+259
(let* ((text "2026-03-15 * Test\n assets:wise:eur 100.00 EUR @ 1.08 USD\n assets:wise:usd\n")
+260
(txns (parse-journal text))
+261
(posting (car (journal-transaction-postings (car txns))))
+262
(cost (journal-posting-cost posting)))
+263
(assert-true (journal-cost? cost))
+264
(assert-equal 'per-unit (journal-cost-type cost))
+265
(assert-equal 1.08 (journal-amount-quantity (journal-cost-amount cost)))
+266
(assert-equal "USD" (journal-amount-commodity (journal-cost-amount cost)))))
+267
+268
(test "parse total cost"
+269
(let* ((text "2026-03-15 * Test\n assets:wise:usd 540.00 USD @@ 500.00 EUR\n assets:wise:eur\n")
+270
(txns (parse-journal text))
+271
(posting (car (journal-transaction-postings (car txns))))
+272
(cost (journal-posting-cost posting)))
+273
(assert-true (journal-cost? cost))
+274
(assert-equal 'total (journal-cost-type cost))
+275
(assert-equal 500.0 (journal-amount-quantity (journal-cost-amount cost)))
+276
(assert-equal "EUR" (journal-amount-commodity (journal-cost-amount cost))))))
+277
+278
(test-group "parse-journal - comments and tags"
+279
(test "parse transaction with tag comment"
+280
(let* ((text "2026-03-15 * Dinner\n ; trip: hawaii\n expenses:meals $85.00\n assets:checking\n")
+281
(txns (parse-journal text))
+282
(txn (car txns))
+283
(tags (journal-transaction-tags txn)))
+284
(assert-equal 1 (length tags))
+285
(assert-equal "trip" (caar tags))
+286
(assert-equal "hawaii" (cdar tags))))
+287
+288
(test "parse posting with inline comment"
+289
(let* ((text "2026-03-15 * Test\n expenses:food $50.00 ; receipt: scan-001\n assets:checking\n")
+290
(txns (parse-journal text))
+291
(posting (car (journal-transaction-postings (car txns)))))
+292
(assert-equal 1 (length (journal-posting-tags posting)))
+293
(assert-equal "receipt" (caar (journal-posting-tags posting)))
+294
(assert-equal "scan-001" (cdar (journal-posting-tags posting))))))
+295
+296
(test-group "parse-journal - balance assertions"
+297
(test "parse balance assertion"
+298
(let* ((text "2026-03-15 * Deposit\n assets:checking $3000.00 = $5000.00\n income:salary\n")
+299
(txns (parse-journal text))
+300
(posting (car (journal-transaction-postings (car txns))))
+301
(bal (journal-posting-balance-assertion posting)))
+302
(assert-true (journal-amount? bal))
+303
(assert-equal 5000.0 (journal-amount-quantity bal))
+304
(assert-equal "$" (journal-amount-commodity bal)))))
+305
+306
;; ========== Round-trip Tests ==========
+307
+308
(test-group "round-trip"
+309
(test "parse and re-format simple transaction"
+310
(let* ((original (str "2026-03-15 * Grocery store\n"
+311
" expenses:food:groceries 47.23 USD\n"
+312
" assets:checking"))
+313
(txns (parse-journal (str original "\n")))
+314
(formatted (format-transaction (car txns))))
+315
(assert-equal original formatted)))
+316
+317
(test "parse and re-format transaction with cost"
+318
(let* ((original (str "2026-03-15 * Currency conversion\n"
+319
" assets:wise:eur -500.00 EUR\n"
+320
" assets:wise:usd 540.00 USD @@ 500.00 EUR"))
+321
(txns (parse-journal (str original "\n")))
+322
(formatted (format-transaction (car txns))))
+323
(assert-equal original formatted)))
+324
+325
(test "parse and re-format multiple transactions"
+326
(let* ((original (str "2026-03-15 * Groceries\n"
+327
" expenses:food 47.23 USD\n"
+328
" assets:checking\n"
+329
"\n"
+330
"2026-03-16 * Gas\n"
+331
" expenses:transport 30.00 USD\n"
+332
" assets:checking"))
+333
(txns (parse-journal (str original "\n")))
+334
(formatted (format-transactions txns)))
+335
(assert-equal original formatted))))
+336
+337
;; ========== Deduplication ==========
+338
+339
(test-group "deduplicate-transactions"
+340
(test "filter out duplicate by ref tag"
+341
(let* ((existing (list
+342
(journal-transaction
+343
date: "2026-03-15"
+344
status: "*"
+345
description: "Existing"
+346
tags: (list (cons "ref" "TRF-001"))
+347
postings: (list
+348
(journal-posting account: "expenses:food"
+349
amount: (journal-amount quantity: 50 commodity: "USD"))
+350
(journal-posting account: "assets:checking")))))
+351
(new-txns (list
+352
(journal-transaction
+353
date: "2026-03-16"
+354
status: "*"
+355
description: "Already imported"
+356
tags: (list (cons "ref" "TRF-001"))
+357
postings: (list
+358
(journal-posting account: "expenses:food"
+359
amount: (journal-amount quantity: 50 commodity: "USD"))
+360
(journal-posting account: "assets:checking")))
+361
(journal-transaction
+362
date: "2026-03-17"
+363
status: "*"
+364
description: "New one"
+365
tags: (list (cons "ref" "TRF-002"))
+366
postings: (list
+367
(journal-posting account: "expenses:food"
+368
amount: (journal-amount quantity: 30 commodity: "USD"))
+369
(journal-posting account: "assets:checking")))))
+370
(result (deduplicate-transactions new-txns existing)))
+371
(assert-equal 1 (length result))
+372
(assert-equal "New one" (journal-transaction-description (car result)))))
+373
+374
(test "keep transactions without ref"
+375
(let* ((existing '())
+376
(new-txns (list
+377
(journal-transaction
+378
date: "2026-03-15"
+379
description: "No ref"
+380
postings: (list
+381
(journal-posting account: "expenses:misc"
+382
amount: (journal-amount quantity: 10 commodity: "USD"))
+383
(journal-posting account: "assets:checking")))))
+384
(result (deduplicate-transactions new-txns existing)))
+385
(assert-equal 1 (length result)))))
+386
+387
(run-tests)