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

Last change on this file since 31371 was 31371, checked in by Ivan Raikov, 5 years ago

ersatz release 1.13

File size: 15.6 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-2014 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         statements-from-string statements-from-file
30         eval-expr eval-statement eval-statements
31         template-std-env init-context
32
33         keep-lexer-table lexer-trace
34
35         template-environment? make-template-environment make-lexer-table 
36         tmpl-env-autoescape tmpl-env-search-path tmpl-env-filters tmpl-env-lexer-table
37         
38         template-context? make-template-context
39         tmpl-ctx-frame-stack tmpl-ctx-macro-table tmpl-ctx-filter-table tmpl-ctx-buffer
40         
41         template-context-frame? 
42
43         template-macro? make-template-macro 
44         tmpl-mac-args tmpl-mac-defaults tmpl-mac-code
45         macro-code?
46         
47         tvalue? Tnull Tint Tbool Tfloat Tstr Tobj Tlist Tset Tfun 
48         sexpr->tvalue tvalue->sexpr
49         
50         tstmt? TextStatement ExpandStatement IfStatement ForStatement IncludeStatement
51         ExtendsStatement ImportStatement FromImportStatement SetStatement BlockStatement
52         MacroStatement FilterStatement CallStatement WithStatement AutoEscapeStatement
53         texpr? IdentExpr LiteralExpr NotOpExpr NegativeOpExpr PlusOpExpr MinusOpExpr
54         TimesOpExpr PowerOpExpr DivOpExpr ModOpExpr AndOpExpr OrOpExpr NotEqOpExpr EqEqOpExpr 
55         LtOpExpr GtOpExpr  LtEqOpExpr GtEqOpExpr DotExpr ApplyExpr ListExpr SetExpr ObjExpr     
56         TestOpExpr KeywordExpr AliasExpr InOpExpr   
57
58         eq-eq list-same obj-same
59
60         op-default op-length op-reverse op-append op-cons op-first op-last op-slice
61         op-plus op-minus op-times op-power op-div op-mod
62         op-abs op-round op-range op-toint op-tofloat
63         op-or op-and
64         op-upper op-lower op-join op-substring
65         op-replace op-truncate
66         op-capitalize op-title op-escape-html op-urlize op-striptags 
67         op-wordcount op-sort op-dictsort
68         op-list op-sublist op-group-by
69         )
70
71        (import scheme chicken)
72        (import (only srfi-1 every any drop fold find filter take last first)
73                (only irregex string->irregex sre->irregex irregex-search irregex-split irregex-replace/all irregex-match-num-submatches
74                      irregex-match-start-index)
75                (only data-structures alist-ref compose ->string string-split conc sort intersperse identity )
76                (only posix current-directory)
77                (only files make-pathname)
78                (only extras fprintf sprintf pp)
79                (only utils read-all)
80                )
81
82        (require-extension datatype lalr lalr-driver uri-generic)
83        (require-library setup-api utf8 utf8-srfi-13 utf8-srfi-14 silex)
84       
85        (import (only utf8 string-length substring)
86                (only utf8-srfi-13 string-null? string-every string-upcase
87                      string-downcase string-titlecase string-concatenate string-trim-both
88                      string-ci< string<)
89                (only utf8-srfi-14 char-set:lower-case char-set:upper-case char-set:whitespace 
90                      char-set char-set->string char-set-contains?)
91                (only silex lex-tables lexer-make-IS lexer-make-lexer )
92                (only setup-api run execute)
93                )
94
95;;
96;; template environment
97;;
98;;  autoescape    : if true or a procedure, template variables are auto escaped when output
99;;  search-path   : search path list; if empty, search current directory only
100;;  filters       : user-defined filters
101;;  lexer-table   : lexical analyzer table to be used (allowing for customizable syntax)
102
103(define-record-type template-environment
104  (make-template-environment  autoescape search-path filters lexer-table )
105  template-environment?
106  (autoescape          tmpl-env-autoescape)
107  (search-path         tmpl-env-search-path)
108  (filters             tmpl-env-filters)
109  (lexer-table         tmpl-env-lexer-table)
110  )
111
112
113
114;;
115;; template context
116;;
117
118(define-record-type template-context
119  (make-template-context frame-stack macro-table filter-table buffer)
120  template-context?
121  (frame-stack   tmpl-ctx-frame-stack)
122  (macro-table   tmpl-ctx-macro-table)
123  (filter-table  tmpl-ctx-filter-table)
124  (buffer        tmpl-ctx-buffer))
125
126
127(define (template-context-frame? lst) 
128  (every (lambda (x) (and (string? (car x)) (tvalue? (cdr x)))) lst))
129
130
131(define-record-type template-macro
132  (make-template-macro args defaults code) 
133  template-macro?
134  (args     tmpl-mac-args)
135  (defaults tmpl-mac-defaults)
136  (code     tmpl-mac-code))
137
138
139(define (list-of pred)
140  (lambda (lst) (every pred lst)))
141
142
143
144(define-datatype tvalue tvalue?
145  (Tnull)
146  (Tint   (i integer?))
147  (Tbool  (b boolean?))
148  (Tfloat (n number?)) 
149  (Tstr   (s string?))
150  (Tobj   (x tvalue-alist?))
151  (Tlist  (x tvalue-list?))
152  (Tset   (x tvalue-list?))
153  (Tfun   (p procedure?)))
154
155
156(define (tvalue-stringp v)
157  (cases tvalue v
158         (Tstr (s) (Tbool #t))
159         (else (Tbool #f))))
160 
161
162(define (tvalue-intp v)
163  (cases tvalue v
164         (Tint (i) (Tbool #t))
165         (else (Tbool #f))))
166 
167
168(define (tvalue-floatp v)
169  (cases tvalue v
170         (Tfloat (i) (Tbool #t))
171         (else (Tbool #f))))
172 
173
174(define (tvalue-listp v)
175  (cases tvalue v
176         (Tlist (l) (Tbool #t))
177         (else (Tbool #f))))
178 
179
180(define (tvalue-setp v)
181  (cases tvalue v
182         (Tset (l) (Tbool #t))
183         (else (Tbool #f))))
184 
185
186(define (tvalue-objp v)
187  (cases tvalue v
188         (Tobj (l) (Tbool #t))
189         (else (Tbool #f))))
190 
191
192(define (tvalue-funp v)
193  (cases tvalue v
194         (Tfun (f) (Tbool #t))
195         (else (Tbool #f))))
196 
197
198(define tvalue-alist?
199  (list-of (lambda (x) (and (symbol? (car x)) (tvalue? (cdr x))))))
200
201
202(define tvalue-list? (list-of tvalue?))
203
204
205
206
207(define-record-printer (tvalue x out)
208  (cases tvalue x
209         (Tnull ()   (fprintf out "<null>"))
210         (Tint   (i) (fprintf out "~A" i))
211         (Tbool  (b) (fprintf out "~A" (if b "true" "false")))
212         (Tfloat (n) (fprintf out "~A" n))
213         (Tstr   (s) (fprintf out "~A" s))
214         (Tobj   (x) (fprintf out "<obj>"))
215         (Tlist  (x) (fprintf out "<list>"))
216         (Tset   (x) (fprintf out "<set>"))
217         (Tfun   (x) (fprintf out "<function>"))
218         ))
219
220(define-record-printer (texpr x out)
221  (cases texpr x
222         (IdentExpr (s)   (fprintf out "Ident(~A)" s))
223         (LiteralExpr (v) (fprintf out "Literal (~A)" v))
224         (NotOpExpr       (e) (fprintf out "Not (~A)" e))
225         (NegativeOpExpr  (e) (fprintf out "Neg (~A)" e))
226         (PlusOpExpr      (e1 e2) (fprintf out "Plus (~A,~A)" e1 e2))
227         (MinusOpExpr     (e1 e2) (fprintf out "Minus (~A,~A)" e1 e2))
228         (TimesOpExpr     (e1 e2) (fprintf out "Times (~A,~A)" e1 e2))
229         (PowerOpExpr     (e1 e2) (fprintf out "Power (~A,~A)" e1 e2))
230         (DivOpExpr       (e1 e2) (fprintf out "Div (~A,~A)" e1 e2))
231         (ModOpExpr       (e1 e2) (fprintf out "Mod (~A,~A)" e1 e2))
232         (AndOpExpr       (e1 e2) (fprintf out "And (~A,~A)" e1 e2))
233         (OrOpExpr        (e1 e2) (fprintf out "Or (~A,~A)" e1 e2))
234         (NotEqOpExpr     (e1 e2) (fprintf out "Neq (~A,~A)" e1 e2))
235         (EqEqOpExpr      (e1 e2) (fprintf out "Eq (~A,~A)" e1 e2))
236         (LtOpExpr        (e1 e2) (fprintf out "Lt (~A,~A)" e1 e2))
237         (GtOpExpr        (e1 e2) (fprintf out "PGt (~A,~A)" e1 e2))
238         (LtEqOpExpr      (e1 e2) (fprintf out "LtEq (~A,~A)" e1 e2))
239         (GtEqOpExpr      (e1 e2) (fprintf out "GtEq (~A,~A)" e1 e2))
240         (DotExpr         (e1 e2) (fprintf out "Dot (~A,~A)" e1 e2))
241         (ApplyExpr       (e a) (fprintf out "Apply (~A,~A)" e a))
242         (ListExpr        (xs) (fprintf out "List (~A)" xs))
243         (SetExpr         (xs) (fprintf out "Set (~A)" xs))
244         (ObjExpr         (xs) (fprintf out "Obj (~A)" xs))
245         (TestOpExpr      (e1 e2) (fprintf out "Test (~A,~A)" e1 e2))
246         (KeywordExpr     (e1 e2) (fprintf out "Keyword (~A,~A)" e1 e2))
247         (AliasExpr       (e1 e2) (fprintf out "Alias (~A,~A)" e1 e2))
248         (InOpExpr        (e1 e2) (fprintf out "In (~A,~A)" e1 e2))
249         ))
250
251 
252(define (type-string-of-tvalue v)
253  (cases tvalue v
254         (Tnull ()   "null")
255         (Tint   (i) "int")
256         (Tbool  (b) "bool")
257         (Tfloat (n) "float")
258         (Tstr   (s) "string")
259         (Tobj   (x) "obj")
260         (Tlist  (x) "list")
261         (Tset   (x) "set")
262         (Tfun   (x) "function")
263         ))
264
265(define (sexpr->tvalue x)
266  (cond
267   ((boolean? x)    (Tbool x))
268   ((integer? x)    (Tint x))
269   ((number? x)     (Tfloat x))
270   ((string? x)     (Tstr x))
271   ((symbol? x)     (Tstr (->string x)))
272   ((procedure? x)  (Tfun x))
273   ((vector? x)     (Tset (map sexpr->tvalue (vector->list x))))
274   ((pair? x)
275    (cond
276     ((eq? x '(tnull)) (Tnull))
277     ((and (pair? (car x)) (symbol? (car (car x))))
278      (Tobj (map (lambda (x) (cons (car x) (sexpr->tvalue (cdr x)))) x)))
279     (else (Tlist (map sexpr->tvalue x)))))
280   ((tvalue? x)  x)
281   (else (error 'sexpr->tvalue "cannot convert sexpr to tvalue" x))
282   ))
283       
284
285(define (tvalue->sexpr x)
286  (cases tvalue x 
287         (Tnull ()     '(tnull))
288         (Tint  (i)    i)
289         (Tbool  (b)   b)
290         (Tfloat (n)   n)
291         (Tstr   (s)   s)
292         (Tobj   (fs)  (map (lambda (x) (cons (car x) (tvalue->sexpr (cdr x)))) fs))
293         (Tlist  (vs)  (map tvalue->sexpr vs))
294         (Tset   (vs)  (vector->list (map tvalue->sexpr vs)))
295         (Tfun   (p)   p)
296         ))
297
298
299
300;; Template function arguments
301;;
302;;   Arguments of template functions are defined as "tvalue list".
303;;   The filtered target is the LAST argument of filter function.
304;;
305;;   For example, consider the following expansion of "x" with filter
306;;   function "foo" (with no keyword arguments) {{x|foo(10,20)}}
307;;
308;;   The filter function "foo" takes 3 arguments, and internally is
309;;   evaluated like this:
310;;
311;;   (foo 10 20 x)
312
313(define tfun-args? tvalue-list?) 
314 
315;;  Template function keyword arguments
316;;  Keyword arguments of function are defined as (string * tvalue) list.
317
318(define tfun-kwargs? tvalue-alist?) 
319
320
321(define-datatype tstmt tstmt?
322  (TextStatement   (s string?))
323
324  (ExpandStatement (e texpr?))
325
326  (IfStatement     (cb (list-of template-cond-clause?))
327                   (el template-ast?))
328
329  (ForStatement    (e1 texpr?)
330                   (e2 texpr?)
331                   (a  template-ast?))
332
333  (IncludeStatement (s string?) (wcontext boolean?))
334
335  (ExtendsStatement (s string?))
336
337  (ImportStatement  (s string?) 
338                    (w (lambda (x) (or (not x) (symbol? x)))))
339
340  (FromImportStatement (s string?)
341                       (w (list-of texpr?)))
342
343  (SetStatement (e1 texpr?)
344                (e2 texpr?))
345
346  (BlockStatement  (e texpr?) (f (lambda (x) (or (not x) (texpr? x))))
347                   (b template-ast?))
348
349  (MacroStatement  (e texpr?) 
350                   (a (list-of texpr?))
351                   (b template-ast?))
352
353  (FilterStatement (e texpr?) 
354                   (b template-ast?))
355
356  (CallStatement (e texpr?) 
357                 (a1 (list-of texpr?))
358                 (a2 (list-of texpr?) )
359                 (b template-ast?))
360
361  (WithStatement (es (list-of texpr?)) 
362                 (b template-ast?))
363
364  (AutoEscapeStatement (e texpr?) 
365                       (b template-ast?))
366  )
367
368
369
370(define macro-code? (list-of tstmt?))
371
372(define-datatype texpr texpr?
373
374  (IdentExpr       (s symbol?))
375  (LiteralExpr     (v tvalue?))
376  (NotOpExpr       (e texpr?))
377  (NegativeOpExpr  (e texpr?))
378  (PlusOpExpr      (e1 texpr?) (e2 texpr?))
379  (MinusOpExpr     (e1 texpr?) (e2 texpr?))
380  (TimesOpExpr     (e1 texpr?) (e2 texpr?))
381  (PowerOpExpr     (e1 texpr?) (e2 texpr?))
382  (DivOpExpr       (e1 texpr?) (e2 texpr?))
383  (ModOpExpr       (e1 texpr?) (e2 texpr?))
384  (AndOpExpr       (e1 texpr?) (e2 texpr?))
385  (OrOpExpr        (e1 texpr?) (e2 texpr?))
386  (NotEqOpExpr     (e1 texpr?) (e2 texpr?))
387  (EqEqOpExpr      (e1 texpr?) (e2 texpr?))
388  (LtOpExpr        (e1 texpr?) (e2 texpr?))
389  (GtOpExpr        (e1 texpr?) (e2 texpr?))
390  (LtEqOpExpr      (e1 texpr?) (e2 texpr?))
391  (GtEqOpExpr      (e1 texpr?) (e2 texpr?))
392  (DotExpr         (e1 texpr?) (e2 texpr?))
393  (ApplyExpr       (e texpr?) (a (list-of texpr?)))
394  (ListExpr        (xs (list-of texpr?)))
395  (SetExpr         (xs (list-of texpr?)))
396  (ObjExpr         (xs (list-of expression-pair?)))
397  (TestOpExpr      (e1 texpr?) (e2 texpr?))
398  (KeywordExpr     (e1 texpr?) (e2 texpr?))
399  (AliasExpr       (e1 texpr?) (e2 texpr?))
400  (InOpExpr        (e1 texpr?) (e2 texpr?))
401  )
402
403(define (expression-pair? x) (and (texpr? (car x)) (texpr? (cdr x))))
404
405(define template-ast? (list-of tstmt?))
406
407(define (template-cond-clause? x) 
408  (and (texpr? (car x)) (template-ast? (cdr x))))
409
410
411(define (template-std-env #!key 
412                          (autoescape #t) 
413                          (search-path '()) 
414                          (filters '()) 
415                          (lexer-table default-ersatz-lexer-table) 
416                          )
417  (make-template-environment
418   autoescape search-path filters lexer-table)
419  )
420
421
422(include "runtime.scm")
423
424;(define default-ersatz-lexer-table)
425
426(define top-frame 
427  `(
428    ;; built-in filters
429    (abs        . ,(func-arg1 op-abs))
430    (capitalize . ,(func-arg1 op-capitalize))
431    (escape     . ,(func-arg1 op-escape-html))
432    (e          . ,(func-arg1 op-escape-html)) ;; alias for escape
433    (float      . ,(func-arg1 op-tofloat))
434    (int        . ,(func-arg1 op-toint))
435    (first      . ,(func-arg1 op-first))
436    (last       . ,(func-arg1 op-last))
437    (length     . ,(func-arg1 op-length))
438    (list       . ,(func-arg1 op-list))
439    (lower      . ,(func-arg1 op-lower))
440    (safe       . ,(func-arg1 op-safe))
441    (strlen     . ,(func-arg1 op-strlen))
442    (striptags  . ,(func-arg1 op-striptags))
443    (sort       . ,(func-arg1 op-sort))
444    (dict       . ,(func-arg1 op-dict))
445    (upper      . ,(func-arg1 op-upper))
446    (reverse    . ,(func-arg1 op-reverse))
447    (append     . ,(func-arg2 op-append))
448    (cons       . ,(func-arg2 op-cons))
449    (title      . ,(func-arg1 op-title))
450    (trim       . ,(func-arg1 op-trim))
451    (urlize     . ,(func-arg1 op-urlize))
452    (wordcount  . ,(func-arg1 op-wordcount))
453   
454    (attr    . ,(func-arg2 op-attr))
455    (batch   . ,(func-arg2 op-batch))
456    (default . ,(func-arg2 op-default))
457    (d       . ,(func-arg2 op-default)) ;; alias for default
458    (join    . ,(func-arg2 op-join))
459    (split   . ,(func-arg2 op-split))
460    (slice   . ,(func-arg2 op-slice))
461    (truncate . ,(func-arg2 op-truncate))
462    (range   . ,(func-arg2 op-range))
463    (round   . ,(func-arg2 op-round))
464   
465    (replace   . ,(func-arg3 op-replace))
466    (substring . ,(func-arg3 op-substring))
467    (sublist   . ,(func-arg3 op-sublist))
468
469    (groupBy   . ,(func-arg2 op-group-by))
470   
471    ;; built-in tests
472    (divisibleby . ,(func-arg2 test-divisibleby))
473    (even        . ,(func-arg1 test-even))
474    (iterable    . ,(func-arg1 test-iterable))
475    (lower       . ,(func-arg1 test-lower))
476    (number      . ,(func-arg1 test-number))
477    (odd         . ,(func-arg1 test-odd))
478    (sameas      . ,(func-arg2 test-sameas))
479    (sequence    . ,(func-arg1 test-sequence))
480    (string      . ,(func-arg1 test-string))
481    (upper       . ,(func-arg1 test-upper))
482    ))
483
484
485(define (init-context #!key 
486                      (env (template-std-env)) 
487                      (models '())
488                      (open-buffer open-output-string)
489                      )
490  (let ((env-values 
491         `((is_autoescape . ,(Tbool (and (tmpl-env-autoescape env) #t))))))
492    (make-template-context 
493     (list (append env-values models)
494           (append (tmpl-env-filters env) 
495                   top-frame)) ;; frame-stack
496     '() ;; macro-table
497     '() ;; filter-table
498     (open-buffer) ;; buffer
499     )))
500
501
502(include "make-ersatz-lexer.scm")
503(include "parser.scm")
504(include "eval.scm")
505
506
507
508(define (from-file fn #!key
509                   (env (template-std-env))
510                   (models '())
511                   (ctx #f))
512  (eval-statements (statements-from-file env fn)
513                   env: env models: models ctx: ctx))
514
515
516(define (from-string source #!key
517                     (env (template-std-env))
518                     (models '())
519                     (ctx #f))
520  (eval-statements (statements-from-string env source)
521                   env: env models: models ctx: ctx))
522
523
524)
Note: See TracBrowser for help on using the repository browser.