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

(provide (except-out (struct-out entity) entity)
         (rename-out [make-entity entity] [entity <entity>])

         (struct-out actor)
         (struct-out facet)
         (struct-out entity-ref)

         parse-Cap!)

(require racket/match)
(require (only-in racket/string string-join))

(require struct-defaults)
(require "support/counter.rkt")
(require "engine.rkt")

(struct entity (id name assert retract message sync data)
  #:transparent
  #:methods gen:custom-write
  [(define (write-proc e port mode)
     (fprintf port "#<entity:~a:~a>" (entity-id e) (entity-name e)))])

(define generate-entity-id (make-counter))

(define-struct-defaults make-entity entity
  (#:_id [entity-id (generate-entity-id)]
   #:name [entity-name '?]
   #:assert [entity-assert #f]
   #:retract [entity-retract #f]
   #:message [entity-message #f]
   #:sync [entity-sync #f]
   #:data [entity-data (void)]))

(struct actor (id
               name
               engine
               [daemon? #:mutable]
               dataflow
               [root #:mutable]
               [exit-reason #:mutable] ;; #f -> running, #t -> terminated OK, exn -> error
               [exit-hooks #:mutable])
  #:methods gen:custom-write
  [(define (write-proc a port mode)
     (fprintf port "#<actor:~a/~a:~a>" (engine-id (actor-engine a)) (actor-id a) (actor-name a)))])

(define (facet-path-to-root f)
  (string-join (reverse (let loop ((f f))
                          (if (facet-parent f)
                              (cons (number->string (facet-id f)) (loop (facet-parent f)))
                              '())))
               "/"))

(define (facet-liveness f)
  (if (facet-live? f)
      ""
      ":(DEAD)"))

(struct facet (id
               actor
               parent
               children
               outbound
               [end-of-turn-actions #:mutable]
               [shutdown-actions #:mutable]
               [live? #:mutable]
               [inert-check-preventers #:mutable])
  #:methods gen:custom-write
  [(define (write-proc f port mode)
     (local-require (only-in racket/string string-join))
     (fprintf port "#<facet:~a/~a:~a:~a~a>"
              (engine-id (actor-engine (facet-actor f)))
              (actor-id (facet-actor f))
              (actor-name (facet-actor f))
              (facet-path-to-root f)
              (facet-liveness f)))])

(struct entity-ref (relay target attenuation)
  #:transparent
  #:methods gen:custom-write
  [(define (write-proc r port mode)
     (match-define (entity-ref f e a) r)
     (fprintf port "#<ref:~a:~a:~a/~a:~a:~a~a~a>"
              (entity-id e)
              (entity-name e)
              (engine-id (actor-engine (facet-actor f)))
              (actor-id (facet-actor f))
              (actor-name (facet-actor f))
              (facet-path-to-root f)
              (facet-liveness f)
              (if (null? a)
                  ""
                  (format " ~s" a))))])

(define (parse-Cap! r)
  (if (entity-ref? r)
      r
      (error 'parse-Ref! "Expected entity-ref; got ~v" r)))