テンプレートエンジン

gemma(2008/09/28 05:08:24 PDT):Schemerは目に優しい丸括弧のSXMLで片付けてしまいますが、テンプレートエンジンもあると便利かなと思って、半日仕事ででっちあげました。単純なXSLTです。 作りかけです。バグがあります。コードもひどいです。コメントお願いします。

• 仕様

  挿入
  
  <p> Hello, #{S式} </p> 
  HTMLエスケープなし
  
  <p> Hello, ${S式} </p>
  HTMLエスケープあり
  
  <p> Hello, <?scm S式 ?> </p>
  HTMLエスケープなし
  XMLのPIなので、S式中でダブルクオートなどのHTML特殊文字が使える
  

  条件処理
  
  <choose test="真偽値を返すS式">
    <then>...</then>
    <else>...</else>
  </choose>
  thenノード、elseノードは省略可
  

  繰り返し処理
  
  <foreach var="リストを返すS式">
    ...
  </foreach>
  

• 例
  • 掛け算表

    <table>
      <foreach i="(list 1 2 3)">
        <tr>
          <foreach j="(list 1 2 3)">
            <td>#{(* i j)}</td>
          </foreach>
        </tr>
      </foreach>
    </table>
    

    <table>
      <tr>
        <td>1</td>
        <td>2</td>
        <td>3</td>
      </tr>
      <tr>
        <td>2</td>
        <td>4</td>
        <td>6</td>
      </tr>
      <tr>
        <td>3</td>
        <td>6</td>
        <td>9</td>
      </tr>
    </table>
    

  • 挿入例1 & 条件処理

    <foreach n="(list 0 1 2 3 4 5 6)">
      <choose test="(= n 6)">
        <then>
          <p>That's all.</p>
        </then>
        <else>
          <p>Factorial #{n} = #{(fact n)}</p>
        </else>
      </choose>
    </foreach>
    

    <p>Factorial 0 = 1</p>
    <p>Factorial 1 = 1</p>
    <p>Factorial 2 = 2</p>
    <p>Factorial 3 = 6</p>
    <p>Factorial 4 = 24</p>
    <p>Factorial 5 = 120</p>
    <p>That's all.</p>
    

  • 挿入例2

    <foreach fruit="items">
      <p href="http://localhost/fruit/${fruit}">
        Yummy <?scm (string-append fruit "!") ?>
      </p>
    </foreach>
    

    <p href="http://localhost/fruit/apple">
        Yummy apple!</p>
    <p href="http://localhost/fruit/orange">
        Yummy orange!</p>
    <p href="http://localhost/fruit/melon">
        Yummy melon!</p>
    

• バグ
  • 私のコードにバグがあって、こんな簡単な入れ子のテンプレートが、処理できません。
  • このバグが、なかなかとれなくて困っています。私の根本的な設計ミスだと思うので、ぜひ助言をください。

    <choose test="(= 1 1)">
      <then>
        <foreach i="(list 0 1 2 3)">
          <choose test="#t">
            <then>
              <foreach j="(list 0 1 2 3)">
                <p>#{(+ i j)}</p>
              </foreach>
            </then>
          </choose>
        </foreach>
      </then>
    </choose>
    

• コード

  (use srfi-1)
  (use sxml.ssax)
  (use sxml.serializer)
  (use sxml.tools)
  (use sxml.tree-trans)
  
  ;;文字列 "Factorial #{n} = #{(fact n)}"から
  ;;S式 (string-append "Factorial " (x->string n) " = " (x->string (fact n))) を生成する
  
  (define (process-text text)
    (if (not (string? text))
      text
      (let loop ((l '())
                 (text text))
        (cond 
         ((#/\#\{([^\}]*)\}/ text) =>
          (lambda (m)
            (loop (cons `(x->string ,(read-from-string (m 1))) (cons (m 'before) l)) (m 'after))))
         ((#/\$\{([^\}]*)\}/ text) =>
          (lambda (m)
            (loop (cons `(sxml:string->html (x->string ,(read-from-string (m 1)))) (cons (m 'before) l)) (m 'after))))
         ((null? l) text)
         (else (list 'unquote `(string-append ,@(reverse (cons text l)))))))))
  
  (define (transform sxml)
    ;; (@ ((href "http://localhost") (name "hoge))) のcdrを取り出す
    (define (attributes-ref a)
      (and (not (null? a))
           (eq? '@ (car a))
           (not (null? (cdr a)))
           (cdr a)))
  
    (pre-post-order
     sxml
     `((choose *macro* . ,(lambda (tag a . elems)
                            (and-let* ((attr (attributes-ref a)))
                              (let ((test-exp (read-from-string (cadar attr)))
                                    (then-exp (or (assq 'then elems) '(then "")))
                                    (else-exp (or (assq 'else elems) '(else ""))))
                                (list 'unquote `(if ,test-exp
                                                  ,(list 'quasiquote (cadr then-exp))
                                                  ,(list 'quasiquote (cadr else-exp))))))))
       (foreach *macro* . ,(lambda (tag a . elems)
                             (and-let* ((attr (attributes-ref a)))
                               (let ((item (caar attr))
                                     (items (read-from-string (cadar attr))))
                                 `(unquote-splicing (append-map (lambda (,item)
                                                                  ,(list 'quasiquote elems))
                                                                ,items))))))
       (*PI* . ,(lambda (tag target str)
                  (list 'unquote (read-from-string str))))
       (*text* . ,(lambda (trigger x) 
                    (process-text x)))
       (*default* . ,(lambda x x)))))
  
  (define (eval-sxml env sxml)
    (eval `(let ,env
             ,(list 'quasiquote sxml))
          (interaction-environment)))
  
  (define (template-engine env in)
    (format #t (srl:sxml->html (eval-sxml env (transform (ssax:xml->sxml in '()))))))
  
  (define (main args)
    (define env '((name "Gemma")
                  (items '("apple" "orange" "melon"))
                  (fact (lambda (x) (apply * (iota x 1))))))
  
    (if (null? (cdr args))
      (template-engine env (current-input-port))
      (call-with-input-file (cadr args)
        (lambda (in)
          (template-engine env in)))))
  

  Tags: sxml.tree-trans, SXSLT