Commit9bed4e6eRecorded26 Feb 2026Repositorysigil-yaml

Add sigil-yaml package for YAML parsing and serialization

Message

Hand-written recursive descent parser supporting block/flow mappings and sequences, scalar type resolution, quoted strings, block literal and folded scalars with chomping, multi-document, and anchors/aliases. Writer supports block and flow output styles with smart string quoting.

Changed
 CHANGELOG.md       |   16 +++
 docs/yaml.md       |  207 ++++++++++++++++++++++++++++
 package.sgl        |   14 ++
 src/sigil/yaml.sgl | 1290 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-yaml.sgl |  389 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 1916 insertions(+)
Diff
CHANGELOG.mdadded
@@ -0,0 +1,16 @@
+1
# sigil-yaml
+2
+3
## 0.7.0
+4
+5
### Features
+6
+7
- YAML parsing with automatic scalar type resolution (strings, integers, floats, booleans, null, hex, octal, infinity, NaN)
+8
- Block mappings and sequences with arbitrary nesting
+9
- Flow (inline) mappings `{key: value}` and sequences `[1, 2, 3]`
+10
- Quoted strings (single and double) with escape sequences
+11
- Block literal (`|`) and folded (`>`) scalars with chomping indicators
+12
- Multi-document support (`---`/`...` markers)
+13
- Anchors (`&name`) and aliases (`*name`)
+14
- Comment handling (full-line and inline)
+15
- YAML serialization in block and flow styles
+16
- Smart string quoting in output
docs/yaml.mdadded
@@ -0,0 +1,207 @@
+1
# (sigil yaml)
+2
+3
YAML parsing and serialization for Sigil applications.
+4
+5
## Type Mapping
+6
+7
| YAML | Scheme |
+8
|-----------|------------------------------------|
+9
| mapping | dict: `#{ name: "Alice" }` |
+10
| sequence | list: `("apple" "banana")` |
+11
| string | string: `"hello"` |
+12
| integer | integer: `42` |
+13
| float | float: `3.14` |
+14
| true/false| `#t` / `#f` |
+15
| null | `'null` symbol |
+16
+17
## Quick Start
+18
+19
```scheme
+20
(import (sigil yaml))
+21
+22
;; Decode YAML strings
+23
(yaml-decode "name: Alice\nage: 30")
+24
; => #{ name: "Alice" age: 30 }
+25
+26
(yaml-decode "- apple\n- banana\n- cherry")
+27
; => ("apple" "banana" "cherry")
+28
+29
;; Encode Scheme values to YAML
+30
(yaml-encode #{ name: "Alice" age: 30 })
+31
; => "name: Alice\nage: 30\n"
+32
+33
(yaml-encode '(1 2 3))
+34
; => "- 1\n- 2\n- 3\n"
+35
```
+36
+37
## Reading and Writing
+38
+39
### String Convenience Functions
+40
+41
```scheme
+42
;; Decode a YAML string
+43
(yaml-decode "key: value") ; => #{ key: "value" }
+44
+45
;; Encode to YAML string
+46
(yaml-encode #{ key: "value" }) ; => "key: value\n"
+47
+48
;; Flow (inline) style
+49
(yaml-encode #{ a: 1 b: 2 } flow: #t) ; => "{a: 1, b: 2}"
+50
```
+51
+52
### Port-Based I/O
+53
+54
```scheme
+55
;; Write YAML to a file
+56
(call-with-output-file "config.yaml"
+57
(lambda (port)
+58
(yaml-write #{ name: "Alice" age: 30 } port)))
+59
+60
;; Read YAML from a file
+61
(call-with-input-file "config.yaml" yaml-read)
+62
; => #{ name: "Alice" age: 30 }
+63
```
+64
+65
## Scalars
+66
+67
YAML scalars are automatically resolved to Scheme types:
+68
+69
```scheme
+70
(yaml-decode "42") ; => 42 (integer)
+71
(yaml-decode "3.14") ; => 3.14 (float)
+72
(yaml-decode "0xFF") ; => 255 (hex integer)
+73
(yaml-decode "0o10") ; => 8 (octal integer)
+74
(yaml-decode "true") ; => #t
+75
(yaml-decode "false") ; => #f
+76
(yaml-decode "null") ; => 'null
+77
(yaml-decode "~") ; => 'null
+78
(yaml-decode ".inf") ; => +infinity
+79
(yaml-decode ".nan") ; => NaN
+80
(yaml-decode "hello") ; => "hello" (string)
+81
```
+82
+83
### Quoted Strings
+84
+85
```scheme
+86
;; Double-quoted (supports escape sequences)
+87
(yaml-decode "\"line1\\nline2\"") ; => "line1\nline2"
+88
+89
;; Single-quoted (no escapes except '')
+90
(yaml-decode "'it''s here'") ; => "it's here"
+91
+92
;; Quoted strings preserve literal values
+93
(yaml-decode "\"true\"") ; => "true" (string, not boolean)
+94
(yaml-decode "'null'") ; => "null" (string, not null)
+95
```
+96
+97
## Collections
+98
+99
### Block Mappings
+100
+101
```scheme
+102
(yaml-decode "name: Alice\nage: 30")
+103
; => #{ name: "Alice" age: 30 }
+104
+105
;; Nested
+106
(yaml-decode "server:\n host: localhost\n port: 8080")
+107
; => #{ server: #{ host: "localhost" port: 8080 } }
+108
```
+109
+110
### Block Sequences
+111
+112
```scheme
+113
(yaml-decode "- apple\n- banana\n- cherry")
+114
; => ("apple" "banana" "cherry")
+115
+116
;; Sequence of mappings
+117
(yaml-decode "- name: Alice\n age: 30\n- name: Bob\n age: 25")
+118
; => (#{ name: "Alice" age: 30 } #{ name: "Bob" age: 25 })
+119
```
+120
+121
### Flow Collections
+122
+123
```scheme
+124
;; Inline sequence
+125
(yaml-decode "[1, 2, 3]")
+126
; => (1 2 3)
+127
+128
;; Inline mapping
+129
(yaml-decode "{name: Alice, age: 30}")
+130
; => #{ name: "Alice" age: 30 }
+131
+132
;; Mixed with block style
+133
(yaml-decode "items: [1, 2, 3]\npoint: {x: 10, y: 20}")
+134
; => #{ items: (1 2 3) point: #{ x: 10 y: 20 } }
+135
```
+136
+137
## Block Scalars
+138
+139
### Literal (`|`) - preserves newlines
+140
+141
```scheme
+142
(yaml-decode "text: |\n line 1\n line 2\n line 3")
+143
; text => "line 1\nline 2\nline 3\n"
+144
```
+145
+146
### Folded (`>`) - joins lines with spaces
+147
+148
```scheme
+149
(yaml-decode "text: >\n long line\n continues here")
+150
; text => "long line continues here\n"
+151
```
+152
+153
### Chomping Indicators
+154
+155
```scheme
+156
;; Strip (-) removes all trailing newlines
+157
(yaml-decode "text: |-\n hello") ; text => "hello"
+158
+159
;; Keep (+) preserves trailing newlines
+160
(yaml-decode "text: |+\n hello\n\nnext: val") ; text => "hello\n\n"
+161
+162
;; Clip (default) keeps one trailing newline
+163
(yaml-decode "text: |\n hello") ; text => "hello\n"
+164
```
+165
+166
## Multi-Document
+167
+168
```scheme
+169
;; Read all documents
+170
(yaml-decode-all "---\na: 1\n---\nb: 2")
+171
; => (#{ a: 1 } #{ b: 2 })
+172
+173
;; yaml-read / yaml-decode only reads the first document
+174
(yaml-decode "---\na: 1\n---\nb: 2")
+175
; => #{ a: 1 }
+176
```
+177
+178
## Anchors and Aliases
+179
+180
```scheme
+181
(yaml-decode "defaults: &def\n color: red\n size: large\nref: *def")
+182
; => #{ defaults: #{ color: "red" size: "large" }
+183
; ref: #{ color: "red" size: "large" } }
+184
```
+185
+186
## Null Handling
+187
+188
Use `yaml-null?` to distinguish null from `#f`:
+189
+190
```scheme
+191
(yaml-null? (yaml-decode "null")) ; => #t
+192
(yaml-null? (yaml-decode "~")) ; => #t
+193
(yaml-null? (yaml-decode "false")) ; => #f
+194
(yaml-null? #f) ; => #f
+195
```
+196
+197
## API Reference
+198
+199
| Procedure | Signature | Description |
+200
|-----------|-----------|-------------|
+201
| `yaml-read` | `(port) -> any` | Read one YAML document from a port |
+202
| `yaml-write` | `(value port [indent: N] [flow: bool]) -> void` | Write YAML to a port |
+203
| `yaml-decode` | `(string) -> any` | Decode a YAML string |
+204
| `yaml-encode` | `(value [indent: N] [flow: bool]) -> string` | Encode a value as YAML |
+205
| `yaml-read-all` | `(port) -> list` | Read all documents from a port |
+206
| `yaml-decode-all` | `(string) -> list` | Decode all documents from a string |
+207
| `yaml-null?` | `(value) -> boolean` | Check if value is YAML null |
package.sgladded
@@ -0,0 +1,14 @@
+1
;;; sigil-yaml - YAML parsing and serialization
+2
;;;
+3
;;; Provides YAML parsing and serialization for Sigil applications.
+4
+5
(package
+6
name: "sigil-yaml"
+7
version: "0.7.0"
+8
description: "YAML parsing and serialization for Sigil"
+9
url: "https://codeberg.org/sigil/sigil"
+10
license: "BSD-3-Clause"
+11
authors: (list "David Wilson <[email protected]>")
+12
+13
dependencies: (list
+14
(from-workspace name: "sigil-stdlib")))
src/sigil/yaml.sgladded
@@ -0,0 +1,1290 @@
+1
;;; (sigil yaml) - YAML Parsing and Serialization
+2
;;;
+3
;;; Streaming YAML encoding and decoding for Sigil. Provides bidirectional
+4
;;; conversion between YAML and native Scheme data structures using ports
+5
;;; for composability with files and other I/O.
+6
;;;
+7
;;; ## Type Mapping
+8
;;;
+9
;;; | YAML | Scheme |
+10
;;; |-----------|--------------------------------------------------|
+11
;;; | mapping | dict: `#{ name: "Alice" }` |
+12
;;; | sequence | list: `(1 2 3)` |
+13
;;; | string | string: `"hello"` |
+14
;;; | integer | integer: `42` |
+15
;;; | float | float: `3.14` |
+16
;;; | true | `#t` |
+17
;;; | false | `#f` |
+18
;;; | null | `'null` symbol |
+19
;;;
+20
;;; ## Basic Usage
+21
;;;
+22
;;; ```scheme
+23
;;; (import (sigil yaml))
+24
;;;
+25
;;; ;; Decode YAML string
+26
;;; (yaml-decode "name: Alice\nage: 30")
+27
;;; ; => #{ name: "Alice" age: 30 }
+28
;;;
+29
;;; ;; Encode to YAML
+30
;;; (yaml-encode #{ name: "Alice" age: 30 })
+31
;;; ; => "name: Alice\nage: 30\n"
+32
;;;
+33
;;; ;; Decode a sequence
+34
;;; (yaml-decode "- apple\n- banana\n- cherry")
+35
;;; ; => ("apple" "banana" "cherry")
+36
;;; ```
+37
;;;
+38
;;; ## Port-Based I/O
+39
;;;
+40
;;; ```scheme
+41
;;; ;; Write YAML to a file
+42
;;; (call-with-output-file "config.yaml"
+43
;;; (lambda (port)
+44
;;; (yaml-write #{ name: "Alice" } port)))
+45
;;;
+46
;;; ;; Read YAML from a file
+47
;;; (call-with-input-file "config.yaml" yaml-read)
+48
;;; ```
+49
;;;
+50
;;; ## Multi-Document
+51
;;;
+52
;;; ```scheme
+53
;;; (yaml-decode-all "---\na: 1\n---\nb: 2")
+54
;;; ; => (#{ a: 1 } #{ b: 2 })
+55
;;; ```
+56
+57
(define-library (sigil yaml)
+58
(import (sigil string)
+59
(sigil io)
+60
(sigil math))
+61
(export
+62
;; Port-based I/O
+63
yaml-read
+64
yaml-write
+65
+66
;; String conversion
+67
yaml-encode
+68
yaml-decode
+69
+70
;; Multi-document
+71
yaml-read-all
+72
yaml-decode-all
+73
+74
;; Utilities
+75
yaml-null?)
+76
+77
(begin
+78
+79
;; ============================================================
+80
;; Parser State
+81
;; ============================================================
+82
+83
;; Parser state is a mutable vector:
+84
;; #(port lines line-index anchors)
+85
;; - port: input port (for error reporting)
+86
;; - lines: vector of all lines read from input
+87
;; - line-index: current line index (mutable via vector-set!)
+88
;; - anchors: alist of anchor-name -> value
+89
+90
(define (make-parser port)
+91
(let ((all-lines (read-all-lines port)))
+92
(vector all-lines 0 '())))
+93
+94
(define (parser-lines p) (vector-ref p 0))
+95
(define (parser-index p) (vector-ref p 1))
+96
(define (parser-anchors p) (vector-ref p 2))
+97
+98
(define (parser-set-index! p i) (vector-set! p 1 i))
+99
(define (parser-set-anchors! p a) (vector-set! p 2 a))
+100
+101
(define (parser-at-end? p)
+102
(>= (parser-index p) (vector-length (parser-lines p))))
+103
+104
(define (parser-current-line p)
+105
(if (parser-at-end? p)
+106
#f
+107
(vector-ref (parser-lines p) (parser-index p))))
+108
+109
(define (parser-advance! p)
+110
(parser-set-index! p (+ (parser-index p) 1)))
+111
+112
;; Read all lines from port into a vector
+113
(define (read-all-lines port)
+114
(let loop ((lines '()))
+115
(let ((line (read-line port)))
+116
(if (eof-object? line)
+117
(list->vector (reverse lines))
+118
(loop (cons line lines))))))
+119
+120
;; ============================================================
+121
;; Line Utilities
+122
;; ============================================================
+123
+124
;; Count leading spaces in a string
+125
(define (count-indent line)
+126
(let ((len (string-length line)))
+127
(let loop ((i 0))
+128
(if (and (< i len) (char=? (string-ref line i) #\space))
+129
(loop (+ i 1))
+130
i))))
+131
+132
;; Strip content portion of line (after indent)
+133
(define (line-content line)
+134
(substring line (count-indent line) (string-length line)))
+135
+136
;; Strip trailing comment from a string (outside of quotes)
+137
(define (strip-comment str)
+138
(let ((len (string-length str)))
+139
(let loop ((i 0) (in-single #f) (in-double #f))
+140
(cond
+141
((>= i len) str)
+142
((and in-single (char=? (string-ref str i) #\'))
+143
(loop (+ i 1) #f in-double))
+144
((and in-double (char=? (string-ref str i) #\"))
+145
(loop (+ i 1) in-single #f))
+146
(in-single (loop (+ i 1) in-single in-double))
+147
(in-double (loop (+ i 1) in-single in-double))
+148
((char=? (string-ref str i) #\')
+149
(loop (+ i 1) #t in-double))
+150
((char=? (string-ref str i) #\")
+151
(loop (+ i 1) in-single #t))
+152
((and (char=? (string-ref str i) #\#)
+153
(> i 0)
+154
(char=? (string-ref str (- i 1)) #\space))
+155
(string-trim-end (substring str 0 (- i 1))))
+156
(else (loop (+ i 1) in-single in-double))))))
+157
+158
;; Check if line is blank or comment-only
+159
(define (blank-or-comment? line)
+160
(let ((trimmed (string-trim line)))
+161
(or (string-empty? trimmed)
+162
(char=? (string-ref trimmed 0) #\#))))
+163
+164
;; Skip blank lines and comment lines, return next content line index
+165
(define (skip-blank-and-comments! p)
+166
(let loop ()
+167
(when (not (parser-at-end? p))
+168
(let ((line (parser-current-line p)))
+169
(when (blank-or-comment? line)
+170
(parser-advance! p)
+171
(loop))))))
+172
+173
;; ============================================================
+174
;; Scalar Type Resolution
+175
;; ============================================================
+176
+177
;; Resolve a plain scalar string to its typed value
+178
(define (resolve-scalar str)
+179
(cond
+180
;; Null
+181
((or (string=? str "null") (string=? str "Null")
+182
(string=? str "NULL") (string=? str "~")
+183
(string-empty? str))
+184
'null)
+185
;; Boolean true
+186
((or (string=? str "true") (string=? str "True") (string=? str "TRUE"))
+187
#t)
+188
;; Boolean false
+189
((or (string=? str "false") (string=? str "False") (string=? str "FALSE"))
+190
#f)
+191
;; Special floats
+192
((or (string=? str ".inf") (string=? str ".Inf") (string=? str ".INF"))
+193
(expt 10.0 400))
+194
((or (string=? str "-.inf") (string=? str "-.Inf") (string=? str "-.INF"))
+195
(- (expt 10.0 400)))
+196
((or (string=? str ".nan") (string=? str ".NaN") (string=? str ".NAN"))
+197
(- (expt 10.0 400) (expt 10.0 400)))
+198
;; Try numeric parsing
+199
(else
+200
(or (try-parse-number str)
+201
str))))
+202
+203
;; Try to parse a string as a number (integer, hex, octal, float)
+204
(define (try-parse-number str)
+205
(let ((len (string-length str)))
+206
(cond
+207
((= len 0) #f)
+208
;; Hex: 0x...
+209
((and (>= len 3)
+210
(char=? (string-ref str 0) #\0)
+211
(or (char=? (string-ref str 1) #\x)
+212
(char=? (string-ref str 1) #\X)))
+213
(string->number (substring str 2 len) 16))
+214
;; Octal: 0o...
+215
((and (>= len 3)
+216
(char=? (string-ref str 0) #\0)
+217
(or (char=? (string-ref str 1) #\o)
+218
(char=? (string-ref str 1) #\O)))
+219
(string->number (substring str 2 len) 8))
+220
;; Regular number (integer or float)
+221
(else
+222
(let ((s (if (and (> len 0) (char=? (string-ref str 0) #\+))
+223
(substring str 1 len)
+224
str)))
+225
;; Reject strings with underscores for now (YAML allows _ in numbers)
+226
;; Also reject strings that are just a sign
+227
(and (> (string-length s) 0)
+228
(let ((first (string-ref s 0)))
+229
(or (char-numeric? first)
+230
(char=? first #\-)
+231
(char=? first #\.)))
+232
(string->number s)))))))
+233
+234
;; ============================================================
+235
;; Quoted String Parsing
+236
;; ============================================================
+237
+238
;; Parse a double-quoted string value (input is the full quoted string including quotes)
+239
(define (parse-double-quoted str)
+240
(let ((len (string-length str)))
+241
(if (< len 2)
+242
str
+243
(let loop ((i 1) (chars '()))
+244
(cond
+245
((>= i len) (list->string (reverse chars)))
+246
((char=? (string-ref str i) #\")
+247
(list->string (reverse chars)))
+248
((char=? (string-ref str i) #\\)
+249
(if (>= (+ i 1) len)
+250
(list->string (reverse chars))
+251
(let ((next (string-ref str (+ i 1))))
+252
(loop (+ i 2)
+253
(cons (case next
+254
((#\n) #\newline)
+255
((#\t) #\tab)
+256
((#\r) #\return)
+257
((#\\) #\\)
+258
((#\") #\")
+259
((#\/) #\/)
+260
((#\0) (integer->char 0))
+261
((#\a) #\alarm)
+262
((#\b) #\backspace)
+263
((#\e) #\escape)
+264
((#\space) #\space)
+265
(else next))
+266
chars)))))
+267
(else
+268
(loop (+ i 1) (cons (string-ref str i) chars))))))))
+269
+270
;; Parse a single-quoted string value (input is the full quoted string including quotes)
+271
(define (parse-single-quoted str)
+272
(let ((len (string-length str)))
+273
(if (< len 2)
+274
str
+275
(let loop ((i 1) (chars '()))
+276
(cond
+277
((>= i len) (list->string (reverse chars)))
+278
((char=? (string-ref str i) #\')
+279
;; Check for escaped single quote ('')
+280
(if (and (< (+ i 1) len) (char=? (string-ref str (+ i 1)) #\'))
+281
(loop (+ i 2) (cons #\' chars))
+282
(list->string (reverse chars))))
+283
(else
+284
(loop (+ i 1) (cons (string-ref str i) chars))))))))
+285
+286
;; Check if a string starts with a quote character
+287
(define (quoted-string? str)
+288
(and (> (string-length str) 0)
+289
(let ((c (string-ref str 0)))
+290
(or (char=? c #\") (char=? c #\')))))
+291
+292
;; Parse a quoted string (dispatches to single or double)
+293
(define (parse-quoted-string str)
+294
(if (char=? (string-ref str 0) #\")
+295
(parse-double-quoted str)
+296
(parse-single-quoted str)))
+297
+298
;; ============================================================
+299
;; Anchor and Alias Support
+300
;; ============================================================
+301
+302
;; Store an anchor value
+303
(define (parser-set-anchor! p name value)
+304
(parser-set-anchors! p (cons (cons name value) (parser-anchors p))))
+305
+306
;; Look up an anchor value
+307
(define (parser-get-anchor p name)
+308
(let ((pair (assoc name (parser-anchors p))))
+309
(if pair
+310
(cdr pair)
+311
(error (format "Unknown YAML anchor: ~a" name)))))
+312
+313
;; Check if string starts with anchor (&name)
+314
(define (has-anchor? str)
+315
(and (> (string-length str) 0)
+316
(char=? (string-ref str 0) #\&)))
+317
+318
;; Check if string is an alias (*name)
+319
(define (is-alias? str)
+320
(and (> (string-length str) 0)
+321
(char=? (string-ref str 0) #\*)))
+322
+323
;; Extract anchor name and remaining content from a string like "&name value"
+324
(define (extract-anchor str)
+325
(let ((len (string-length str)))
+326
(let loop ((i 1))
+327
(if (or (>= i len)
+328
(char=? (string-ref str i) #\space)
+329
(char=? (string-ref str i) #\:))
+330
(let ((name (substring str 1 i))
+331
(rest (if (and (< i len) (char=? (string-ref str i) #\space))
+332
(string-trim (substring str (+ i 1) len))
+333
(if (< i len)
+334
(substring str i len)
+335
""))))
+336
(values name rest))
+337
(loop (+ i 1))))))
+338
+339
;; Extract alias name
+340
(define (extract-alias str)
+341
(let ((len (string-length str)))
+342
(let loop ((i 1))
+343
(if (or (>= i len)
+344
(char=? (string-ref str i) #\space)
+345
(char=? (string-ref str i) #\,)
+346
(char=? (string-ref str i) #\})
+347
(char=? (string-ref str i) #\]))
+348
(substring str 1 i)
+349
(loop (+ i 1))))))
+350
+351
;; ============================================================
+352
;; Block Scalar Parsing (| and >)
+353
;; ============================================================
+354
+355
;; Parse a block scalar (literal | or folded >)
+356
;; indicator is the first character of the value string (| or >)
+357
;; header is the full header string after the indicator (e.g., "-", "+", "2", etc.)
+358
(define (parse-block-scalar p indicator header base-indent)
+359
(let* ((literal? (char=? indicator #\|))
+360
(header-trimmed (strip-comment (string-trim header)))
+361
;; Parse chomping indicator
+362
(chomp (cond
+363
((string-contains? header-trimmed "-") 'strip)
+364
((string-contains? header-trimmed "+") 'keep)
+365
(else 'clip)))
+366
;; Collect lines for the block
+367
(lines-list (collect-block-scalar-lines p base-indent))
+368
;; Determine content indent from first non-empty line
+369
(content-indent (find-content-indent lines-list base-indent)))
+370
(if (null? lines-list)
+371
""
+372
(let* (;; Strip the content indent from each line
+373
(stripped (map (lambda (line)
+374
(if (string-blank? line)
+375
""
+376
(let ((indent (count-indent line)))
+377
(if (>= indent content-indent)
+378
(substring line content-indent (string-length line))
+379
line))))
+380
lines-list))
+381
;; Build the content string based on style
+382
(content (if literal?
+383
(build-literal-content stripped)
+384
(build-folded-content stripped))))
+385
;; Apply chomping
+386
(apply-chomping content chomp)))))
+387
+388
;; Collect lines that belong to a block scalar
+389
(define (collect-block-scalar-lines p base-indent)
+390
(let loop ((lines '()) (saw-content #f))
+391
(if (parser-at-end? p)
+392
(reverse lines)
+393
(let* ((line (parser-current-line p))
+394
(trimmed (string-trim line)))
+395
(cond
+396
;; Empty/blank line - include it (may be in middle of block)
+397
((string-blank? trimmed)
+398
(parser-advance! p)
+399
(loop (cons line lines) saw-content))
+400
;; Content line - check indent
+401
(else
+402
(let ((indent (count-indent line)))
+403
(if (> indent base-indent)
+404
(begin
+405
(parser-advance! p)
+406
(loop (cons line lines) #t))
+407
;; Line at or before base indent - stop
+408
(reverse lines)))))))))
+409
+410
;; Find the content indent level from first non-empty line
+411
(define (find-content-indent lines base-indent)
+412
(let loop ((ls lines))
+413
(if (null? ls)
+414
(+ base-indent 2) ; default
+415
(let ((line (car ls)))
+416
(if (string-blank? line)
+417
(loop (cdr ls))
+418
(count-indent line))))))
+419
+420
;; Build literal block content (preserve newlines)
+421
(define (build-literal-content lines)
+422
(let loop ((ls lines) (parts '()) (first #t))
+423
(if (null? ls)
+424
(apply string-append (reverse parts))
+425
(loop (cdr ls)
+426
(cons (if first
+427
(car ls)
+428
(string-append "\n" (car ls)))
+429
parts)
+430
#f))))
+431
+432
;; Build folded block content (fold newlines to spaces, preserve double newlines)
+433
(define (build-folded-content lines)
+434
(let loop ((ls lines) (parts '()) (prev-empty #f) (first #t))
+435
(if (null? ls)
+436
(apply string-append (reverse parts))
+437
(let ((line (car ls)))
+438
(cond
+439
((string-empty? line)
+440
(loop (cdr ls) parts #t first))
+441
(first
+442
(loop (cdr ls) (cons line parts) #f #f))
+443
(prev-empty
+444
(loop (cdr ls) (cons (string-append "\n\n" line) parts) #f #f))
+445
;; Indented lines get preserved as-is in folded mode
+446
((and (> (string-length line) 0) (char=? (string-ref line 0) #\space))
+447
(loop (cdr ls) (cons (string-append "\n" line) parts) #f #f))
+448
(else
+449
(loop (cdr ls) (cons (string-append " " line) parts) #f #f)))))))
+450
+451
;; Apply chomping to block scalar content
+452
(define (apply-chomping content chomp)
+453
(let ((trimmed (string-trim-end content)))
+454
(case chomp
+455
((strip) trimmed)
+456
((keep) (string-append content "\n"))
+457
((clip) (string-append trimmed "\n")))))
+458
+459
;; ============================================================
+460
;; Flow Collection Parsing
+461
;; ============================================================
+462
+463
;; Parse a flow sequence: [item, item, ...]
+464
;; str is the content starting after '['
+465
;; Returns (values parsed-list remaining-string)
+466
(define (parse-flow-sequence str)
+467
(let loop ((s (string-trim str)) (items '()))
+468
(cond
+469
((string-empty? s)
+470
(error "Unterminated flow sequence"))
+471
((char=? (string-ref s 0) #\])
+472
(values (reverse items)
+473
(string-trim (substring s 1 (string-length s)))))
+474
((char=? (string-ref s 0) #\,)
+475
(loop (string-trim (substring s 1 (string-length s))) items))
+476
(else
+477
(let-values (((value rest) (parse-flow-value s)))
+478
(loop (string-trim rest) (cons value items)))))))
+479
+480
;; Parse a flow mapping: {key: value, ...}
+481
;; str is the content starting after '{'
+482
;; Returns (values parsed-dict remaining-string)
+483
(define (parse-flow-mapping str)
+484
(let loop ((s (string-trim str)) (result #{}))
+485
(cond
+486
((string-empty? s)
+487
(error "Unterminated flow mapping"))
+488
((char=? (string-ref s 0) #\})
+489
(values result
+490
(string-trim (substring s 1 (string-length s)))))
+491
((char=? (string-ref s 0) #\,)
+492
(loop (string-trim (substring s 1 (string-length s))) result))
+493
(else
+494
;; Parse key
+495
(let-values (((key rest) (parse-flow-key s)))
+496
;; Expect colon
+497
(let ((r (string-trim rest)))
+498
(if (and (> (string-length r) 0) (char=? (string-ref r 0) #\:))
+499
(let ((after-colon (string-trim (substring r 1 (string-length r)))))

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

test/test-yaml.sgladded
@@ -0,0 +1,389 @@
+1
;;; Test suite for (sigil yaml)
+2
+3
(import (sigil test)
+4
(sigil yaml)
+5
(sigil math))
+6
+7
;; ============================================================
+8
;; Scalar Type Resolution
+9
;; ============================================================
+10
+11
(test-group "yaml-decode - null"
+12
(test "null keyword"
+13
(assert-equal 'null (yaml-decode "null")))
+14
(test "Null keyword"
+15
(assert-equal 'null (yaml-decode "Null")))
+16
(test "NULL keyword"
+17
(assert-equal 'null (yaml-decode "NULL")))
+18
(test "tilde is null"
+19
(assert-equal 'null (yaml-decode "~")))
+20
(test "empty string is null"
+21
(assert-equal 'null (yaml-decode ""))))
+22
+23
(test-group "yaml-decode - booleans"
+24
(test "true"
+25
(assert-equal #t (yaml-decode "true")))
+26
(test "True"
+27
(assert-equal #t (yaml-decode "True")))
+28
(test "TRUE"
+29
(assert-equal #t (yaml-decode "TRUE")))
+30
(test "false"
+31
(assert-equal #f (yaml-decode "false")))
+32
(test "False"
+33
(assert-equal #f (yaml-decode "False")))
+34
(test "FALSE"
+35
(assert-equal #f (yaml-decode "FALSE"))))
+36
+37
(test-group "yaml-decode - integers"
+38
(test "positive integer"
+39
(assert-equal 42 (yaml-decode "42")))
+40
(test "negative integer"
+41
(assert-equal -7 (yaml-decode "-7")))
+42
(test "zero"
+43
(assert-equal 0 (yaml-decode "0")))
+44
(test "hex integer"
+45
(assert-equal 255 (yaml-decode "0xFF")))
+46
(test "octal integer"
+47
(assert-equal 8 (yaml-decode "0o10"))))
+48
+49
(test-group "yaml-decode - floats"
+50
(test "simple float"
+51
(assert-equal 3.14 (yaml-decode "3.14")))
+52
(test "negative float"
+53
(assert-equal -2.5 (yaml-decode "-2.5")))
+54
(test "positive infinity"
+55
(assert-true (infinite? (yaml-decode ".inf")))
+56
(assert-true (> (yaml-decode ".inf") 0)))
+57
(test "negative infinity"
+58
(assert-true (infinite? (yaml-decode "-.inf")))
+59
(assert-true (< (yaml-decode "-.inf") 0)))
+60
(test "nan"
+61
(assert-true (nan? (yaml-decode ".nan")))))
+62
+63
(test-group "yaml-decode - strings"
+64
(test "plain string"
+65
(assert-equal "hello" (yaml-decode "hello")))
+66
(test "string with spaces"
+67
(assert-equal "hello world" (yaml-decode "hello world")))
+68
(test "double-quoted string"
+69
(assert-equal "hello" (yaml-decode "\"hello\"")))
+70
(test "single-quoted string"
+71
(assert-equal "hello" (yaml-decode "'hello'")))
+72
(test "double-quoted with escapes"
+73
(assert-equal "line1\nline2" (yaml-decode "\"line1\\nline2\"")))
+74
(test "double-quoted with tab"
+75
(assert-equal "a\tb" (yaml-decode "\"a\\tb\"")))
+76
(test "single-quoted with escaped quote"
+77
(assert-equal "it's" (yaml-decode "'it''s'")))
+78
(test "double-quoted preserves special chars"
+79
(assert-equal "true" (yaml-decode "\"true\"")))
+80
(test "single-quoted preserves special chars"
+81
(assert-equal "null" (yaml-decode "'null'"))))
+82
+83
;; ============================================================
+84
;; Block Mappings
+85
;; ============================================================
+86
+87
(test-group "yaml-decode - block mappings"
+88
(test "simple mapping"
+89
(assert-equal #{ name: "Alice" age: 30 }
+90
(yaml-decode "name: Alice\nage: 30")))
+91
+92
(test "mapping with string values"
+93
(assert-equal #{ first: "John" last: "Doe" }
+94
(yaml-decode "first: John\nlast: Doe")))
+95
+96
(test "mapping with mixed types"
+97
(assert-equal #{ name: "Alice" age: 30 active: #t }
+98
(yaml-decode "name: Alice\nage: 30\nactive: true")))
+99
+100
(test "mapping with null value"
+101
(assert-equal #{ key: "null" }
+102
;; Bare "key:" with no value after colon
+103
;; Actually "key:" at end of line should give null
+104
(yaml-decode "key: 'null'")))
+105
+106
(test "mapping with empty value"
+107
(assert-true (yaml-null? (dict-ref (yaml-decode "key:") key:))))
+108
+109
(test "nested mapping"
+110
(assert-equal #{ outer: #{ inner: 42 } }
+111
(yaml-decode "outer:\n inner: 42")))
+112
+113
(test "deeply nested mapping"
+114
(assert-equal #{ a: #{ b: #{ c: "deep" } } }
+115
(yaml-decode "a:\n b:\n c: deep"))))
+116
+117
;; ============================================================
+118
;; Block Sequences
+119
;; ============================================================
+120
+121
(test-group "yaml-decode - block sequences"
+122
(test "simple sequence"
+123
(assert-equal '("apple" "banana" "cherry")
+124
(yaml-decode "- apple\n- banana\n- cherry")))
+125
+126
(test "sequence of integers"
+127
(assert-equal '(1 2 3)
+128
(yaml-decode "- 1\n- 2\n- 3")))
+129
+130
(test "sequence with mixed types"
+131
(assert-equal '("hello" 42 #t)
+132
(yaml-decode "- hello\n- 42\n- true")))
+133
+134
(test "nested sequence"
+135
(assert-equal '(("a" "b") ("c" "d"))
+136
(yaml-decode "- - a\n - b\n- - c\n - d")))
+137
+138
(test "sequence of mappings"
+139
(assert-equal (list #{ name: "Alice" } #{ name: "Bob" })
+140
(yaml-decode "- name: Alice\n- name: Bob"))))
+141
+142
;; ============================================================
+143
;; Mixed Nesting
+144
;; ============================================================
+145
+146
(test-group "yaml-decode - mixed nesting"
+147
(test "mapping with sequence value"
+148
(assert-equal #{ items: '(1 2 3) }
+149
(yaml-decode "items:\n - 1\n - 2\n - 3")))
+150
+151
(test "mapping with nested sequence of mappings"
+152
(assert-equal #{ users: (list #{ name: "Alice" age: 30 } #{ name: "Bob" age: 25 }) }
+153
(yaml-decode "users:\n - name: Alice\n age: 30\n - name: Bob\n age: 25")))
+154
+155
(test "sequence of mappings with nested values"
+156
(assert-equal (list #{ name: "server1" ports: '(80 443) }
+157
#{ name: "server2" ports: '(8080) })
+158
(yaml-decode "- name: server1\n ports:\n - 80\n - 443\n- name: server2\n ports:\n - 8080"))))
+159
+160
;; ============================================================
+161
;; Flow Collections
+162
;; ============================================================
+163
+164
(test-group "yaml-decode - flow collections"
+165
(test "flow sequence"
+166
(assert-equal '(1 2 3)
+167
(yaml-decode "[1, 2, 3]")))
+168
+169
(test "flow mapping"
+170
(assert-equal #{ a: 1 b: 2 }
+171
(yaml-decode "{a: 1, b: 2}")))
+172
+173
(test "nested flow"
+174
(assert-equal #{ a: '(1 2) b: #{ c: 3 } }
+175
(yaml-decode "{a: [1, 2], b: {c: 3}}")))
+176
+177
(test "flow in block mapping"
+178
(assert-equal #{ items: '(1 2 3) }
+179
(yaml-decode "items: [1, 2, 3]")))
+180
+181
(test "flow mapping in block"
+182
(assert-equal #{ point: #{ x: 10 y: 20 } }
+183
(yaml-decode "point: {x: 10, y: 20}")))
+184
+185
(test "empty flow sequence"
+186
(assert-equal '()
+187
(yaml-decode "[]")))
+188
+189
(test "empty flow mapping"
+190
(assert-equal #{}
+191
(yaml-decode "{}"))))
+192
+193
;; ============================================================
+194
;; Block Scalars
+195
;; ============================================================
+196
+197
(test-group "yaml-decode - block scalars"
+198
(test "literal block scalar"
+199
(assert-equal "line1\nline2\nline3\n"
+200
(dict-ref (yaml-decode "text: |\n line1\n line2\n line3") text:)))
+201
+202
(test "folded block scalar"
+203
(assert-equal "line1 line2 line3\n"
+204
(dict-ref (yaml-decode "text: >\n line1\n line2\n line3") text:)))
+205
+206
(test "literal with strip chomping"
+207
(assert-equal "line1\nline2"
+208
(dict-ref (yaml-decode "text: |-\n line1\n line2") text:)))
+209
+210
(test "literal with keep chomping"
+211
(assert-equal "line1\nline2\n\n"
+212
(dict-ref (yaml-decode "text: |+\n line1\n line2\n\nnext: val") text:)))
+213
+214
(test "folded with paragraph break"
+215
(assert-equal "first second\n\nthird fourth\n"
+216
(dict-ref (yaml-decode "text: >\n first\n second\n\n third\n fourth") text:))))
+217
+218
;; ============================================================
+219
;; Comments
+220
;; ============================================================
+221
+222
(test-group "yaml-decode - comments"
+223
(test "full-line comment"
+224
(assert-equal #{ name: "Alice" }
+225
(yaml-decode "# This is a comment\nname: Alice")))
+226
+227
(test "inline comment"
+228
(assert-equal #{ name: "Alice" }
+229
(yaml-decode "name: Alice # a comment")))
+230
+231
(test "comment between entries"
+232
(assert-equal #{ a: 1 b: 2 }
+233
(yaml-decode "a: 1\n# separator\nb: 2"))))
+234
+235
;; ============================================================
+236
;; Multi-Document
+237
;; ============================================================
+238
+239
(test-group "yaml-decode - multi-document"
+240
(test "single document with marker"
+241
(assert-equal #{ a: 1 }
+242
(yaml-decode "---\na: 1")))
+243
+244
(test "yaml-read-all with multiple docs"
+245
(assert-equal (list #{ a: 1 } #{ b: 2 })
+246
(yaml-decode-all "---\na: 1\n---\nb: 2")))
+247
+248
(test "document end marker"
+249
(assert-equal (list #{ a: 1 })
+250
(yaml-decode-all "---\na: 1\n..."))))
+251
+252
;; ============================================================
+253
;; Anchors and Aliases
+254
;; ============================================================
+255
+256
(test-group "yaml-decode - anchors and aliases"
+257
(test "simple anchor and alias"
+258
(let ((result (yaml-decode "anchor: &val Alice\nref: *val")))
+259
(assert-equal "Alice" (dict-ref result anchor:))
+260
(assert-equal "Alice" (dict-ref result ref:))))
+261
+262
(test "anchor on mapping value"
+263
(let ((result (yaml-decode "defaults: &def\n color: red\n size: large\ncustom:\n color: blue\n size: large")))
+264
(assert-equal "red" (dict-ref (dict-ref result defaults:) color:)))))
+265
+266
;; ============================================================
+267
;; Writer - Block Style
+268
;; ============================================================
+269
+270
(test-group "yaml-encode - scalars"
+271
(test "encode string"
+272
(assert-equal "hello\n" (yaml-encode "hello")))
+273
(test "encode integer"
+274
(assert-equal "42\n" (yaml-encode 42)))
+275
(test "encode float"
+276
(assert-equal "3.14\n" (yaml-encode 3.14)))
+277
(test "encode true"
+278
(assert-equal "true\n" (yaml-encode #t)))
+279
(test "encode false"
+280
(assert-equal "false\n" (yaml-encode #f)))
+281
(test "encode null"
+282
(assert-equal "null\n" (yaml-encode 'null)))
+283
(test "encode string that needs quoting"
+284
(assert-equal "\"true\"\n" (yaml-encode "true")))
+285
(test "encode empty string"
+286
(assert-equal "\"\"\n" (yaml-encode ""))))
+287
+288
(test-group "yaml-encode - block mappings"
+289
(test "simple mapping"
+290
(assert-equal "name: Alice\n"
+291
(yaml-encode #{ name: "Alice" })))
+292
+293
(test "nested mapping"
+294
(assert-equal "outer:\n inner: 42\n"
+295
(yaml-encode #{ outer: #{ inner: 42 } })))
+296
+297
(test "empty mapping"
+298
(assert-equal "{}\n" (yaml-encode #{}))))
+299
+300
(test-group "yaml-encode - block sequences"
+301
(test "simple sequence"
+302
(assert-equal "- 1\n- 2\n- 3\n"
+303
(yaml-encode '(1 2 3))))
+304
+305
(test "empty list"
+306
(assert-equal "[]\n" (yaml-encode '()))))
+307
+308
;; ============================================================
+309
;; Writer - Flow Style
+310
;; ============================================================
+311
+312
(test-group "yaml-encode - flow style"
+313
(test "flow mapping"
+314
(assert-equal "{a: 1, b: 2}"
+315
(yaml-encode #{ a: 1 b: 2 } flow: #t)))
+316
+317
(test "flow sequence"
+318
(assert-equal "[1, 2, 3]"
+319
(yaml-encode '(1 2 3) flow: #t)))
+320
+321
(test "flow nested"
+322
(assert-equal "{items: [1, 2, 3]}"
+323
(yaml-encode #{ items: '(1 2 3) } flow: #t))))
+324
+325
;; ============================================================
+326
;; yaml-null?
+327
;; ============================================================
+328
+329
(test-group "yaml-null?"
+330
(test "null symbol is null"
+331
(assert-true (yaml-null? 'null)))
+332
(test "false is not null"
+333
(assert-false (yaml-null? #f)))
+334
(test "empty list is not null"
+335
(assert-false (yaml-null? '())))
+336
(test "decoded null is null"
+337
(assert-true (yaml-null? (yaml-decode "null"))))
+338
(test "decoded tilde is null"
+339
(assert-true (yaml-null? (yaml-decode "~")))))
+340
+341
;; ============================================================
+342
;; Round-Trip Tests
+343
;; ============================================================
+344
+345
(test-group "yaml round-trip"
+346
(test "simple mapping round-trip"
+347
(let* ((original #{ name: "Alice" age: 30 })
+348
(encoded (yaml-encode original))
+349
(decoded (yaml-decode encoded)))
+350
(assert-equal "Alice" (dict-ref decoded name:))
+351
(assert-equal 30 (dict-ref decoded age:))))
+352
+353
(test "sequence round-trip"
+354
(let* ((original '(1 2 3))
+355
(encoded (yaml-encode original))
+356
(decoded (yaml-decode encoded)))
+357
(assert-equal original decoded)))
+358
+359
(test "nested structure round-trip"
+360
(let* ((original #{ users: (list #{ name: "Alice" } #{ name: "Bob" }) })
+361
(encoded (yaml-encode original))
+362
(decoded (yaml-decode encoded)))
+363
(assert-equal "Alice"
+364
(dict-ref (car (dict-ref decoded users:)) name:))
+365
(assert-equal "Bob"
+366
(dict-ref (cadr (dict-ref decoded users:)) name:)))))
+367
+368
;; ============================================================
+369
;; Edge Cases
+370
;; ============================================================
+371
+372
(test-group "yaml-decode - edge cases"
+373
(test "empty document"
+374
(assert-equal 'null (yaml-decode "")))
+375
+376
(test "comment-only document"
+377
(assert-equal 'null (yaml-decode "# just a comment")))
+378
+379
(test "quoted key in mapping"
+380
(assert-equal #{ key: "value" }
+381
(yaml-decode "\"key\": value")))
+382
+383
(test "colon in value"
+384
(assert-equal #{ url: "http://example.com" }
+385
(yaml-decode "url: http://example.com")))
+386
+387
(test "mapping key with quoted value"
+388
(assert-equal #{ greeting: "hello world" }
+389
(yaml-decode "greeting: \"hello world\""))))