Re: sfx: baby steps of an html templating engine based on skribillo's skribe reader and sxml

[Amirouche Boubekki <amirouche@hypermove.net>]

[-- Attachment #1: Type: text/plain, Size: 6341 bytes --]

I improved the usuability of the module. It should be able to just drop 
`sfx.scm` in your project to use it.

Here an exemple use in scheme code:

;;;
;;; This requires at least a `index.sfx` file and `person.scm` where
;;; a `<person>` record is defined.
;;;

;; (use-modules (person))

;; (define persons (list (make-person "amirouche" 30)
;;                       (make-person "julien" 30)
;;                       (make-person "mez" 27)
;;                       (make-person "moh" 113)))

;; (define bindings `((value ,(make-parameter 42))
;;                    (title '(h1 "Héllo (again (and again)) hacker!"))
;;                    (persons ,persons)))

;; (with-output-to-file "index.html"
;;   (lambda () (render "index.sfx" bindings)))

I attached the updated `sfx.scm` with required files to test it.

There still one area where it can be improved regarding template 
resolution/finding. Right now it simply look for templates according the 
default `(open)` behavior which looks
in cwd (current working directory).


Best regards

Le 2015-07-30 18:52, Amirouche Boubekki a écrit :
> Le 2015-07-30 13:55, Amirouche Boubekki a écrit :
>> Héllo,
>> 
>> 
>> I've been lurking around skribillo and artanis. I don't really like
>> the rails-like syntax
>> of artanis, even if it has its use-cases and I wanted to hack on
>> something "small", so
>> I've put together sfx.
>> 
>> The code of skribe reader is included in sfx.scm. So the only
>> dependency is guile (2.0.11) and
>> guile-reader that you can install using `guix package -i 
>> guile-reader`.
>> 
>> This bare template language has the following features:
>> 
>> - wanna be simpler sxml syntax
>> - templates with custom environment
>> - external libraries loading inside the template
>> 
>> 
>> # Wanna be simpler sxml syntax
>> 
>> Skribe reader (implemented with guile-reader) provide a handy syntax 
>> to
>> both define keywords and quasiquote. In an sxml context those features
>> are used to implemented attributes and text nodes.
>> 
>> ## attributes
>> 
>> Attributes in sxml are defined as follow:
>> 
>>   (div (@ (id "shell")) "This the main area")
>> 
>> Instead of requiring the nesting of `(attribute-name attribute-value)` 
>> sfx use
>> the simpler keyword syntax `:keyword`. The above snippet becomes:
>> 
>>   (div (@ :id "shell") "This the main area")
>> 
>> I'm not sure it's worth the trouble of diverting from sxml standard.
>> That said, it looks
>> more like plain xml.
>> 
>> ## text nodes
>> 
>> Text nodes can be defined as
>> 
>>   (p [héllo hacker])
>> 
>> This is looks the same as the default reader. It becomes handy when
>> you include an
>> inline element inside the text node:
>> 
>>   (p [héllo ,(b [hacker])
>> 
>> `,()` is a special syntax of skribe reader which provides `(unquote)`
>> inside [bracket] `quasiquote`.
>> 
>> With the default guile reader, this must be written as:
>> 
>>   (p "héllo " (b "hacker"))
>> 
>> This is looks verbose and prone to error. One must not forget the 
>> space in the
>> string before the `(b)` element.
>> 
>> 
>> # templates with custom environment
>> 
>> Right now this part of the template language is not really
>> userfriendly. But you can pass custom
>> variables to the template but those must be parameters. In the example
>> sfx.scm (which includes
>> example use of the procedures) the environment in which the template
>> is evaled is defined as follow:
>> 
>>   (define value (make-parameter 42))
>>   (define amirouche (make-person "amirouche" 30))
>>   (define env (let ((value value)
>>                     (amirouche amirouche))
>>                 (the-environment)))
>> 
>> 
>> Then `value` can be echo'ed inside the template using the unquote
>> syntax `,()`, e.g.
>> 
>>    (p [Here is a lucky number for you «,(value)»])
>> 
>> As you can see the previous snippet, there is also a `<record>` record
>> inside the environment.
>> One can (maybe) provide in the environment the required procedures to
>> echo the correct
>> fields but this is verbose. Instead sfx use `(use-modules)` inside the
>> template definition
>> file. This is presented in the following and last part.
>> 
>> # external libraries loading inside the template
>> 
>> Currently it's (only) possible to do `(use-modules)` inside the
>> template file. The template
>> file looks like the following:
>> 
>> ```
>> (use-modules (person))
>> 
>> `(html
>>   (body
>>     (p [My name is ,(person-name amirouche)])))
>> ```
>> 
>> I could not make procedure definition work inside the template, this
>> my be linked to the way
>> I eval the template. It's shame because for quick and dirty hacks it
>> can be handy like defining
>> mini-templates inside the big template.
>> 
>> 
>> 
>> 
>> 
>> This is my second try at this and having a look at the code of haunt
>> [1] was helpful.
>> 
>> Hope this helps!
>> 
>> 
>> [1] https://git.dthompson.us/haunt.git
> 
> Sorry for the double posting. This mail is not a duplicate.
> 
> I though that the implementation `extend` would be more involving.
> 
> `extend` is the dual of `include`. Given a base template `base.sfx`
> you define placeholders
> say `,(main)` and `,(sidebar)` and the rest is the "shell" of the
> application ie. the part of
> GUI that is always the same over the application.
> 
> If `index.sfx` inherit `base.sfx` the context in which `base.sfx` is
> rendered is the same as the context
> used to render `ìndex.sfx` plus the variables defined/passed in
> `ìndex.sfx` to `base.sfx`.
> 
> In the following example, `title` and `intro` are evaled and then
> added to `(current-module)` environment
> with which `base.sfx` is rendered.
> 
>    (extend "base.sfx"
>            (current-module)
>            `((title `(h1 [Héllo again hacker!!]))
>              (intro "This is a little presentation of sfx template 
> language")))
> 
> I don't how to make `(current-module)` disappear but it's also more
> explicit. I'm not sure.
> 
> `extend` implement a pattern similar to inheritance in OOP.
> 
> I attach complete code with an example. There is small doc in the
> header of the file.

-- 
Amirouche ~ amz3 ~ http://www.hyperdev.fr

[-- Attachment #2: sfx.scm --]
[-- Type: text/plain, Size: 10199 bytes --]

;;; Copyright © 2015  Amirouche Boubekki <amirouche@hypermove.net>
;;; Copyright © 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public License
;;; as published by the Free Software Foundation; either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library.  If not, see
;;; <http://www.gnu.org/licenses/>.

;; sfx.scm
;;
;; sxml and skribe based mini html template engine
;;
;; takes as input a quasiquoted pseudo sxml e.g.:
;;
;; `(html
;;   (head
;;    (meta (@ :charset "utf-8"))
;;    (title [This is a page generated from scheme])
;;    (meta (@ :name "author" :content "Amirouche BOUBEKKI <amirouche@hypermove.net>"))
;;    (meta (@ :name "viewport" :content "width=device-width, initial-scale=1"))
;;    (link (@ :rel "stylesheet" :href "static/css/bootstrap.min.css"))
;;    (link (@ :rel "stylesheet" :href "static/css/bootstrap-theme.min.css"))
;;    (link (@ :rel "stylesheet" :href "static/css/main.css")))  
;;   (body (@ :class "index")
;;         (div (@ :class container)
;;              (div (@ :class "header clearfix")
;;                   (nav
;;                    (ul (@ :class "nav nav-pills pull-right")                     
;;                        (li (@ :role "presentation" :class "active")
;;                            (a (@ :href "#") [Home]))
;;                        (li (@ :role "presentation" )
;;                            (a (@ :href "#") [About]))
;;                        (li (@ :role "presentation" )
;;                            (a (@ :href "#") [Contact]))))
;;                   (h3 (@ :class "text-muted") [hypermove.net])))))
;;
;; It's similar to sxml except the syntax to declare attributes is less verbose
;; *and* you can use some scheme code but they are limitations. You can (use-modules)
;; and variable must wrapped with `(make-parameter)`. The sxml must appear last in the file.
;;
;; Use of `map` inside a template:
;;
;;  (div (@ :class "row")
;;    (ul ,(map (lambda (person) `(li ,(person-name person)))
;;              persons)))
;;
;; Use of `extend` inside a template:
;;
;;
;;   (extend "base.sfx"
;;           (current-module)
;;           `((title `(h1 [Héllo again hacker!!]))
;;             (intro "This is a little presentation of sfx template language")))
;;
;; Mind the fact  that there is no quasiquote at the beginning
;; of this template, since it's a procedure call and not skribe
;; sxml.
;;
;; Then you can use in `base.sfx` template `title` and `intro`
;; like variables using the unquote syntax e.g. `,(title)`.
;;
;; Here is an example `base.sfx`:
;;
;;   `(html
;;     (head
;;      (meta (@ :charset "utf-8"))
;;      (title [This is a page generated from scheme])
;;      (meta (@ :name "author" :content "Amirouche BOUBEKKI <amirouche@hypermove.net>"))
;;      (meta (@ :name "viewport" :content "width=device-width, initial-scale=1"))
;;      (link (@ :rel "stylesheet" :href "static/css/bootstrap.min.css"))
;;      (link (@ :rel "stylesheet" :href "static/css/bootstrap-theme.min.css"))
;;      (link (@ :rel "stylesheet" :href "static/css/main.css")))  
;;     (body (@ :class "index")
;;           (div (@ :class container)
;;                (div (@ :class "header clearfix")
;;                     (nav
;;                      (ul (@ :class "nav nav-pills pull-right")                     
;;                          (li (@ :role "presentation" :class "active")
;;                              (a (@ :href "#") [Home]))
;;                          (li (@ :role "presentation" )
;;                              (a (@ :href "mailto:amirouche@hyperdev.fr") [Contact]))))
;;                     (h3 (@ :class "text-muted") [hyperdev.fr]))
;;                (h1 [,(title)])
;;                ,(intro))))
;;

(use-modules (srfi srfi-1))
(use-modules ((srfi srfi-26) #:select (cut)))

(use-modules (ice-9 r5rs))  ;; scheme-report-environment
(use-modules (ice-9 match))
(use-modules (ice-9 format))
(use-modules (ice-9 hash-table))
(use-modules (ice-9 optargs))
(use-modules (ice-9 local-eval))

(use-modules (sxml simple))

;; the Scheme reader composition framework (guile-reader)
(use-modules ((system reader) #:renamer (symbol-prefix-proc 'r:)))

;;;
;;; skribe reader (borrowed from skribilo)
;;;

(define (make-colon-free-token-reader tr)
  ;; Stolen from `guile-reader' 0.3.
  "If token reader @var{tr} handles the @code{:} (colon) character, remove it
