#lang scheme/base

(require scheme/unit
         (for-syntax scheme/base
                     (only-in (lib "1.ss" "srfi") lset-difference))
         ;(planet "dispatch.ss" ("untyped" "dispatch.plt" 1))

(provide with-library
         define-lib-aux ; XXX lame

(define-signature starters^ (req))

(define-signature empty-sig^ ())

 (define LIB-NAMES '(req server-start))

(define-macro (define-lib-sig)
  `(define-signature lib^ ,(cons '(define-syntaxes (define-page)
                                    (values (syntax-rules ()
                                              ((_ (page-name arg ...) body ...)
                                               (define-controller (page-name req arg ...)
                                                 body ...)))))


;; with-library
(define-syntax with-library
  (syntax-rules ()
    ((_ ((req req-val) prefixed-server-start-iden base-lib@ extended-lib@) body ...)
     (let* ((starters@ (unit
                         (export starters^)
                         (define req req-val)))
            (main@ (unit
                    (import (prefix web: lib^))
                    (export empty-sig^)
                    body ...
                    ;; after we excecute whatever body was given, we call web:server-start:
            (import-free@ (compound-unit (import)
                                        (export RESULT)
                                        (link [((STARTERS : starters^)) starters@]
                                              [((BASE : lib^)) base-lib@ STARTERS]
                                              [((EXT : lib^)) extended-lib@ BASE]
                                              [((RESULT : empty-sig^)) main@ EXT]))))
       (invoke-unit import-free@)))))

;; define-base-lib
;; Used internally to provide the "out-of-the-box" library functionality.  Users of
;; the library can use define-web-app to make their web app (and override functionality
;; provided by this guy.
;; XXX probably should add some syntax so the prefix issue isn't so confusing, since
;; currently, you have ot override with names lacking the prefix, but refer to other
;; functions with names that have the prefix.
(define-syntax define-base-lib
  (syntax-rules (define)
    ((_ name (req-iden prefixed-req-iden)
        (define (fn arg ...) body ...)
     (define-unit name
       (import (prefix web: starters^))
       (export lib^)
       (define req-iden prefixed-req-iden)
       (define (fn arg ...) body ...)

;; define-web-app
(define-macro (define-lib lib-name . def-exprs)
  (let ((def-idens (map caadr def-exprs)))
    `(define-lib-aux ,lib-name ,(map (lambda (iden)
                                               (list iden
                                                       (symbol->string iden)))))
                                             (lset-difference eq? LIB-NAMES def-idens))

(define-syntax define-lib-aux
  (syntax-rules (define)
    ((_ lib-name ((not-overridden prefixed-not-overridden) ...)
        ((define (fn arg ...) body ...) ...))
     (define-unit lib-name
       (import (prefix web: lib^))
       (export lib^)
       (define not-overridden prefixed-not-overridden) ...
       (define (fn arg ...) body ...) ...))))