#lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>

(provide (all-from-out "schemas/gen/dataspace.rkt")
         (all-from-out "schemas/gen/dataspace-patterns.rkt")
         (all-from-out "schemas/gen/dataspace-patterns.meta.rkt")

         dataspace
         actor-system/dataspace)

(require racket/match)

(require preserves)

(require "bag.rkt")
(require "main.rkt")
(require "skeleton.rkt")

(require "schemas/gen/dataspace.rkt")
(require "schemas/gen/dataspace-patterns.rkt")
(require "schemas/gen/dataspace-patterns.meta.rkt")

(define-logger syndicate/dataspace)

(define (dataspace #:name [name (gensym 'dataspace)])
  (define handles (make-hash))
  (define assertions (make-bag))
  (define skeleton (make-empty-skeleton))
  (define ds-e
    (entity #:name name
            #:assert (action (value handle)
                       (log-syndicate/dataspace-debug "~v + ~v ~v" ds-e handle value)
                       (define maybe-observe (parse-Observe value))
                       (hash-set! handles handle (cons value maybe-observe))
                       (when (eq? (bag-change! assertions value +1) 'absent->present)
                         (match maybe-observe
                           [(? eof-object?) (void)]
                           [(Observe pat ref) (add-interest! this-turn skeleton pat ref)])
                         (add-assertion! this-turn skeleton value)))
            #:retract (action (upstream-handle)
                        (match (hash-ref handles upstream-handle #f)
                          [#f (error 'dataspace "Peer retracted unknown handle ~v" upstream-handle)]
                          [(cons value maybe-observe)
                           (log-syndicate/dataspace-debug "~v - ~v ~v" ds-e upstream-handle value)
                           (hash-remove! handles upstream-handle)
                           (when (eq? (bag-change! assertions value -1) 'present->absent)
                             (remove-assertion! this-turn skeleton value)
                             (match maybe-observe
                               [(? eof-object?) (void)]
                               [(Observe pat ref) (remove-interest! this-turn skeleton pat ref)]))]))
            #:message (action (message)
                        (log-syndicate/dataspace-debug "~v ! ~v" ds-e message)
                        (send-assertion! this-turn skeleton message))))
  ds-e)

(define-syntax actor-system/dataspace
  (syntax-rules ()
    [(_ (ds) expr ...)
     (actor-system
      #:name 'dataspace
      (facet-prevent-inert-check! this-facet)
      (define ds (ref (dataspace)))
      expr ...)]))