from its specification and return the new token reader."
  (let* ((spec (r:token-reader-specification tr))
         (proc (r:token-reader-procedure tr)))
    (r:make-token-reader (filter (lambda (chr)
                                   (not (char=? chr #\:)))
                                 spec)
                         proc)))

(define &sharp-reader
  ;; The reader for what comes after a `#' character.
  (let* ((dsssl-keyword-reader  ;; keywords à la `#!key'
          (r:make-token-reader #\!
                               (r:token-reader-procedure
                                (r:standard-token-reader 'keyword)))))
      (r:make-reader (cons dsssl-keyword-reader
                           (map r:standard-token-reader
                                '(character srfi-4 vector
                                  number+radix boolean
                                  srfi30-block-comment
                                  srfi62-sexp-comment)))
                     #f ;; use default fault handler
                     'reader/record-positions)))

(define (make-skribe-reader)
  (let ((colon-keywords ;; keywords à la `:key' fashion
         (r:make-token-reader #\:
                              (r:token-reader-procedure
                               (r:standard-token-reader 'keyword))))
        (symbol-misc-chars-tr
         ;; Make sure `:' is handled only by the keyword token reader.
         (make-colon-free-token-reader
          (r:standard-token-reader 'r6rs-symbol-misc-chars))))


    ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since
    ;; they consider square brackets as delimiters.
    (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader)
                          colon-keywords
                          symbol-misc-chars-tr
                          (map r:standard-token-reader
                               `(whitespace
                                 sexp string r6rs-number
                                 r6rs-symbol-lower-case
                                 r6rs-symbol-upper-case
                                 quote-quasiquote-unquote
                                 semicolon-comment
                                 skribe-exp)))
                   #f ;; use the default fault handler
                   'reader/record-positions
                   )))

(define skribe (make-skribe-reader))

;;;
;;; sfx template specifics
;;;

(define (keywords->attributes keywords)
  "Convert (list :one \"key\" :two \"word\") to sxml attributes (list ('one \"key\") ('two \"word\"))"
  (match keywords
    ((keyword value rest ...) (cons (list (keyword->symbol keyword) value) (keywords->attributes rest)))
    (_ '())))

(define (sfx->sxml sfx)
  "Turn sfx template into sxml"
  (match sfx
    (('quasiquote value) (map sfx->sxml value))
    (('unquote value) (list 'unquote value))
    ((tag ('@ keywords ...)) (list tag (append '(@) (keywords->attributes keywords))))
    ((tag ('@ keywords ...) children ...) (append (list tag (append '(@) (keywords->attributes keywords))) (map sfx->sxml children)))
    
    ((tag children ...) (append (list tag) (map sfx->sxml children)))
    
    ((value ...) (map sfx->sxml value))
    (_ sfx)))

;;;
;;; template rendering
;;;

(define* (read-eval-template env #:optional out)
  (let ((sexp (skribe)))
    (if (eof-object? sexp)
        out
        (read-eval-template env (flyeval sexp env)))))

(define (template->xml env port)
  (sxml->xml (flyeval (list 'quasiquote (sfx->sxml (read-eval-template env))) env)) port)

(define (flyeval sexpr env)
  ((local-eval `(lambda () ,sexpr) env)))

;;;
;;; template procedures
;;;

(define (extend base env context)
  "Extend BASE template with values defined in ENV and CONTEXT.

   This must be used inside a template"
  (map (lambda (pair)
         (match pair
                ((name value)
                 (module-add! env
                              name
                              (make-variable 
                               (make-parameter (flyeval value env)))))))
       context)
  (call-with-output-string
   (lambda (port)
     (with-input-from-file base
       (lambda ()
         (template->xml env port))))))

;;;
;;; render
;;;

(define (render template bindings)
  (define env (scheme-report-environment 5))
  (module-add! env 'extend (make-variable extend))
  (module-add! env 'current-module (make-variable current-module))
  (map (lambda (pair)
         (match pair ((name value) (module-add! env name (make-variable value)))))
       bindings)
  (call-with-output-string
   (lambda (port)
     (with-input-from-file template
       (lambda ()
         (display "<!DOCTYPE html>")
         (template->xml env port))))))

;;;
;;; Example use
;;;
;;; This requires at least a `index.sfx` file and `person.scm` where
;;; a `<person>` record is defined.
;;;

;; (use-modules (person))

;; (define persons (list (make-person "amirouche" 30)
;;                       (make-person "julien" 30)
;;                       (make-person "mez" 27)
;;                       (make-person "moh" 113)))

;; (define bindings `((value ,(make-parameter 42))
;;                    (title '(h1 "Héllo (again (and again)) hacker!"))
;;                    (persons ,persons)))

;; (with-output-to-file "index.html"
;;   (lambda () (render "index.sfx" bindings)))

[-- Attachment #3: base.sfx --]
[-- Type: text/plain, Size: 1097 bytes --]

`(html
  (head
   (meta (@ :charset "utf-8"))
   (title [This is a page generated from scheme])
   (meta (@ :name "author" :content "Amirouche BOUBEKKI <amirouche@hypermove.net>"))
   (meta (@ :name "viewport" :content "width=device-width, initial-scale=1"))
   (link (@ :rel "stylesheet" :href "static/css/bootstrap.min.css"))
   (link (@ :rel "stylesheet" :href "static/css/bootstrap-theme.min.css"))
   (link (@ :rel "stylesheet" :href "static/css/main.css")))  
  (body (@ :class "index")
        (div (@ :class container)
             (div (@ :class "header clearfix")
                  (nav
                   (ul (@ :class "nav nav-pills pull-right")                     
                       (li (@ :role "presentation" :class "active")
                           (a (@ :href "#") [Home]))
                       (li (@ :role "presentation" )
                           (a (@ :href "mailto:amirouche@hyperdev.fr") [Contact]))))
                  (h3 (@ :class "text-muted") [hyperdev.fr]))
             (h4 [The magic number is ,(value)])
             ,(header)
             ,(intro))))

[-- Attachment #4: index.sfx --]
[-- Type: text/plain, Size: 368 bytes --]

(extend "base.sfx"
        (current-module)
        `((header ,title)
          (intro `(div (p "This is a little presentation of sfx template language")
                       (p "Here is an example of sxml code generated with scheme code")
                       (ul ,(map (lambda (person) `(li ,(person-name person)))
                                 persons))))))

[-- Attachment #5: person.scm --]
[-- Type: text/plain, Size: 205 bytes --]

(define-module (person))

(use-modules (srfi srfi-9))

(define-record-type <person>
  (make-person name age)
  person?
  (name person-name)
  (age person-age))

(export make-person person-name person-age)