(module hwiki-manager mzscheme
        (require (lib "contract.ss"))
        (require (lib "manager.ss" "web-server" "managers"))
        (require (lib "servlet-structs.ss" "web-server"))
        (require "debug.scm")

        (define (data cell)            (vector-ref cell 0))
        (define (data! cell value)     (vector-set! cell 0 value))
        (define (continuations cell)    (vector-ref cell 1))
        (define (continuations! cell c) (vector-set! cell 1 c))
        (define (timeout cell)         (vector-ref cell 2))
        (define (timeout! cell t)      (vector-set! cell 2 t))
        (define (expiref cell)         (vector-ref cell 3))
        (define (expiref! cell f)      (vector-set! cell 3 f))
        (define (exhandler cell)       (vector-ref cell 7))
        (define (exhandler! cell v)    (vector-set! cell 7 v))
        (define (guard cell)           (vector-ref cell 4))
        (define (guard! cell g)        (vector-set! cell 4 g))
        (define (locked cell)          (vector-ref cell 5))
        (define (locked! cell v)       (vector-set! cell 5 v))
        (define (clear cell)           (vector-ref cell 6))
        (define (clear! cell)          (vector-set! cell 6 #t))
        (define (seconds cell)         (vector-ref cell 8))
        (define (seconds! cell s)      (vector-set! cell 8 s))
        (define (new-cell)             (vector #f #f #f (lambda args #f) #f #f #f (lambda args #f) #f))

        (provide/contract
         (create-hwiki-manager (expiration-handler? . -> . manager?)))
        (provide
          hwiki-cell-usage
          hwiki-current-manager)

        (define-struct (hwiki-manager manager) (instance-expiration-handler cell-usage))

        (define (create-hwiki-manager instance-expiration-handler)

          (define sem            (make-semaphore 1))
          (define storage        (make-hash-table))
          (define ID              0)
          (define default-timeout 30)
          (define ID-RECYCLER    '())
          
          ;;; precondition: semaphore-wait sem
          (define (get-id)
            (if (null? ID-RECYCLER)
                (begin
                  (set! ID (+ ID 1))
                  ID)
                (let ((id (car ID-RECYCLER)))
                  (set! ID-RECYCLER (cdr ID-RECYCLER))
                  id)))

          ;;; precondition: semaphore-wait sem
          (define (recycle-id id)
            (set! ID-RECYCLER (cons id ID-RECYCLER)))

          (define (create-instance data expire-fn . S)
            (let ((_storage (if (null? S) storage (car S))))
              (let ((my-id (get-id)))
                (let ((cell (new-cell)))
                  (seconds! cell 0)
                  (data!    cell data)
                  (expiref! cell expire-fn)
                  (timeout! cell default-timeout)
                  (continuations! cell (make-hash-table))
                  (guard!   cell (thread (lambda ()
                                           (let ((c (current-seconds)))
                                             (seconds! cell c)
                                             (letrec ((g (lambda ()
                                                           (let ((tdiff (- (current-seconds) c)))
;                                                             (debug (format "cell:id=~a, locked=~a, clear=~a, tdiff=~a, timeout=~a~%"
;                                                                              my-id (locked cell) (clear cell) tdiff (timeout cell)))
                                                             (if (or (clear cell)
                                                                     (and (> tdiff (timeout cell))
                                                                          (not (locked cell))))
                                                                 (begin
                                                                   (semaphore-wait sem)
                                                                   (hash-table-remove! _storage my-id)
                                                                   (recycle-id my-id)
                                                                   (semaphore-post sem)
                                                                   (let ((exf (expiref cell)))
                                                                     (debug (format "expiring: ~s~%" exf))
                                                                     (if exf (exf)))
                                                                   )
                                                                 (if (and 
                                                                      (> tdiff (timeout cell))
                                                                      (locked cell)
                                                                      (= (hash-table-count (continuations cell)) 0))
                                                                     (begin
                                                                       (semaphore-wait sem)
                                                                       (hash-table-remove! _storage my-id)
                                                                       (recycle-id my-id)
                                                                       (semaphore-post sem)                                                                       
                                                                       (let ((exf (expiref cell)))
                                                                         (debug (format "locked, but 0 continuations: expiring ~s~%" exf))
                                                                         (if exf (exf)))
                                                                       )
                                                                     (begin
                                                                       (sleep 10)
                                                                       (g))))))))
                                               (g))))))
                  (hash-table-put! _storage my-id cell))
                (semaphore-post sem)
                my-id)))
          
          (define (instance-lookup instance-id)
            (semaphore-wait sem)
            (let ((cell (hash-table-get storage instance-id (lambda () #f))))
              (debug (format "instance-lookup: ~a, cell=~s~%" instance-id cell))
              (if (eq? cell #f)
                  (begin
                    (semaphore-post sem)
                    (raise (make-exn:fail:servlet-manager:no-instance
                            (string->immutable-string
                             (format "No instance for id: ~a" instance-id))
                            (current-continuation-marks)
                            instance-expiration-handler)))
                  (begin
                    (semaphore-post sem)
                    cell))))
          
          (define (adjust-timeout! instance-id secs)
            (let ((cell (instance-lookup instance-id)))
              (debug (format "id:~a, new seconds: ~a~%" instance-id secs))
              (hash-table-map (continuations cell) (lambda (id ccell) (timeout! ccell secs)))
              (timeout! cell secs)
              ))
              
          (define (instance-lock! instance-id)
            (let ((cell (instance-lookup instance-id)))
              (locked! cell #t)))

          (define (instance-unlock! instance-id)
            (let ((cell (instance-lookup instance-id)))
              (locked! cell #f)))

          (define (instance-lookup-data instance-id)
            (let ((cell (instance-lookup instance-id)))
              (data cell)))

          (define (clear-continuations! instance-id)
            (let ((cell (instance-lookup instance-id)))
              (hash-table-map (continuations cell)
                              (lambda (id cell)
                                (clear! cell)))))
          
          (define (continuation-store! instance-id k expiration-handler)
            (let ((cell (instance-lookup instance-id)))
              (let ((id (create-instance k expiration-handler (continuations cell))))
                (let ((ccell (hash-table-get (continuations cell) id)))
                  (debug (format "continuation-store: id=~a, timeout=~a, exh=~s, timeout instance=~a~%"
                                 id (timeout ccell) expiration-handler (timeout cell)))
                  (timeout!   ccell (timeout cell))       ;;; inherit the timeout of the current cell
                  (exhandler! ccell expiration-handler))
                (list id id))))

          (define (continuation-lookup instance-id a-k-id a-salt)
            (debug (format "instance-id:~a, a-k-id=~a, a-salt=~a~%" instance-id a-k-id a-salt))
            (let ((cell (instance-lookup instance-id)))
              (let ((ccell (hash-table-get (continuations cell) a-k-id (lambda () #f))))
                (let ((expiration-handler (if (eq? ccell #f) 
                                              #f
                                              (exhandler ccell))))
                  (if (not (= a-k-id a-salt))
                      (raise (make-exn:fail:servlet-manager:no-continuation
                              (string->immutable-string
                               (format "No continuation for id: ~a (~a)" a-k-id a-salt))
                              (current-continuation-marks)
                              (if expiration-handler
                                  expiration-handler
                                  instance-expiration-handler)))
                      (data ccell))))))
          
          (define (cell-usage)
            (semaphore-wait sem)
            (let ((R (hash-table-map storage
                                     (lambda (id cell)
                                       (list id (seconds cell) (timeout cell) (hash-table-count (continuations cell)))))))
              (semaphore-post sem)
              R))

          (make-hwiki-manager create-instance
                              adjust-timeout!
                              instance-lookup-data
                              instance-lock!
                              instance-unlock!
                              clear-continuations!
                              continuation-store!
                              continuation-lookup
                              ; Specific
                              instance-expiration-handler
                              cell-usage)
          
          )
        
        
        (define (hwiki-cell-usage manager)
          ((hwiki-manager-cell-usage manager)))
        
        (define CURRENT-MANAGER #f)
        
        (define (hwiki-current-manager . m)
          (if (not (null? m)) (set! CURRENT-MANAGER (car m)))
          CURRENT-MANAGER)
        
        
        )