template.lisp

(defclass template ()
  ((template :initarg :template :initform (error "template string is required"))
   (template-format-string)
   (dollar-symbols)))

(defun parse-template-string (str)
  (let (strs syms)
    (with-input-from-string (s str)
      (loop :named loop
	 :for ch = (read-char s nil nil)
	 :while ch
	 :do
	 (if (char= ch #\$)
	     (case (peek-char nil s)
	       ((#\$) (push (read-char s) strs))
	       ((#\{)
		(read-char s)
		(push
		 (intern
		  (format nil "~@:(~{~A~}~)"
			  (loop :for ch = (read-char s)
			     :until (char= ch #\})
			     :collect ch)))
		 syms)
		(push "~A" strs))
	       (T (let ((sym (read-preserving-whitespace s)))
		    (when (null sym)
		      (error "template identifier error"))
		    (push sym syms)
		    (push "~A" strs))))
	     (push ch strs))))
    (values (format nil "~{~A~}" (reverse strs))
	    (reverse syms))))


(defmethod initialize-instance :after ((instance template) &rest initarg)
  (let ((str (slot-value instance 'template)))
    (unless (stringp str)
      (error "~A is not string" str))
    (multiple-value-bind (fstr syms)
	(parse-template-string str)
      (setf (slot-value instance 'template-format-string) fstr
	    (slot-value instance 'dollar-symbols) syms)))
  (values))


(defgeneric substitute-template (template subst &key safe))

(defmethod substitute-template ((template template) (subst list) &key safe)
  (with-slots (template-format-string dollar-symbols) template
    (let ((result nil))
      (dolist (sym dollar-symbols)
	(let ((as (assoc sym subst)))
	  (if as
	      (push (second as) result)
	      (if safe
		  (push (format nil "$~A" sym) result)
		  (error "template ~A not found" sym)))))
      (apply #'format nil template-format-string
	     (nreverse result)))))

(defmethod substitute-template ((template template) (subst hash-table) &key safe)
  (let ((result nil))
    (with-slots (template-format-string dollar-symbols) template
      (dolist (sym dollar-symbols)
	(multiple-value-bind (val ?)
	    (gethash sym subst)
	  (if ?
	      (push val result)
	      (if safe
		  (push (format nil "$~A" sym) result)
		  (error "template ~A not found" sym)))))
      (apply #'format nil template-format-string
	     (nreverse result)))))

;; example
;; (defvar  a (make-instance 'template :template "$Hello World"))
;; (substitute-template a '((hello "piyo")))
;; => "piyo world"
;; (substitute-template a '((fuga "piyo")) :safe t)
;; "$HELLO World"
;; (defvar ht (make-hash-table))
;; (setf (gethash 'hello ht) "fuga")
;; (substitute-template a ht)
;; => "fuga World"