#lang racket/base
;; Cross-layer relaying between adjacent dataspaces
;; TODO: protocol for *clean* shutdown of a dataspace

;; TODO: Actually elide the need for relays entirely, by allowing an
;; actor to manifest in multiple dataspaces (multiple
;; points-of-attachment), and by placing assertions and subscriptions
;; directly in the dataspace concerned. (Done naively, this would
;; avoid manifesting observed assertions in intermediate nested
;; dataspaces; but then, if anyone cared, they'd be observing the
;; tuples themselves - right?? Oh, maybe observing the observers would
;; be an, er, observable difference.)

(provide quit-dataspace!
         dataspace)

(require racket/match)
(require racket/set)
(require "assertions.rkt")
(require "dataspace.rkt")
(require "syntax.rkt")
(require "skeleton.rkt")
(require "term.rkt")
(require "bag.rkt")

(require (for-syntax racket/base))
(require (for-syntax syntax/parse))
(require "syntax-classes.rkt")

(struct *quit-dataspace* () #:transparent)

;; TODO: inbound^n, outbound^n -- protocol/standard-relay, iow

(define (quit-dataspace!)
  (send! (*quit-dataspace*)))

(define-syntax (dataspace stx)
  (syntax-parse stx
    [(_ name:name form ...)
     (syntax/loc stx
       (let ((ds-name name.N))
         (spawn #:name ds-name
                (define outer-facet (current-facet))
                (begin/dataflow (void)) ;; eww. dummy endpoint to keep the root facet alive
                (define (schedule-inner!)
                  (push-script!
                   (facet-actor outer-facet)
                   (lambda ()
                     (with-current-facet [outer-facet]
                       (when (facet-live? outer-facet)
                         (defer-turn! (lambda ()
                                        (when (run-scripts! inner-ds)
                                          (schedule-inner!)))))))))
                (define inner-ds (make-dataspace
                                  (lambda ()
                                    (schedule-script!
                                     (current-actor)
                                     (lambda ()
                                       (spawn #:name (list 'ds-link ds-name)
                                              (boot-relay schedule-inner!
                                                          outer-facet))
                                       (spawn* form ...))))))
                (on-start (schedule-inner!)))))]))

(define (boot-relay schedule-inner! outer-facet)
  (define inbound-endpoints (make-hash))
  (define outbound-endpoints (make-hash))

  (define inner-facet (current-facet))
  (define inner-actor (current-actor))
  (define inner-ds (actor-dataspace inner-actor))

  (on (asserted (observe (inbound $x)))
      ;; (log-info "~a (asserted (observe (inbound ~v)))" inner-actor x)
      (with-current-facet [outer-facet]
        (with-non-script-context
          (define (make-endpoint)
            (define inner-capture-proj
              ;; inner-capture-proj accounts for the extra (inbound ...) layer around
              ;; assertions
              (let ((outer-capture-proj (term->capture-proj x)))
                (map (lambda (p) (cons 0 p)) outer-capture-proj)))
            (define (rebuild cs)
              (instantiate-term->value (inbound x) cs
                                       #:visibility-restriction-proj inner-capture-proj))
            (define ((wrap f) cs)
              (f (rebuild cs))
              (schedule-inner!))
            (add-raw-observer-endpoint!
             (lambda () x)
             #:on-add (wrap (lambda (t) (apply-patch! inner-ds inner-actor (bag t +1))))
             #:on-remove (wrap (lambda (t) (apply-patch! inner-ds inner-actor (bag t -1))))
             #:on-message (wrap (lambda (t) (send-assertion! (dataspace-routing-table inner-ds) t)))
             #:cleanup (lambda (cache)
                         (apply-patch! inner-ds inner-actor (for/bag/count [(cs (in-bag cache))]
                                                              (values (rebuild cs) -1)))
                         (schedule-inner!))))
          (record-endpoint-if-live! outer-facet inbound-endpoints x make-endpoint))))

  (on (message (*quit-dataspace*))
      (with-current-facet [outer-facet]
        (stop-current-facet)))

  (on (retracted (observe (inbound $x)))
      ;; (log-info "~a (retracted (observe (inbound ~v)))" inner-actor x)
      (with-current-facet [outer-facet]
        (with-non-script-context
          (remove-endpoint! outer-facet (hash-ref inbound-endpoints x))
          (hash-remove! inbound-endpoints x))))

  (on (asserted (outbound $x))
      ;; (log-info "~a (asserted (outbound ~v))" inner-actor x)
      (with-current-facet [outer-facet]
        (with-non-script-context
          (record-endpoint-if-live! outer-facet
                                    outbound-endpoints
                                    x
                                    (lambda ()
                                      (add-endpoint! outer-facet
                                                     "dataspace-relay (outbound ...)"
                                                     #t
                                                     (lambda () (values x #f))))))))

  (on (retracted (outbound $x))
      ;; (log-info "~a (retracted (outbound ~v))" inner-actor x)
      (with-current-facet [outer-facet]
        (with-non-script-context
          (remove-endpoint! outer-facet (hash-ref outbound-endpoints x))
          (hash-remove! outbound-endpoints x))))

  (on (message (outbound $x))
      ;; (log-info "~a (message (outbound ~v))" inner-actor x)
      (with-current-facet [outer-facet]
        (send! x))))

(define (record-endpoint-if-live! f table key ep-adder)
  (when (facet-live? f)
    ;;
    ;; ^ Check that `f` is still alive, because we're (carefully!!)
    ;; violating an invariant of `dataspace.rkt` by adding an endpoint
    ;; well after the construction of the facet we're in. We may be
    ;; executing this handler just after clean shutdown of the facet
    ;; by a `quit-dataspace!` request, and in that case we MUST NOT
    ;; add any further endpoints because their assertions will not get
    ;; removed, because cleanup (as part of `(quit)` processing) has
    ;; already been done.
    ;;
    ;; We don't have to do a similar check before calling
    ;; `remove-endpoint!`, because shortly after all (both) calls to
    ;; `destroy-endpoint!`, all destroyed endpoints are removed from
    ;; the `facet-endpoints` table, ensuring they won't be processed
    ;; again.
    ;;
    (hash-set! table key (ep-adder))))