extra/http/server/templating/templating.factor

   1 ! Copyright (C) 2005 Alex Chapman
   2 ! Copyright (C) 2006, 2007 Slava Pestov
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: sequences kernel parser namespaces io io.files
   5 io.streams.lines io.streams.string html html.elements
   6 source-files debugger combinators math quotations generic
   7 strings splitting ;
   8
   9 IN: http.server.templating
  10
  11 : templating-vocab ( -- vocab-name ) "http.server.templating" ;
  12
  13 ! See apps/http-server/test/ or libs/furnace/ for template usage
  14 ! examples
  15
  16 ! We use a custom lexer so that %> ends a token even if not
  17 ! followed by whitespace
  18 TUPLE: template-lexer ;
  19
  20 : <template-lexer> ( lines -- lexer )
  21     <lexer> template-lexer construct-delegate ;
  22
  23 M: template-lexer skip-word
  24     [
  25         {
  26             { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
  27             { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
  28             { [ t ] [ [ blank? ] skip ] }
  29         } cond
  30     ] change-column ;
  31
  32 DEFER: <% delimiter
  33
  34 : check-<% ( lexer -- col )
  35     "<%" over line-text rot lexer-column start* ;
  36
  37 : found-<% ( accum lexer col -- accum )
  38     [
  39         over line-text >r >r lexer-column r> r> subseq parsed
  40         \ write-html parsed
  41     ] 2keep 2 + swap set-lexer-column ;
  42
  43 : still-looking ( accum lexer -- accum )
  44     [
  45         dup line-text swap lexer-column tail
  46         parsed \ print-html parsed
  47     ] keep next-line ;
  48
  49 : parse-%> ( accum lexer -- accum )
  50     dup still-parsing? [
  51         dup check-<%
  52         [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
  53     ] [
  54         drop
  55     ] if ;
  56
  57 : %> lexer get parse-%> ; parsing
  58
  59 : parse-template-lines ( lines -- quot )
  60     <template-lexer> [
  61         V{ } clone lexer get parse-%> f (parse-until)
  62     ] with-parser ;
  63
  64 : parse-template ( string -- quot )
  65     [
  66         use [ clone ] change
  67         templating-vocab use+
  68         string-lines parse-template-lines
  69     ] with-scope ;
  70
  71 : eval-template ( string -- ) parse-template call ;
  72
  73 : run-template-file ( filename -- )
  74     [
  75         [
  76             file-vocabs
  77             parser-notes off
  78             templating-vocab use+
  79             dup source-file file set ! so that reload works properly
  80             [ <file-reader> contents eval-template ] keep
  81         ] with-scope
  82     ] assert-depth drop ;
  83
  84 : template-convert ( infile outfile -- )
  85     <file-writer> [ run-template-file ] with-stream ;