#lang racket/base
;; Breaking the infinite tower of nested dataspaces, connecting to Racket at the fracture line.

(provide current-ground-event-async-channel
         ground-send!
         ground-assert!
         ground-retract!
         signal-background-activity!
         extend-ground-boot!
         run-ground)

(define-logger syndicate/ground)

(require racket/async-channel)
(require racket/set)
(require racket/match)
(require racket/list)
(require "dataspace.rkt")
(require "syntax.rkt")

(define current-ground-event-async-channel (make-parameter #f))
(define *ground-boot-extensions* '())

(define (ground-enqueue! item)
  (async-channel-put (current-ground-event-async-channel) item))

(define (ground-send! body)
  (ground-enqueue! (lambda (ac) (enqueue-send! ac body))))

(define (ground-assert! assertion)
  (ground-enqueue! (lambda (ac) (adhoc-assert! ac assertion))))

(define (ground-retract! assertion)
  (ground-enqueue! (lambda (ac) (adhoc-retract! ac assertion))))

(define (signal-background-activity! delta)
  (ground-enqueue! delta))

(define (extend-ground-boot! proc)
  (set! *ground-boot-extensions* (cons proc *ground-boot-extensions*)))

(define (run-ground* boot-proc)
  (define ch (make-async-channel))
  (parameterize ((current-ground-event-async-channel ch))
    (define ground-event-relay-actor #f)
    (define background-activity-count 0)

    (define (handle-ground-event-item item)
      (match item
        [(? procedure? proc)
         (push-script! ground-event-relay-actor
                       (lambda () (proc ground-event-relay-actor)))]
        [(? number? delta)
         (set! background-activity-count (+ background-activity-count delta))]))

    (define (drain-external-events)
      (define item (async-channel-try-get ch))
      (when item
        (handle-ground-event-item item)
        (drain-external-events)))

    (define ground-event-relay-evt
      (handle-evt ch (lambda (item)
                       (handle-ground-event-item item)
                       (drain-external-events))))

    (define ds (make-dataspace
                (lambda ()
                  (schedule-script! (current-actor)
                                    (lambda ()
                                      (spawn #:name 'ground-event-relay
                                             (set! ground-event-relay-actor (current-actor))
                                             ;; v Adds a dummy endpoint to keep this actor alive
                                             (begin/dataflow (void)))))
                  (schedule-script! (current-actor)
                                    (lambda ()
                                      (boot-proc)
                                      (let ((extensions (reverse *ground-boot-extensions*)))
                                        (set! *ground-boot-extensions* '())
                                        (for [(p (in-list extensions))] (p))))))))

    (let loop ()
      (define work-remaining? (run-scripts! ds))
      (define events-expected? (positive? background-activity-count))
      (log-syndicate/ground-debug "GROUND: ~a; ~a background activities"
                                  (if work-remaining? "busy" "idle")
                                  background-activity-count)
      (cond
        [events-expected?
         (sync ground-event-relay-evt (if work-remaining? (system-idle-evt) never-evt))
         (loop)]
        [work-remaining?
         (sync ground-event-relay-evt (system-idle-evt))
         (loop)]
        [else
         (sync (handle-evt ground-event-relay-evt (lambda _ (loop))) (system-idle-evt))]))))

(define (run-ground boot-proc)
  (if (equal? (getenv "SYNDICATE_PROFILE") "ground")
      (let ()
        (local-require profile)
        (profile (run-ground* boot-proc)))
      (run-ground* boot-proc)))