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: 3567 bytes --]

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

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: index.scm --]
[-- Type: text/plain; charset=us-ascii; name=index.scm, Size: 1179 bytes --]

(use-modules (person))

`(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]))
             (div (@ :class "row")
                  (p [,(person-name amirouche) says: Héllo stranger! Here is a lucky number for you «,(value)»])))))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: sfx.scm --]
[-- Type: text/plain; charset=us-ascii; name=sfx.scm, Size: 7017 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.
;; It's possible to pass variables to the template but right now it's hardcoded cf. `flyeval`.
;;

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

(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 (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)))


(define skribe (make-skribe-reader))

;; FIXME: the environment is hardcoded inside flyeval
(use-modules (person))
(define value (make-parameter 42))
(define amirouche (make-person "amirouche" 30))
(define env (let ((value value)
                  (amirouche amirouche))
              (the-environment)))

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


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


(define (output)
    (with-input-from-file "index.scm"
      (lambda ()
        (display "<!DOCTYPE html>")
        (sxml->xml (flyeval (list 'quasiquote (sfx->sxml (read-eval-template))))))))


;; (output)  ;; display html to stdout


(with-output-to-file "index.html"
  (lambda () (output)))

[-- Attachment #4: 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)