source: project/release/4/ersatz/trunk/ersatz-lib.scm @ 26863

Last change on this file since 26863 was 26863, checked in by Ivan Raikov, 9 years ago

ersatz: implement a procedure for easy creation of custom lexers and added tests

File size: 12.2 KB
Line 
1;;
2;;
3;;  The Ersatz template library.
4;;
5;;  Based on the Ocaml Jingoo library by Masaki WATANABE., which is in
6;;  turn based on the Python Jinja2 library.
7;;
8;; Copyright 2012 Ivan Raikov and the Okinawa Institute of
9;; Science and Technology.
10;;
11;; This program is free software: you can redistribute it and/or
12;; modify it under the terms of the GNU General Public License as
13;; published by the Free Software Foundation, either version 3 of the
14;; License, or (at your option) any later version.
15;;
16;; This program is distributed in the hope that it will be useful, but
17;; WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19;; General Public License for more details.
20;;
21;; A full copy of the GPL license can be found at
22;; <http://www.gnu.org/licenses/>.
23;;
24
25(module ersatz-lib
26
27        (
28         from-string from-file
29         eval-expr eval-statement
30         template-std-env init-context
31
32         template-environment? make-template-environment make-lexer-table keep-lexer-table
33         tmpl-env-autoescape tmpl-env-search-path tmpl-env-filters tmpl-env-lexer-table
34         template-context? make-template-context
35         tmpl-ctx-frame-stack tmpl-ctx-macro-table tmpl-ctx-filter-table tmpl-ctx-buffer
36         template-context-frame? 
37         template-macro? make-template-macro 
38         tmpl-mac-args tmpl-mac-defaults tmpl-mac-code
39         macro-code?
40         tvalue? Tnull Tint Tbool Tfloat Tstr Tobj Tlist Tset Tfun 
41         tstmt? TextStatement ExpandStatement IfStatement ForStatement IncludeStatement
42         ExtendsStatement ImportStatement FromImportStatement SetStatement BlockStatement
43         MacroStatement FilterStatement CallStatement WithStatement AutoEscapeStatement
44         texpr? IdentExpr LiteralExpr NotOpExpr NegativeOpExpr PlusOpExpr MinusOpExpr
45         TimesOpExpr PowerOpExpr DivOpExpr ModOpExpr AndOpExpr OrOpExpr NotEqOpExpr EqEqOpExpr 
46         LtOpExpr GtOpExpr  LtEqOpExpr GtEqOpExpr DotExpr ApplyExpr ListExpr SetExpr ObjExpr     
47         TestOpExpr KeywordExpr AliasExpr InOpExpr   
48
49         eq-eq list-same obj-same
50
51         op-default op-length op-reverse op-last op-slice
52         op-plus op-minus op-times op-power op-div op-mod
53         op-abs op-round op-range op-toint op-tofloat
54         op-or op-and
55         op-upper op-lower op-join op-substring
56         op-replace op-truncate
57         op-capitalize op-title op-escape-html op-urlize op-striptags 
58         op-wordcount op-sort op-dictsort
59         op-list op-sublist
60         )
61
62        (import scheme chicken)
63        (import (only srfi-1 every any drop fold find filter take last)
64                (only irregex string->irregex sre->irregex irregex-search irregex-split irregex-replace/all irregex-match-num-submatches
65                      irregex-match-start-index)
66                (only data-structures alist-ref compose ->string string-split conc sort intersperse identity )
67                (only posix current-directory)
68                (only files make-pathname)
69                (only extras fprintf sprintf pp)
70                (only utils read-all)
71                )
72
73        (require-extension datatype lalr lalr-driver uri-generic)
74        (require-library setup-api utf8 utf8-srfi-13 utf8-srfi-14 silex)
75       
76        (import (only utf8 string-length substring)
77                (only utf8-srfi-13 string-null? string-every string-upcase
78                      string-downcase string-titlecase string-concatenate string-trim-both
79                      string-ci< string<)
80                (only utf8-srfi-14 char-set:lower-case char-set:upper-case char-set:whitespace 
81                      char-set char-set->string)
82                (only silex lex-tables lexer-make-IS lexer-make-lexer )
83                (only setup-api run execute)
84                )
85
86;;
87;; template environment
88;;
89;;  autoescape    : if true or a procedure, template variables are auto escaped when output
90;;  search-path   : search path list; if empty, search current directory only
91;;  filters       : user-defined filters
92;;  lexer-table   : lexical analyzer table to be used (allowing for customizable syntax)
93
94(define-record-type template-environment
95  (make-template-environment  autoescape search-path filters lexer-table )
96  template-environment?
97  (autoescape          tmpl-env-autoescape)
98  (search-path         tmpl-env-search-path)
99  (filters             tmpl-env-filters)
100  (lexer-table         tmpl-env-lexer-table)
101  )
102
103
104
105;;
106;; template context
107;;
108
109(define-record-type template-context
110  (make-template-context frame-stack macro-table filter-table buffer)
111  template-context?
112  (frame-stack   tmpl-ctx-frame-stack)
113  (macro-table   tmpl-ctx-macro-table)
114  (filter-table  tmpl-ctx-filter-table)
115  (buffer        tmpl-ctx-buffer))
116
117
118(define (template-context-frame? lst) 
119  (every (lambda (x) (and (string? (car x)) (tvalue? (cdr x)))) lst))
120
121
122(define-record-type template-macro
123  (make-template-macro args defaults code) 
124  template-macro?
125  (args     tmpl-mac-args)
126  (defaults tmpl-mac-defaults)
127  (code     tmpl-mac-code))
128
129
130(define (list-of pred)
131  (lambda (lst) (every pred lst)))
132
133
134
135(define-datatype tvalue tvalue?
136  (Tnull)
137  (Tint   (i integer?))
138  (Tbool  (b boolean?))
139  (Tfloat (n number?)) 
140  (Tstr   (s string?))
141  (Tobj   (x tvalue-alist?))
142  (Tlist  (x tvalue-list?))
143  (Tset   (x tvalue-list?))
144  (Tfun   (p procedure?)))
145
146
147(define (tvalue-stringp v)
148  (cases tvalue v
149         (Tstr (s) (Tbool #t))
150         (else (Tbool #f))))
151 
152
153(define (tvalue-intp v)
154  (cases tvalue v
155         (Tint (i) (Tbool #t))
156         (else (Tbool #f))))
157 
158
159(define (tvalue-floatp v)
160  (cases tvalue v
161         (Tfloat (i) (Tbool #t))
162         (else (Tbool #f))))
163 
164
165(define (tvalue-listp v)
166  (cases tvalue v
167         (Tlist (l) (Tbool #t))
168         (else (Tbool #f))))
169 
170
171(define (tvalue-setp v)
172  (cases tvalue v
173         (Tset (l) (Tbool #t))
174         (else (Tbool #f))))
175 
176
177(define (tvalue-objp v)
178  (cases tvalue v
179         (Tobj (l) (Tbool #t))
180         (else (Tbool #f))))
181 
182
183(define (tvalue-funp v)
184  (cases tvalue v
185         (Tfun (f) (Tbool #t))
186         (else (Tbool #f))))
187 
188
189(define tvalue-alist?
190  (list-of (lambda (x) (and (symbol? (car x)) (tvalue? (cdr x))))))
191
192
193(define tvalue-list? (list-of tvalue?))
194
195
196(define-record-printer (tvalue x out)
197  (cases tvalue x
198         (Tnull ()   (fprintf out "<null>"))
199         (Tint   (i) (fprintf out "~A" i))
200         (Tbool  (b) (fprintf out "~A" (if b "true" "false")))
201         (Tfloat (n) (fprintf out "~A" n))
202         (Tstr   (s) (fprintf out "~A" s))
203         (Tobj   (x) (fprintf out "<obj>"))
204         (Tlist  (x) (fprintf out "<list>"))
205         (Tset   (x) (fprintf out "<set>"))
206         (Tfun   (x) (fprintf out "<function>"))
207         ))
208
209 
210(define (type-string-of-tvalue v)
211  (cases tvalue v
212         (Tnull ()   "null")
213         (Tint   (i) "int")
214         (Tbool  (b) "bool")
215         (Tfloat (n) "float")
216         (Tstr   (s) "string")
217         (Tobj   (x) "obj")
218         (Tlist  (x) "list")
219         (Tset   (x) "set")
220         (Tfun   (x) "function")
221         ))
222
223
224;; Template function arguments
225;;
226;;   Arguments of template functions are defined as "tvalue list".
227;;   The filtered target is the LAST argument of filter function.
228;;
229;;   For example, consider the following expansion of "x" with filter
230;;   function "foo" (with no keyword arguments) {{x|foo(10,20)}}
231;;
232;;   The filter function "foo" takes 3 arguments, and internally is
233;;   evaluated like this:
234;;
235;;   (foo 10 20 x)
236
237(define tfun-args? tvalue-list?) 
238 
239;;  Template function keyword arguments
240;;  Keyword arguments of function are defined as (string * tvalue) list.
241
242(define tfun-kwargs? tvalue-alist?) 
243
244
245(define-datatype tstmt tstmt?
246  (TextStatement   (s string?))
247
248  (ExpandStatement (e texpr?))
249
250  (IfStatement     (cb (list-of template-cond-clause?))
251                   (el template-ast?))
252
253  (ForStatement    (e1 texpr?)
254                   (e2 texpr?)
255                   (a  template-ast?))
256
257  (IncludeStatement (s string?) (wcontext boolean?))
258
259  (ExtendsStatement (s string?))
260
261  (ImportStatement  (s string?) 
262                    (w (lambda (x) (or (not x) (string? x)))))
263
264  (FromImportStatement (s string?)
265                       (w (list-of texpr?)))
266
267  (SetStatement (e1 texpr?)
268                (e2 texpr?))
269
270  (BlockStatement  (e texpr?) 
271                   (b template-ast?))
272
273  (MacroStatement  (e texpr?) 
274                   (a (list-of texpr?))
275                   (b template-ast?))
276
277  (FilterStatement (e texpr?) 
278                   (b template-ast?))
279
280  (CallStatement (e texpr?) 
281                 (a1 (list-of texpr?))
282                 (a2 (list-of texpr?) )
283                 (b template-ast?))
284
285  (WithStatement (es (list-of texpr?)) 
286                 (b template-ast?))
287
288  (AutoEscapeStatement (e texpr?) 
289                       (b template-ast?))
290  )
291
292
293
294(define macro-code? (list-of tstmt?))
295
296(define-datatype texpr texpr?
297
298  (IdentExpr       (s symbol?))
299  (LiteralExpr     (v tvalue?))
300  (NotOpExpr       (e texpr?))
301  (NegativeOpExpr  (e texpr?))
302  (PlusOpExpr      (e1 texpr?) (e2 texpr?))
303  (MinusOpExpr     (e1 texpr?) (e2 texpr?))
304  (TimesOpExpr     (e1 texpr?) (e2 texpr?))
305  (PowerOpExpr     (e1 texpr?) (e2 texpr?))
306  (DivOpExpr       (e1 texpr?) (e2 texpr?))
307  (ModOpExpr       (e1 texpr?) (e2 texpr?))
308  (AndOpExpr       (e1 texpr?) (e2 texpr?))
309  (OrOpExpr        (e1 texpr?) (e2 texpr?))
310  (NotEqOpExpr     (e1 texpr?) (e2 texpr?))
311  (EqEqOpExpr      (e1 texpr?) (e2 texpr?))
312  (LtOpExpr        (e1 texpr?) (e2 texpr?))
313  (GtOpExpr        (e1 texpr?) (e2 texpr?))
314  (LtEqOpExpr      (e1 texpr?) (e2 texpr?))
315  (GtEqOpExpr      (e1 texpr?) (e2 texpr?))
316  (DotExpr         (e1 texpr?) (e2 texpr?))
317  (ApplyExpr       (e texpr?) (a (list-of texpr?)))
318  (ListExpr        (xs (list-of texpr?)))
319  (SetExpr         (xs (list-of texpr?)))
320  (ObjExpr         (xs (list-of expression-pair?)))
321  (TestOpExpr      (e1 texpr?) (e2 texpr?))
322  (KeywordExpr     (e1 texpr?) (e2 texpr?))
323  (AliasExpr       (e1 texpr?) (e2 texpr?))
324  (InOpExpr        (e1 texpr?) (e2 texpr?))
325  )
326
327(define (expression-pair? x) (and (texpr? (car x)) (texpr? (cdr x))))
328
329(define template-ast? (list-of tstmt?))
330
331(define (template-cond-clause? x) 
332  (and (texpr? (car x)) (template-ast? (cdr x))))
333
334
335(define (template-std-env #!key (autoescape #t) 
336                          (search-path '()) 
337                          (filters '()) 
338                          (lexer-table default-ersatz-lexer-table) )
339  (make-template-environment
340   autoescape search-path filters lexer-table)
341  )
342
343
344(include "runtime.scm")
345
346;(define default-ersatz-lexer-table)
347
348(define top-frame 
349  `(
350    ;; built-in filters
351    (abs        . ,(func-arg1 op-abs))
352    (capitalize . ,(func-arg1 op-capitalize))
353    (escape     . ,(func-arg1 op-escape-html))
354    (e          . ,(func-arg1 op-escape-html)) ;; alias for escape
355    (float      . ,(func-arg1 op-tofloat))
356    (int        . ,(func-arg1 op-toint))
357    (last       . ,(func-arg1 op-last))
358    (length     . ,(func-arg1 op-length))
359    (list       . ,(func-arg1 op-list))
360    (lower      . ,(func-arg1 op-lower))
361    (safe       . ,(func-arg1 op-safe))
362    (strlen     . ,(func-arg1 op-strlen))
363    (striptags  . ,(func-arg1 op-striptags))
364    (sort       . ,(func-arg1 op-sort))
365    (upper      . ,(func-arg1 op-upper))
366    (reverse    . ,(func-arg1 op-reverse))
367    (title      . ,(func-arg1 op-title))
368    (trim       . ,(func-arg1 op-trim))
369    (urlize     . ,(func-arg1 op-urlize))
370   
371    (attr    . ,(func-arg2 op-attr))
372    (batch   . ,(func-arg2 op-batch))
373    (default . ,(func-arg2 op-default))
374    (d       . ,(func-arg2 op-default)) ;; alias for default
375    (join    . ,(func-arg2 op-join))
376    (split   . ,(func-arg2 op-split))
377    (slice   . ,(func-arg2 op-slice))
378    (truncate . ,(func-arg2 op-truncate))
379    (range   . ,(func-arg2 op-range))
380    (round   . ,(func-arg2 op-round))
381   
382    (replace   . ,(func-arg3 op-replace))
383    (substring . ,(func-arg3 op-substring))
384    (sublist   . ,(func-arg3 op-sublist))
385   
386    ;; built-in tests
387    (divisibleby . ,(func-arg2 test-divisibleby))
388    (even        . ,(func-arg1 test-even))
389    (iterable    . ,(func-arg1 test-iterable))
390    (lower       . ,(func-arg1 test-lower))
391    (number      . ,(func-arg1 test-number))
392    (odd         . ,(func-arg1 test-odd))
393    (sameas      . ,(func-arg2 test-sameas))
394    (sequence    . ,(func-arg1 test-sequence))
395    (string      . ,(func-arg1 test-string))
396    (upper       . ,(func-arg1 test-upper))
397    ))
398
399
400(define (init-context  #!key (env (template-std-env)) (models '()))
401  (let ((env-values 
402         `((is_autoescape . ,(Tbool (and (tmpl-env-autoescape env) #t))))))
403    (make-template-context 
404     (list models (append (tmpl-env-filters env) top-frame)) ;; frame-stack
405     '() ;; macro-table
406     '() ;; filter-table
407     (open-output-string) ;; buffer
408     )))
409
410
411(include "make-ersatz-lexer.scm")
412(include "parser.scm")
413(include "eval.scm")
414
415
416
417(define (from-file fn #!key
418                   (env (template-std-env))
419                   (models '())
420                   (ctx #f))
421  (eval-statements (statements-from-file env fn)
422                   env: env models: models ctx: ctx))
423
424
425(define (from-string source #!key
426                     (env (template-std-env))
427                     (models '())
428                     (ctx #f))
429  (eval-statements (statements-from-string env source)
430                   env: env models: models ctx: ctx))
431
432
433)
Note: See TracBrowser for help on using the repository browser.