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

(provide (struct-out inbound)
         (struct-out outbound)
         dataspace)

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

(require (for-syntax racket/base))

(struct inbound (assertion) #:prefab)
(struct outbound (assertion) #:prefab)

(define-syntax (dataspace stx)
  (syntax-case stx ()
    [(_ form ...)
     (syntax/loc stx
       (spawn (define outer-actor (current-actor))
              (define outer-facet (current-facet))
              (define inner-ds (make-dataspace
                                (lambda ()
                                  (schedule-script!
                                   (current-actor)
                                   (lambda ()
                                     (spawn #:name 'dataspace-relay
                                            (boot-relay outer-actor
                                                        outer-facet))
                                     (spawn* form ...))))))
              (on-start (schedule-turn! inner-ds))))]))

(define (schedule-turn! inner-ds)
  (defer-turn! (lambda ()
                 (when (run-scripts! inner-ds)
                   (schedule-turn! inner-ds)))))

(define (boot-relay outer-actor outer-facet)
  (define inbound-endpoints (make-hash))
  (define outbound-endpoints (make-hash))

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

  (on (asserted (observe (inbound $x)))
      (with-current-facet [outer-actor outer-facet #f]
        (define i (skeleton-interest
                   (term->skeleton x)
                   (term->skeleton-proj x)
                   (term->key x)
                   (term->capture-proj x)
                   (lambda (op . captured-values)
                     (define term (inbound (instantiate-term->value x captured-values)))
                     (push-script! inner-actor
                                   (lambda ()
                                     (match op
                                       ['+ (adhoc-assert! inner-actor term)]
                                       ['- (adhoc-retract! inner-actor term)]
                                       ['! (enqueue-send! inner-actor term)]))))
                   (lambda (cache)
                     (push-script! inner-actor
                                   (lambda ()
                                     (for [(captured-values (in-bag cache))]
                                       (define term
                                         (inbound (instantiate-term->value x captured-values)))
                                       (adhoc-retract! inner-actor term)))))))
        (hash-set! inbound-endpoints
                   x
                   (add-endpoint! outer-facet
                                  "dataspace-relay (observe (inbound ...))"
                                  (lambda () (observe x))
                                  i))))

  (on (retracted (observe (inbound $x)))
      (with-current-facet [outer-actor outer-facet #f]
        (remove-endpoint! outer-facet (hash-ref inbound-endpoints x))
        (hash-remove! inbound-endpoints x)))

  (on (asserted (outbound $x))
      (with-current-facet [outer-actor outer-facet #f]
        (hash-set! outbound-endpoints
                   x
                   (add-endpoint! outer-facet
                                  "dataspace-relay (outbound ...)"
                                  (lambda () x)
                                  #f))))

  (on (retracted (outbound $x))
      (with-current-facet [outer-actor outer-facet #f]
        (remove-endpoint! outer-facet (hash-ref outbound-endpoints x))
        (hash-remove! outbound-endpoints x)))

  (on (message (outbound $x))
      (with-current-facet [outer-actor outer-facet #f]
        (send! x))))