dumb-templating.scm

;; A template is conceptually a list
;; The items in the list are of two varieties
;; 1) A string - these are printed verbatim
;; 2) A variable - these are taken from a context
;;
;; Contexts are conceptually a hashtable
;;
;; If a variable is not found in a context, it is an error, unless the
;; context has a default value specified.
;;
;; Variables are denoted by {{ var }} in the surrounding text.
;; As of now there is no escape mechanism, nor automatic sanitisation
;; of inputs.

;; api
;;;;;;;;
;; string->template :: string -> template
;; file->template   :: filename -> template
;; make-context     :: hashtable [default] -> Context
;; render           :: template context -> string // maybe take optional port argument
(import (pfds dlists)
        (wak foof-loop)
        (rnrs conditions)
        (rnrs exceptions)
        (rnrs records syntactic)
        (rnrs io ports)
        (rnrs io simple)
        (only (utils) ->)
        (rnrs hashtables))

;;; Notes: something like this could also make a simple test for
;;; iteratees

(define-condition-type &parsing-error &i/o-read
  make-parsing-error
  parsing-error?)

(define-condition-type &unterminated-read &parsing-error
  make-unterminated-read-error
  unterminated-read-error?
  ;; represents what was read already
  (data unterminated-read-data))

(define (unterminated-read who message so-far)
  (raise
   (condition
    (make-who-condition who)
    (make-message-condition message)
    (make-unterminated-read-error so-far))))

;; read-delimited string port -> string | eof
;; reads the string that precedes the first occurrence of the
;; delim-string in the port
;; returns the string, or the eof-object if the port is empty
(define (read-delimited delim-string port) ; O(n)
  ;; Note, there are better algorithms for this problem, and I should
  ;; probably be using them, but this is sufficient for now.
  ;;
  ;; What I need to know is, is there an efficient algorithm for
  ;; searching for a delimited string, one row at a time, and never
  ;; peeking ahead more than one?
  ;; Now, the answer is yes, since this is how regular expressions
  ;; work, but I think it should be more specific algorithms anyway
  (cond ((string-null? delim-string)
         (get-string-all port))
        ((eof-object? (lookahead-char port))
         (eof-object))
        (else
         (-> (read-delim (dlist) (string->list delim-string) port)
             dlist->list
             list->string))))

(define (in-delim so-far delim-so-far delim-list orig-delim-list port)
  (if (null? delim-list)
      so-far
      (let ((c (get-char port)))
        (cond ((eof-object? c)
               (dlist-append so-far delim-so-far))
              ((char=? c (car delim-list))
               (in-delim so-far
                         (dlist-snoc delim-so-far (car delim-list))
                         (cdr delim-list)
                         orig-delim-list
                         port))
              (else
               (read-delim (dlist-snoc (dlist-append so-far delim-so-far) c)
                           orig-delim-list
                           port))))))

(define (read-delim so-far delim-list port)
  (define char (get-char port))
  (cond ((eof-object? char) so-far)
        ((char=? char (car delim-list))
         (in-delim so-far (dlist (car delim-list)) (cdr delim-list) delim-list port))
        (else
         (read-delim (dlist-snoc so-far char) delim-list port))))


;; (define (test input delim-string output-value)
;;   (call-with-input-string input
;;     (lambda (port)
;;       (equal? (read-delimited delim-string port)
;;               output-value))))

;; (test "" "{{" (eof-object))
;; (test "foo" "{{" "foo")
;; (test "foo bar baz {{" "{{" "foo bar baz ")
;; (test "foo { bar{{" "{{" "foo { bar")
;; (test "abcabcabcdabc" "abc" "")
;; (test "abcabcabcdabc" "abcd" "abcabc")
;; (test "frob zot" "" "frob zot")


(define-record-type node
  (fields value)) ; probably not the best way to do things
(define-record-type string-node
  (parent node))
(define-record-type variable-node
  (parent node))
(define-record-type template
  (fields nodes))

(define (template-from-port port)
  ;; note, this is a pretty raw parser, and you don't have to close
  ;; the last variable
  (define (read-string-node prefix)
    (if (eof-object? (peek-char port))
        (dlist->list prefix)
        (let ((node (make-string-node (read-delimited "{{" port))))
          (read-variable-node (dlist-snoc prefix node)))))
  
  (define (read-variable-node prefix)
    (if (eof-object? (peek-char port))
        (dlist->list prefix)
        (let* ((str (read-delimited "}}" port))
               (node (make-variable-node (string-trim-both str))))
          (read-string-node (dlist-snoc prefix node)))))
  
  (make-template (read-string-node (dlist))))

(define (string->template string)
  (call-with-input-string string template-from-port))

(define (file->template filename)
  (call-with-input-file filename template-from-port))

(define-record-type (context %make-context context?)
  (fields (immutable table)))

(define (make-context)
  (%make-context (make-hashtable string-hash string=?)))

(define (context-set! ctxt key value)
  (hashtable-set! (context-table ctxt)
                  (if (symbol? key)
                      (symbol->string key)
                      key)
                  value))

(define (context-ref ctxt key)
  (hashtable-ref (context-table ctxt) key #f))

(define (alist->context alist)
  (define c (make-context))
  (for-each (lambda (pair)
              (context-set! c (car pair) (cdr pair)))
            alist)
  c)

(define* (render template context port #:optional (default ""))
  (let ((context (if (list? context)
                     (alist->context context)
                     context)))
    (for-each (lambda (node)
                (define v (node-value node))
                (cond ((string-node? node)
                       (display v port))
                      ;; for now we assume that the value of the key in
                      ;; the context is not #f, we can change this if we
                      ;; use riastradh's more flexible cond, but we
                      ;; aren't right now
                      ((context-ref context v) =>
                       (lambda (p)
                         (display p port)))
                      (else
                       (display default port))))
              (template-nodes template))))

(define* (render-to-string template context #:optional (default ""))
  (call-with-string-output-port
   (lambda (out)
     (render template context out default))))