[core-utils] introduce gnc:format

(gnc:format str [binding value]...)

str will contain ${binding} which will be replaced to value.
This commit is contained in:
Christopher Lam 2021-10-06 09:19:14 +08:00
parent 3ff5bd8246
commit 0bce6a1d56
2 changed files with 44 additions and 0 deletions

View File

@ -32,6 +32,7 @@
(use-modules (srfi srfi-26))
(use-modules (ice-9 match))
(use-modules (ice-9 i18n))
(use-modules (ice-9 regex))
(export N_)
(export G_)
@ -41,6 +42,7 @@
(export gnc:string-locale<?)
(export gnc:string-locale>?)
(export gnc:version)
(export gnc:format)
;; loads modules and re-exports all its public interface into the
;; current module
@ -107,3 +109,16 @@
(_ (default-printer))))
(set-exception-printer! 'unbound-variable print-unbound-variable-error)
;; format.
(define %regex (make-regexp "[$][{]([[:alnum:]]+)[}]"))
(define (gnc:format str . bindings)
(define hash (make-hash-table))
(define (substitute m)
(or (hashq-ref hash (string->symbol (match:substring m 1)))
(warn "invalid identifier" (match:substring m 0))))
(let lp ((bindings bindings))
(match bindings
(() (regexp-substitute/global #f %regex str 'pre substitute 'post))
(((? symbol? k) v . rest) (hashq-set! hash k (format #f "~a" v)) (lp rest))
(_ (error "gnc:format syntax error")))))

View File

@ -13,8 +13,37 @@
"foobar"
(N_ "foobar")))
(define (gnc-format-tests)
(test-equal "null"
""
(gnc:format ""))
(test-equal "basic"
"basic"
(gnc:format "basic"))
(test-equal "basic with unused symbols"
"basic"
(gnc:format "basic" 'task "testing"))
(test-equal "one substitution"
"basic test"
(gnc:format "basic ${job}" 'job "test"))
(test-equal "two substitutions out of order"
"basic test"
(gnc:format "${difficulty} ${job}" 'job "test" 'difficulty "basic"))
(test-equal "trying to reference invalid symbol"
"${symbol} does not exist"
(gnc:format "${symbol} does not exist" 'existence "none"))
(test-error "gnc:format syntax error"
(gnc:format "${symbol} does not exist" 'existence)))
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "test-core-utils")
(N_-tests)
(gnc-format-tests)
(test-end "test-core-utils"))