utils: *-file: Support S-expression as well.

* modules/rosenthal/utils/file.scm (ini-file, json-file, toml-file, yaml-file):
Support S-expression.
This commit is contained in:
Hilton Chain 2026-05-25 19:43:30 +08:00
parent 0b6b5feb72
commit 86d418b080
No known key found for this signature in database
GPG Key ID: ACC66D09CA528292

View File

@ -64,53 +64,72 @@
;; https://github.com/artyom-poptsov/guile-ini ;; https://github.com/artyom-poptsov/guile-ini
(define (ini-file name exp) (define (ini-file name exp)
"Return file-like object NAME, serialized from G-expression EXP in INI "Return a file-like object, outputing INI file serialized from EXP."
format."
(computed-file name (computed-file name
(with-extensions (list guile-ini guile-lib guile-smc) (with-extensions (list guile-ini guile-lib guile-smc)
#~(begin (if (gexp? exp)
(use-modules (srfi srfi-26) (ini)) #~(begin
(call-with-output-file #$output (use-modules (srfi srfi-26) (ini))
(cut scm->ini #$exp #:port <>)))) (call-with-output-file #$output
(cut scm->ini #$exp #:port <>)))
#~(begin
(use-modules (srfi srfi-26) (ini))
(call-with-output-file #$output
(cut scm->ini '#$exp #:port <>)))))
#:options '(#:substitutable? #f))) #:options '(#:substitutable? #f)))
;; https://github.com/aconchillo/guile-json ;; https://github.com/aconchillo/guile-json
(define (json-file name exp) (define (json-file name exp)
"Return file-like object NAME, serialized from G-expression EXP in JSON "Return a file-like object, outputing JSON file serialized from EXP."
format."
(computed-file name (computed-file name
(with-extensions (list guile-json-4) (with-extensions (list guile-json-4)
#~(begin (if (gexp? exp)
(use-modules (srfi srfi-26) (json)) #~(begin
(call-with-output-file #$output (use-modules (srfi srfi-26) (json))
(cut scm->json #$exp <> #:pretty #t)))) (call-with-output-file #$output
(cut scm->json #$exp <> #:pretty #t)))
#~(begin
(use-modules (srfi srfi-26) (json))
(call-with-output-file #$output
(cut scm->json '#$exp <> #:pretty #t)))))
#:options '(#:substitutable? #f))) #:options '(#:substitutable? #f)))
;; https://github.com/hylophile/guile-toml ;; https://github.com/hylophile/guile-toml
;; TODO: TOML writing support is incomplete. ;; TODO: TOML writing support is incomplete.
;; See https://github.com/hylophile/guile-toml/blob/main/toml/builder.scm. ;; See https://github.com/hylophile/guile-toml/blob/main/toml/builder.scm.
(define (toml-file name exp) (define (toml-file name exp)
"Return file-like object NAME, serialized from G-expression EXP in TOML "Return a file-like object, outputing TOML file serialized from EXP."
format."
(computed-file name (computed-file name
(with-extensions (list guile-json-4 guile-toml) (with-extensions (list guile-json-4 guile-toml)
#~(begin (if (gexp? exp)
(use-modules (srfi srfi-26) (toml)) #~(begin
(call-with-output-file #$output (use-modules (srfi srfi-26) (toml))
(cut scm->toml #$exp <>)))) (call-with-output-file #$output
(cut scm->toml #$exp <>)))
#~(begin
(use-modules (srfi srfi-26) (toml))
(call-with-output-file #$output
(cut scm->toml '#$exp <>)))))
#:options '(#:substitutable? #f))) #:options '(#:substitutable? #f)))
;; https://gitlab.com/yorgath/guile-yamlpp ;; https://gitlab.com/yorgath/guile-yamlpp
(define (yaml-file name exp) (define (yaml-file name exp)
"Return file-like object NAME, serialized from G-expression EXP in YAML "Return a file-like object, outputing YAML file serialized from EXP."
format."
(computed-file name (computed-file name
(with-extensions (list guile-yamlpp) (with-extensions (list guile-yamlpp)
#~(begin (if (gexp? exp)
(use-modules (yamlpp)) #~(begin
(call-with-output-file #$output (use-modules (yamlpp))
(lambda (port) (call-with-output-file #$output
(let ((emitter (make-yaml-emitter))) (lambda (port)
(yaml-emit! emitter #$exp) (let ((emitter (make-yaml-emitter)))
(display (yaml-emitter-string emitter) port)))))) (yaml-emit! emitter #$exp)
(display (yaml-emitter-string emitter) port)))))
#~(begin
(use-modules (yamlpp))
(call-with-output-file #$output
(lambda (port)
(let ((emitter (make-yaml-emitter)))
(yaml-emit! emitter '#$exp)
(display (yaml-emitter-string emitter) port)))))))
#:options '(#:substitutable? #f))) #:options '(#:substitutable? #f)))