unit-lib-util.scm
#lang scheme/base

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

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

(define-signature starters^ (req))

(define-signature empty-sig^ ())

(begin-for-syntax
 (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 ...)))))
                                 LIB-NAMES)))

(define-lib-sig)

;;
;; with-library
;;
(define-syntax with-library
  (syntax-rules ()
    ((_ ((req req-val) prefixed-server-start-iden base-lib@ extended-lib@) body ...)
     (let* ((starters@ (unit
                         (import)
                         (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:
                    (prefixed-server-start-iden)))
            (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
                                                     (string->symbol
                                                      (string-append
                                                       "web:"
                                                       (symbol->string iden)))))
                                             (lset-difference eq? LIB-NAMES def-idens))
       ,def-exprs)))

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