gerbil quasistring

quasistring.ss

;; quasistring.ss

(import :std/format
        :std/net/request)

;; variant: return procedure of n args?
(defsyntax (quasistring stx)
  (syntax-case stx ()
    ((macro s)
     (stx-string? #'s)
     (let (port (open-input-string (stx-e #'s)))
       (let lp ((c (read-char port))
                (sexps [])
                (str []))
         (cond
          ((eq? c #\#) ;; template variable?
           (let ((c+1 (read-char port)))
             (cond
              ((eq? c+1 #\{) ;; yes, read sexp
               (let (ssexp (read port))
                 (if (eq? (read-char port) #\}) ;; closed template variable?
                   (lp (read-char port) (cons ssexp sexps) (cons #\a (cons #\~ str)))
                   (error "Bad quasistring formatting."))))
              (else ;; no, start again
               (lp (read-char port) sexps str)))))
          ((eq? c #!eof) ;; eof so return syntax
           (close-input-port port)
           (with-syntax (((vars ...) (datum->syntax #'macro (reverse sexps)))
                         (str (list->string (reverse str))))
             #'(apply format str [vars ...])))
          (else ;; no, start again
           (lp (read-char port) sexps (cons c str)))))))))

;; > (let ((a 1) (b 2)) (quasistring "a: #{a}~nb: #{b}"))
;; "a: 1\nb: 2"
;; > (let ((a 1) (b 2)) (quasistring "a: #{b}~nb: #{b}"))
;; "a: 2\nb: 2"
;; > (let (name "world") (quasistring "hello, #{name}!"))
;; "hello, world!"
;; > (quasistring "hello, #{name}!")
;; *** ERROR -- Unbound variable: name
;; > (quasistring "2 + 2 is #{(+ 2 2)}")                             
;; "2 + 2 is 4"
;; > (quasistring "Your IP address is #{(let (req (http-get \"ipinfo.io/json\")) (hash-ref (request-json req) 'ip))}")
;; "Your IP address is x.x.x.x"