sgwf.scm

#|
 |   Simple Gauche Web Framework
 |#

(define-module sgwf
  (use www.cgi)
  (use text.html-lite)
  (use sxml.serializer)
  (use gauche.interactive)
  (use simply)
  (export main ssf-main render)
  )
(select-module sgwf)

(define *self-module* (find-module 'sgwf))
(define *action-parameter* "action")
(define *default-action* "index")
(define *now-action* "")
(define *view-extension* ".html.scm")

#|            *-PUBLIC-*
 |#
; =main(default)
; ---------------------------------------
(define (main args)
  (ssf-main)
  )

; =ssf-main
; ---------------------------------------
(define (ssf-main)
  (cgi-main (cut parse <>))
  )

; =render
; ---------------------------------------
(define (render . options)
  (cond
    [(string? (car options))
     ; action指定
     (output/template (car options) (cdr options))
     ]
    [else
      (output/template *now-action* options)
      ]
    )
  )


#|            *-PRIVATE-*
 |#
; =make-cgi-header
; ---------------------------------------
(define (make-cgi-header)
  (cgi-header :content-type "text/html;char=utf-8")
  )

(define (output/template template-name args)
  (let* ((ls (simple-input #`",|template-name|,|*view-extension*|" (r port-fold cons '() read)))
         (params (r fold (lambda (x res)
                           (cond
                             [(keyword? x)
                              (cons (lambda (in) (eq? in x)) res)
                              ]
                             [else (cons x res)]
                             )
                           ) '() args))
         )

    (srl:sxml->xml (apply list-replace-all (append ls params)))
    )
  )

; =cgi-params->hash
; ---------------------------------------
(define (cgi-params->hash cgi-params)
  (let1 hs (make-hash-table-wrap)
    (for-each
      (lambda (x)
        (hs (string->symbol (car x)) (cadr x))
        )
      cgi-params)
    hs
    )
  )

; =do-action
; ---------------------------------------
(define (do-action action cgi-args)
  (set! *now-action* action)
  (eval (list (string->symbol (string-append "do-" action)) cgi-args)
        interaction-environment)
  )

; =parse
; ---------------------------------------
(define (parse params)
  (let1 action (cgi-get-parameter *action-parameter* params :default *default-action*)
    (let1 res (do-action action (cgi-params->hash params))
      (list (make-cgi-header) res)
      )
    )
  )

(provide "sgwf")