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

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

ersatz: added characters to the objects recognized by sexpr->tvalue

File size: 15.7 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 op-trim op-pad
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 string-pad
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   ((char? x)       (Tstr (->string x)))
272   ((symbol? x)     (Tstr (->string x)))
273   ((procedure? x)  (Tfun x))
274   ((vector? x)     (Tset (map sexpr->tvalue (vector->list x))))
275   ((null? x)       (Tlist '()))
276   ((pair? x)
277    (cond
278     ((and (pair? (car x)) (symbol? (car (car x))))
279      (Tobj (map (lambda (x) (cons (car x) (sexpr->tvalue (cdr x)))) x)))
280     (else (Tlist (map sexpr->tvalue x)))))
281   ((tvalue? x)  x)
282   (else (error 'sexpr->tvalue "cannot convert sexpr to tvalue" x))
283   ))
284       
285
286(define (tvalue->sexpr x)
287  (cases tvalue x 
288         (Tnull ()     '(tnull))
289         (Tint  (i)    i)
290         (Tbool  (b)   b)
291         (Tfloat (n)   n)
292         (Tstr   (s)   s)
293         (Tobj   (fs)  (map (lambda (x) (cons (car x) (tvalue->sexpr (cdr x)))) fs))
294         (Tlist  (vs)  (map tvalue->sexpr vs))
295         (Tset   (vs)  (vector->list (map tvalue->sexpr vs)))
296         (Tfun   (p)   p)
297         ))
298
299
300
301;; Template function arguments
302;;
303;;   Arguments of template functions are defined as "tvalue list".
304;;   The filtered target is the LAST argument of filter function.
305;;
306;;   For example, consider the following expansion of "x" with filter
307;;   function "foo" (with no keyword arguments) {{x|foo(10,20)}}
308;;
309;;   The filter function "foo" takes 3 arguments, and internally is
310;;   evaluated like this:
311;;
312;;   (foo 10 20 x)
313
314(define tfun-args? tvalue-list?) 
315 
316;;  Template function keyword arguments
317;;  Keyword arguments of function are defined as (string * tvalue) list.
318
319(define tfun-kwargs? tvalue-alist?) 
320
321
322(define-datatype tstmt tstmt?
323  (TextStatement   (s string?))
324
325  (ExpandStatement (e texpr?))
326
327  (IfStatement     (cb (list-of template-cond-clause?))
328                   (el template-ast?))
329
330  (ForStatement    (e1 texpr?)
331                   (e2 texpr?)
332                   (a  template-ast?))
333
334  (IncludeStatement (s string?) (wcontext boolean?))
335
336  (ExtendsStatement (s string?))
337
338  (ImportStatement  (s string?) 
339                    (w (lambda (x) (or (not x) (symbol? x)))))
340
341  (FromImportStatement (s string?)
342                       (w (list-of texpr?)))
343
344  (SetStatement (e1 texpr?)
345                (e2 texpr?))
346
347  (BlockStatement  (e texpr?) (f (lambda (x) (or (not x) (texpr? x))))
348                   (b template-ast?))
349
350  (MacroStatement  (e texpr?) 
351                   (a (list-of texpr?))
352                   (b template-ast?))
353
354  (FilterStatement (e texpr?) 
355                   (b template-ast?))
356
357  (CallStatement (e texpr?) 
358                 (a1 (list-of texpr?))
359                 (a2 (list-of texpr?) )
360                 (b template-ast?))
361
362  (WithStatement (es (list-of texpr?)) 
363                 (b template-ast?))
364
365  (AutoEscapeStatement (e texpr?) 
366                       (b template-ast?))
367  )
368
369
370
371(define macro-code? (list-of tstmt?))
372
373(define-datatype texpr texpr?
374
375  (IdentExpr       (s symbol?))
376  (LiteralExpr     (v tvalue?))
377  (NotOpExpr       (e texpr?))
378  (NegativeOpExpr  (e texpr?))
379  (PlusOpExpr      (e1 texpr?) (e2 texpr?))
380  (MinusOpExpr     (e1 texpr?) (e2 texpr?))
381  (TimesOpExpr     (e1 texpr?) (e2 texpr?))
382  (PowerOpExpr     (e1 texpr?) (e2 texpr?))
383  (DivOpExpr       (e1 texpr?) (e2 texpr?))
384  (ModOpExpr       (e1 texpr?) (e2 texpr?))
385  (AndOpExpr       (e1 texpr?) (e2 texpr?))
386  (OrOpExpr        (e1 texpr?) (e2 texpr?))
387  (NotEqOpExpr     (e1 texpr?) (e2 texpr?))
388  (EqEqOpExpr      (e1 texpr?) (e2 texpr?))
389  (LtOpExpr        (e1 texpr?) (e2 texpr?))
390  (GtOpExpr        (e1 texpr?) (e2 texpr?))
391  (LtEqOpExpr      (e1 texpr?) (e2 texpr?))
392  (GtEqOpExpr      (e1 texpr?) (e2 texpr?))
393  (DotExpr         (e1 texpr?) (e2 texpr?))
394  (ApplyExpr       (e texpr?) (a (list-of texpr?)))
395  (ListExpr        (xs (list-of texpr?)))
396  (SetExpr         (xs (list-of texpr?)))
397  (ObjExpr         (xs (list-of expression-pair?)))
398  (TestOpExpr      (e1 texpr?) (e2 texpr?))
399  (KeywordExpr     (e1 texpr?) (e2 texpr?))
400  (AliasExpr       (e1 texpr?) (e2 texpr?))
401  (InOpExpr        (e1 texpr?) (e2 texpr?))
402  )
403
404(define (expression-pair? x) (and (texpr? (car x)) (texpr? (cdr x))))
405
406(define template-ast? (list-of tstmt?))
407
408(define (template-cond-clause? x) 
409  (and (texpr? (car x)) (template-ast? (cdr x))))
410
411
412(define (template-std-env #!key 
413                          (autoescape #t) 
414                          (search-path '()) 
415                          (filters '()) 
416                          (lexer-table default-ersatz-lexer-table) 
417                          )
418  (make-template-environment
419   autoescape search-path filters lexer-table)
420  )
421
422
423(include "runtime.scm")
424
425;(define default-ersatz-lexer-table)
426
427(define top-frame 
428  `(
429    ;; built-in filters
430    (abs        . ,(func-arg1 op-abs))
431    (capitalize . ,(func-arg1 op-capitalize))
432    (escape     . ,(func-arg1 op-escape-html))
433    (e          . ,(func-arg1 op-escape-html)) ;; alias for escape
434    (float      . ,(func-arg1 op-tofloat))
435    (int        . ,(func-arg1 op-toint))
436    (first      . ,(func-arg1 op-first))
437    (last       . ,(func-arg1 op-last))
438    (length     . ,(func-arg1 op-length))
439    (list       . ,(func-arg1 op-list))
440    (lower      . ,(func-arg1 op-lower))
441    (safe       . ,(func-arg1 op-safe))
442    (strlen     . ,(func-arg1 op-strlen))
443    (striptags  . ,(func-arg1 op-striptags))
444    (sort       . ,(func-arg1 op-sort))
445    (dict       . ,(func-arg1 op-dict))
446    (upper      . ,(func-arg1 op-upper))
447    (reverse    . ,(func-arg1 op-reverse))
448    (append     . ,(func-arg2 op-append))
449    (cons       . ,(func-arg2 op-cons))
450    (title      . ,(func-arg1 op-title))
451    (trim       . ,(func-arg1 op-trim))
452    (pad        . ,(func-arg2 op-pad))
453    (urlize     . ,(func-arg1 op-urlize))
454    (wordcount  . ,(func-arg1 op-wordcount))
455   
456    (attr    . ,(func-arg2 op-attr))
457    (batch   . ,(func-arg2 op-batch))
458    (default . ,(func-arg2 op-default))
459    (d       . ,(func-arg2 op-default)) ;; alias for default
460    (join    . ,(func-arg2 op-join))
461    (split   . ,(func-arg2 op-split))
462    (slice   . ,(func-arg2 op-slice))
463    (truncate . ,(func-arg2 op-truncate))
464    (range   . ,(func-arg2 op-range))
465    (round   . ,(func-arg2 op-round))
466   
467    (replace   . ,(func-arg3 op-replace))
468    (substring . ,(func-arg3 op-substring))
469    (sublist   . ,(func-arg3 op-sublist))
470
471    (groupBy   . ,(func-arg2 op-group-by))
472   
473    ;; built-in tests
474    (divisibleby . ,(func-arg2 test-divisibleby))
475    (even        . ,(func-arg1 test-even))
476    (iterable    . ,(func-arg1 test-iterable))
477    (lower       . ,(func-arg1 test-lower))
478    (number      . ,(func-arg1 test-number))
479    (odd         . ,(func-arg1 test-odd))
480    (sameas      . ,(func-arg2 test-sameas))
481    (sequence    . ,(func-arg1 test-sequence))
482    (string      . ,(func-arg1 test-string))
483    (upper       . ,(func-arg1 test-upper))
484    ))
485
486
487(define (init-context #!key 
488                      (env (template-std-env)) 
489                      (models '())
490                      (open-buffer open-output-string)
491                      )
492  (let ((env-values 
493         `((is_autoescape . ,(Tbool (and (tmpl-env-autoescape env) #t))))))
494    (make-template-context 
495     (list (append env-values models)
496           (append (tmpl-env-filters env) 
497                   top-frame)) ;; frame-stack
498     '() ;; macro-table
499     '() ;; filter-table
500     (open-buffer) ;; buffer
501     )))
502
503
504(include "make-ersatz-lexer.scm")
505(include "parser.scm")
506(include "eval.scm")
507
508
509
510(define (from-file fn #!key
511                   (env (template-std-env))
512                   (models '())
513                   (ctx #f))
514  (eval-statements (statements-from-file env fn)
515                   env: env models: models ctx: ctx))
516
517
518(define (from-string source #!key
519                     (env (template-std-env))
520                     (models '())
521                     (ctx #f))
522  (eval-statements (statements-from-string env source)
523                   env: env models: models ctx: ctx))
524
525
526)
Note: See TracBrowser for help on using the repository browser.