Guile - Heredoc

November 24, 2022
Tags:

In my previous blog post titled "Literal string interpolation", I've shown how one can add a simple syntax called fstring to have variable interpolation in Guile. Today, I want to go further and incorporate a reader so one don't have to use the fstring syntax. I also want to have some kind of heredoc à la bash where users can specify if they want to trim or not whitespace.

NOTE: Rendering of code on the website is not okay. You can try the code in the REPL it's all valid.

Goals

Simple interpolation

Input

(let ((x 2))
  (display #"x^2=@(* x x)")
  (newline))

Output

(let ((x 2))
  (display (format #f "x^2=~a" (* x x)))
  (newline))

Interpolation with whitespaces trimming

Input

(let ((foo 'bar))
  (display #@"\
This is a multi-line
  heredoc
     where whitespaces
       are trimmed
and with interpolation
foo=@foo
"))

Output

(let ((foo 'bar))
  (display (format #f "This is a multi-line\nheredoc\nwhere whitespaces\nare trimmed\nand with interpolation\nfoo=~a\n" foo)))

Whitespaces trimming without interpolation

Input

(let ((foo 'bar))
  (display #@~"\
  This is a multi-line
    heredoc
       where whitespaces are
                                trimmed
and without interpolation
foo=@foo
"))

Output

(let ((foo 'bar))
  (display "This is a multi-line\nheredoc\nwhere whitespaces are\ntrimmed\nand without interpolation\nfoo=@foo\n"))

Tests

Since we've put our goals in term of Scheme code, why not use them as our base for testing?

;;; SPDX-License-Identifier: GPL-3.0-or-later
;;;
;;; Copyright (c) 2022 Olivier Dion <olivier-dion@proton.me>
;;;
;;; Commentary:
;;;
;;; Our code will be in the (fmt) module.
;;;
;;; Code:

(define-module (tests fmt)
  #:use-module (fmt)
  #:use-module (srfi srfi-64))

(test-begin "(fmt)")

(let ((x 10))
  (test-equal "Simple interpolation"
    (format #f "x^2=~a" (* x x))
    #"x^2=@(* x x)"))

(let ((foo 'bar))
  (test-equal "Interpolation with whitespaces trimming"
    (format #f
      "\
This is a multi-line
heredoc
where whitespaces are
trimmed
and with interpolation
foo=~a
" foo)
    #@"\
  This is a multi-line
    heredoc
       where whitespaces are
                                trimmed
and with interpolation
foo=@foo
"))

(let ((foo 'bar))
  (test-equal "Whitespaces trimming without interpolation"
    "\
This is a multi-line
heredoc
where whitespaces are
trimmed
and without interpolation
foo=@foo
"
    #@~"\
  This is a multi-line
    heredoc
       where whitespaces are
                                trimmed
and without interpolation
foo=@foo
"))

(test-end "(fmt)")

Extending the reader

Guile allows user to extend the reader using the read-hash-extend procedure. It takes two arguments. The first argument is a character that is going to be used for dispatching to the second argument which is a procedure that takes two arguments. That procedure receives the character that was used for dispatching -- since different characters can dispatch to the same procedure -- as its first argument and the port for reading as its second argument.

For us, we want to dispatch on tree different prefix.

  1. "

  2. @"

  3. @~"

Implementation

Helpers

First, we want to trim whitespaces of each lines. This can easily be implemented like this:

(define (trim-lines-whitespaces text)
  (string-join
   (map (cut string-trim <> char-set:whitespace)
        (string-split text #\newline))
   "\n"
   'infix))

Second, we want a procedure that will transform a text into an S-exp for formating that text with interpolated expressions.

(define (interpolate-this% text)
  (call-with-input-string text
    (lambda (port)
      (let loop ((new-text '())
                 (exps '())
                 (escape? #f))
        (let ((chr (get-char port)))
          (cond
           ((eof-object? chr)
            (values
             (reverse-list->string new-text)
             (reverse exps)))
           (escape?
            (if (char=? chr #\@)
                (loop (cons chr new-text) exps #f)
                (loop (cons chr (cons #\\ next-text)) exps #f)))
           ((char=? chr #\\)
            (loop new-text exps #t))
           ((char=? chr #\@)
            (loop (cons #\a (cons #\~ new-text))
                  (cons (read port) exps)
                  #f))
           (else
            (loop (cons chr new-text) exps #f))))))))

(define (interpolate-this text)
  (receive (fmt args)
      (interpolate-this% text)
    `(format #f ,fmt ,@args)))

The transformer

We want to transform a string into a new string or a formating of a new string with its arguments. Our transformer will take three arguments. The text to transform and two switches for enabling/disabling interpolation and trimming.

(define (transform text interpolate? trim?)
  (cond
   ((and interpolate? trim?)
    (interpolate-this (trim-lines-whitespaces text)))
   (interpolate?
    (interpolate-this text))
   (trim?
    (trim-lines-whitespaces text))
   (else
    text)))

The readers

Finally, we want to simply the life of user by not having to call transform. To do this we're going to use the read-hash-extend procedure to extend Guile's reader.

(define (read-string/interpolation char port)
  (unget-char port char)
  (transform (read port) #t #f))

(define (read-heredoc _ port)
  (let ((ahead (get-char port)))
    (if (char=? ahead #\~)
        (transform (read port) #f #t)
        (begin
          (unget-char port ahead)
          (transform (read port) #t #t)))))

(read-hash-extend #\" read-string/interpolation)
(read-hash-extend #\@ read-heredoc)

Also readers are weird beasts, so we have to put all our code in a eval-when form like this:

(eval-when (expand load eval) ...)

Conclusion

That is it! In this post we've seen that it is quite easy to extend the Guile's reader so we can have expression interpolation and whitespaces trimming. Our extensions use some characters that might not make sens for some. I've choose these characters because paredit in Emacs seems to not get confused about them. However, it would be nice if we could parameterize the (fmt) module so users can select the prefixes that they want to use in their project.

Happy hacking!

Full code

;;; SPDX-License-Identifier: GPL-3.0-or-later
;;;
;;; Copyright (c) 2022 Olivier Dion <olivier-dion@proton.me>
;;;
;;; Commentary:
;;;
;;; Expression interpolation and whitespaces trimming extensions to Guile's
;;; reader.
;;;
;;; The '@' character is used to interpolate an expression in string.
;;;
;;; Strings prefixed with '#' have expressions interpolation.
;;;
;;; Strings prefixed with '#@' have expressions interpolation and whitespaces
;;; are trimmed for each lines.
;;;
;;; Strings prefixed with '#@~' don't have expressions interpolation and
;;; whitespaces are trimmed for each lines.
;;;
;;; Code:

(define-module (fmt)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-26))

(eval-when (expand load eval)

  (define (trim-lines-whitespaces text)
    (string-join
     (map (cut string-trim <> char-set:whitespace)
          (string-split text #\newline))
     "\n"
     'infix))

  (define (interpolate-this% text)
    (call-with-input-string text
      (lambda (port)
        (let loop ((new-text '())
                   (exps '())
                   (escape? #f))
          (let ((chr (get-char port)))
            (cond
             ((eof-object? chr)
              (values
               (reverse-list->string new-text)
               (reverse exps)))
             (escape?
              (if (char=? chr #\@)
                  (loop (cons chr new-text) exps #f)
                  (loop (cons chr (cons #\\ next-text)) exps #f)))
             ((char=? chr #\\)
              (loop new-text exps #t))
             ((char=? chr #\@)
              (loop (cons #\a (cons #\~ new-text))
                    (cons (read port) exps)
                    #f))
             (else
              (loop (cons chr new-text) exps #f))))))))

  (define (interpolate-this text)
    (receive (fmt args)
        (interpolate-this% text)
      `(format #f ,fmt ,@args)))

  (define (transform text interpolate? trim?)
    (cond
     ((and interpolate? trim?)
      (interpolate-this (trim-lines-whitespaces text)))
     (interpolate?
      (interpolate-this text))
     (trim?
      (trim-lines-whitespaces text))
     (else
      text)))

  (define (read-string/interpolation char port)
    (unget-char port char)
    (transform (read port) #t #f))

  (define (read-heredoc _ port)
    (let ((ahead (get-char port)))
      (if (char=? ahead #\~)
          (transform (read port) #f #t)
          (begin
            (unget-char port ahead)
            (transform (read port) #t #t)))))

  (read-hash-extend #\" read-string/interpolation)
  (read-hash-extend #\@ read-heredoc))