;;; Copyright © 2015  Amirouche Boubekki <address@hidden>
;;; Copyright © 2005, 2006 Ludovic Courtès <address@hidden>
;;;
;;; 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 <address@hidden>"))
;;    (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)))