#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/pretty)
(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)

(match (getenv "SYNDICATE_COLUMNS")
  [#f (void)]
  [n (pretty-print-columns (string->number n))])

(define (pretty-assertion indent value)
  (define gap (make-string indent #\space))
  (parameterize ((pretty-print-print-line
                  (lambda (line-number port line-length columns)
                    (fprintf port "\n~a" gap)
                    indent)))
    (pretty-format value #:mode 'print)))

(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 (lambda (value handle)
                       (log-syndicate/dataspace-debug "~v + ~v~a" ds-e handle (pretty-assertion 4 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 (lambda (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~a" ds-e upstream-handle (pretty-assertion 4 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 (lambda (message)
                        (log-syndicate/dataspace-debug "~v !~a" ds-e (pretty-assertion 4 message))
                        (send-assertion! this-turn skeleton message))))
  (ref ds-e))

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