#lang scheme/base

;; XXX start convention for macros that introduce idens with the () and the => and use
;; it everywhere.

(require scheme/match
         (planet "web.scm" ("soegaard" "web.plt" 2 1))
         (planet "instaservlet.ss" ("untyped" "instaservlet.plt" 1))
         (planet "dispatch.ss" ("untyped" "dispatch.plt" 1))
         "util.scm"
         "web-support.scm"
         "record.scm"
         "repository.scm"
         "form.scm"
         "validate.scm"
         "closures.scm"
         "session.scm"
         "js.scm"
         "settings.scm"
         "user.scm"
         "time.scm"
         "page.scm"
         )

(provide

 ;; the work of others:
 (all-from-out (planet "web.scm" ("soegaard" "web.plt" 2 1)))
 (all-from-out (planet "dispatch.ss" ("untyped" "dispatch.plt" 1)))
 (all-from-out (planet "instaservlet.ss" ("untyped" "instaservlet.plt" 1)))

 ;; web server
 serve
 define-app
 
 ;; core web help
 web-link
 wrap-each-in-list
 raw-str
 
 ;; web forms
 form
 validate
 field-validate
 form-id
 form-markup
 
 ;; records and the data repository
 rec-prop
 rec-child-prop
 rec-id
 rec-data
 rec-set-prop!
 rec-set-data!
 rec-set-rec-prop!
 rec-rec-prop
 load-rec
 load-where
 load-children
 contains-child?
 add-child-and-save!
 rec-add-list-prop-elt!
 store-rec!
 fresh-rec-from-data
 same-rec?
 
 ;; closures
 handle-closure-in-req
 body-as-url
 body-as-closure-key
 
 ;; sessions
 session-put-val!
 session-get-val
 session-remove-entry!
 all-sessions
 sessioned-response

 ;; response
 cookied-response

 ;; js
 js-script-invoke
 js-array
 js-quote
 js-call

 ;; html, pages, includes, etc
 define-page
 define-session-page
 page-url
 redirect-to-page
 make-wrapper
 atom-wrapper

 ;; settings
 declare-setting
 setting
 setting-set!

 ;; users
 register-form
 welcome-message
 current-user
 created-by?
 created-by-str
 stamp-user-on-rec!
 get-user-rec
 unauthenticated-login!
 if-these-users

 ;; time
 created-when-str
 
 )

;; consumes a web-app; passes its keyword arguments to go! (part of instaservlet)
(define serve
  (make-keyword-procedure
   (lambda (kws kw-vals . reg-args)
     (match reg-args ((list web-app)
                      (keyword-apply go!
                                     kws
                                     kw-vals
                                     (list (lambda (req)
                                             (remove-group-tags
                                              (handle-closure-in-req
                                               req
                                               (dispatch req web-app)))))))))))

(define-syntax define-app
  (syntax-rules ()
    ((_ app-name
        (page-name route-syntax)
        ...)
     (begin (provide app-name page-name ...)
            (define-site app-name ((route-syntax page-name) ...))))))