#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 syndicate/schemas/service)

         with-services
         provide-service

         standard-actor-system
         standard-actor-system/no-services)

(require racket/stxparam)
(require (for-syntax racket/base))

(require syndicate/syntax)
(require syndicate/pattern)
(require syndicate/dataspace)
(require syndicate/schemas/service)

(define-logger syndicate/service)

(define-syntax-parameter registry-dataspace
  (lambda (stx)
    (raise-syntax-error 'registry-dataspace "Illegal use" stx)))

(define-syntax with-services
  (syntax-rules ()
    [(_ [] body ...)
     (begin body ...)]
    [(_ [service-name more-services ...] body ...)
     (at registry-dataspace
       (during (ServiceRunning 'service-name)
         (with-services [more-services ...] body ...)))]))

(define-syntax provide-service
  (syntax-rules ()
    [(_ [dataspace] body ...)
     (module+ #%service
       (provide #%service)
       (define (#%service service-name dataspace)
         (syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
           (at dataspace (assert (ServiceRunning service-name)))
           body ...)))]))

(define-syntax standard-actor-system/no-services
  (syntax-rules ()
    [(_ [dataspace] body ...)
     (actor-system/dataspace (dataspace)
       #:name 'standard-actor-system
       (syntax-parameterize ([registry-dataspace (make-rename-transformer #'dataspace)])
         (spawn-service-manager dataspace)
         body ...))]))

(define-syntax standard-actor-system
  (syntax-rules ()
    [(_ [dataspace] body ...)
     (standard-actor-system/no-services [dataspace]
       (with-services [syndicate/drivers/stream
                       syndicate/drivers/tcp
                       syndicate/drivers/timer]
         body ...))]))

(define (spawn-service-manager ds)
  (spawn #:name 'syndicate/service
         #:daemon? #t
         (at ds
           (during (Observe (:pattern (ServiceRunning ,(DLit $service-name))) _)
             (assert (RequireService service-name)))

           (during/spawn (RequireService $service-name)
             #:name service-name
             #:daemon? #t
             (log-syndicate/service-info "Starting service ~a" service-name)
             (define boot
               (dynamic-require `(submod ,service-name #%service)
                                '#%service
                                (lambda () (error service-name "No service provided"))))
             (boot service-name ds)
             (on-stop (log-syndicate/service-info "Stopping service ~a" service-name))))))

;;---------------------------------------------------------------------------
;;; Local Variables:
;;; eval: (put 'provide-service 'racket-indent-function 1)
;;; eval: (put 'standard-actor-system 'racket-indent-function 1)
;;; eval: (put 'standard-actor-system/no-services 'racket-indent-function 1)
;;; End: