source: main/templ.lisp

#|
Copyright (C) 2008  David Owen <dsowen@fugue88.ws>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Lesser Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser Public License for more details.

You should have received a copy of the GNU Lesser Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
|#

(defpackage #:dso-simple-template-templ
  (:use #:cl)
  (:import-from #:dso-parse #:defgrammar)
  (:export #:template #:read-template-from-string #:read-template
           #:load-template))

(in-package #:dso-simple-template-templ)



(defun flatten-chars (tree)
  (flet ((f (tree)
           (destructuring-bind (x) tree
             (aref x 0))))
    (coerce (mapcar #'f tree) 'string)))

(defun flatten-expression-chars (tree)
  (flet ((f (tree)
           (destructuring-bind (x) tree
             (aref x 0))))
    (destructuring-bind (x) tree
      (coerce (mapcar #'f x) 'string))))

(defgrammar ()
  (expression-start #\{)
  (expression-finish #\})
  (escaped-expression-start ({} 2 2 expression-start)
                            :filter (lambda (x) '("{"))
                            :cclass t)
  #|(escaped-expression-finish ({} 2 2 expression-finish)
                             :filter (lambda (x) '("}"))
                             :cclass t)|#
  (newline #\Newline
           :filter (lambda (x) '("
"))
           :cclass t)
  (expression-char (/ #|escaped-expression-finish|# ((! expression-finish) (^ ".")))
                   :cclass t)
  (expression ((= expression-start) (+ expression-char) (= expression-finish))
              :filter flatten-expression-chars)
  (body-char (/ escaped-expression-start ((! expression-start) (^ ".")) newline)
             :cclass t)
  (body-text (+ body-char) :filter flatten-chars)
  (simple-template (+ (/ body-text expression))))



(defclass template ()
  ((parts :type list :initarg :parts :reader parts)))

(defun read-template-from-string (s)
  (multiple-value-bind (ok tail tree) (simple-template s)
    (unless (and ok (string= tail ""))
      (error "Can't parse the template."))
    (make-instance 'template :parts (cdr tree))))

(defun gulp-stream (stream)
  (let ((s-out (make-string-output-stream))
        (buffer (make-sequence 'string 4096)))
    (do ((n #1=(read-sequence buffer stream) #1#))
        ((= n 0))
      (write-sequence buffer s-out :end n))
    (get-output-stream-string s-out)))

(defun read-template (stream)
  (read-template-from-string (gulp-stream stream)))

(defun load-template (filename)
  (with-open-file (stream filename)
    (read-template stream)))