(module resume-unit mzscheme
  (require (lib "unitsig.ss")
           (lib "servlet-sig.ss" "web-server"))
  
  (provide resume@ resume^)
  
  (define-signature resume^ (set-resume-point!       ; user -> (union #f tst)
                             log-out!                ; user -> void
                             clear-resume-table!     ; -> void
                             
                             send/suspend-to-user    ; (string -> response), user -> request
                             send/finish-to-user     ; response, user -> void
                             send/forward-to-user    ; (string -> response), user -> request
                             send/back-to-user       ; response, user -> void
                             resume                  ; user [tst] -> #f
                             ))

  ;; ------------------------------------------------------------
  ;; THE RESUME TABLE
  ;; It must be outside the unit because the unit gets instantiated
  ;; once per servlet instance (in the case of unit servlets) but
  ;; the table must be instantiated only once per instantiation of
  ;; the servlet itself
  
  ;; *R* : USER -o> continuation
  ;; Maps user names to the continuation representing the farthest
  ;; point the user has reached in this web interaction
  (define *R* (make-hash-table 'equal))
  
  ;; using a mutex lock here rather than channels because it seems
  ;; slightly simpler for this minimal amount of synchronization
  (define *R-lock* (make-semaphore 1))
  
  ;; ------------------------------------------------------------
  ;; THE RESUME@ UNIT
  ;; Defines the resume primitives.
  (define resume@ 
    (unit/sig resume^
      (import servlet^)
      
      ;; set-resume-point! : USER -> tst
      ;; sets the given resume point and returns #f. When this point is resumed to,
      ;; returns #t by default or anything the program provides as an extra optional
      ;; argument to resume.
      (define (set-resume-point! user)
        (let/cc k 
          (begin
            (call-with-semaphore *R-lock* (λ () (hash-table-put! *R* user k)))
            #f)))
      
      ;; log-out! : -> void
      ;; get rid of a user's entry in the user table
      (define (log-out! user)
        (call-with-semaphore *R-lock* (λ () (hash-table-remove! *R* user)))
        (void))
      
      ;; clear-user-table! : -> void
      ;; clear the entire user table
      (define (clear-resume-table!)
        (call-with-semaphore *R-lock* (λ () (set! *R* (make-hash-table 'equal))))
        (void))
      
      ;; send-to-user* : (X -> Y) -> X user -> Y
      ;; abstraction over the pattern found in all the send/*-to-user functions below
      (define ((send-to-user* sender) response user)
        (set-resume-point! user)
        (sender response))

      ;; implementations of the "-to-user" versions of the web primitives
      (define send/suspend-to-user (send-to-user* send/suspend))
      (define send/finish-to-user  (send-to-user* send/finish))
      (define send/forward-to-user (send-to-user* send/forward))
      (define send/back-to-user    (send-to-user* send/back))
      
      ;; resume : user [tst] -> #f
      ;; if the user has a current session, this function
      ;; does not return and instead throws to the continuation
      ;; representing that session. Otherwise returns false.
      (define resume
        (case-lambda 
          [(user)
           (resume user #t)]
          [(user resume-value)
           (let ((k (call-with-semaphore *R-lock* (λ () (hash-table-get *R* user (lambda () #f))))))
             (if k 
                 (k resume-value)
                 #f))])))))