cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

core: provide functions for simple config

Browse source
This commit is contained in:
Helmut Merz 2024-06-18 18:04:01 +02:00
parent ae24fabee5
commit e6b3567e10
4 changed files with 24 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
core/core.lisp
View file

@ -4,9 +4,9 @@
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:config :scopes/config) (:local-nicknames (:config :scopes/config)
(:message :scopes/core/message)) (:message :scopes/core/message))
(:export #:config #:service-config (:export #:root-config #:add-config
#:context #:*root* #:setup #:find-service #:default-start
#:name #:send #:context #:*root* #:setup #:find-service #:config #:name #:send
#:printer)) #:printer))
(in-package :scopes/core) (in-package :scopes/core)
@ -15,11 +15,18 @@
(defclass config (config:root) ()) (defclass config (config:root) ())
(defun root-config ()
(make-instance 'config))
(defclass service-config (config:base) (defclass service-config (config:base)
((name :reader name :initarg :name) ((name :reader name :initarg :name)
(start :reader start :initarg :start :initform #'default-start) (start :reader start :initarg :start :initform #'default-start)
(actions :reader actions :initarg :actions :initform nil))) (actions :reader actions :initarg :actions :initform nil)))
(defun add-config (parent name start &rest actions)
(make-instance 'service-config :parent parent :name name :start start
:actions actions))
;;;; actions ;;;; actions
(defclass action-spec () (defclass action-spec ()
@ -56,8 +63,8 @@
(actions :accessor actions :initform nil) (actions :accessor actions :initform nil)
(services :initform (make-hash-table)))) (services :initform (make-hash-table))))
(defun default-start (cfg) (defun default-start (cfg &optional (cls 'context))
(make-instance 'context :config cfg)) (make-instance cls :config cfg))
(defun find-service (name) (defun find-service (name)
(with-slots (services) *root* (with-slots (services) *root*
@ -88,10 +95,10 @@
(:method ((rcvr context) msg) (:method ((rcvr context) msg)
(let* ((acts (actions rcvr)) (let* ((acts (actions rcvr))
(hdlrs (select msg acts))) (hdlrs (select msg acts)))
(if (null hdlrs) (if hdlrs
(log:warn "no action selected for ~s" msg)
(dolist (hdlr hdlrs) (dolist (hdlr hdlrs)
(funcall hdlr rcvr msg)))))) (funcall hdlr rcvr msg))
(log:warn "no action selected for ~s" msg)))))
;;;; simple printer service ;;;; simple printer service

9
test/etc/config-core.lisp
View file

@ -2,9 +2,8 @@
(in-package :scopes/test-core) (in-package :scopes/test-core)
(setf *config* (make-instance 'core:config)) (setf *config* (core:root-config))
(make-instance 'core:service-config :parent *config* (core:add-config *config* :test-receiver #'start
:name :test-receiver '((:test) check-message)
:start #'(lambda (cfg) (make-instance 'test-receiver :config cfg)) )
:actions '(((:test) check-message)))

3
test/test-core.lisp
View file

@ -21,6 +21,9 @@
((expected :accessor expected ((expected :accessor expected
:initform (make-hash-table :test #'equalp)))) :initform (make-hash-table :test #'equalp))))
(defun start (cfg)
(core:default-start cfg 'test-receiver))
(defun check-message (ctx msg) (defun check-message (ctx msg)
(let ((key (message:head-as-list msg))) (let ((key (message:head-as-list msg)))
(multiple-value-bind (val found) (gethash key (expected ctx)) (multiple-value-bind (val found) (gethash key (expected ctx))

3
web/server.lisp
View file

@ -26,7 +26,8 @@
(setf *listener* (setf *listener*
(clack:clackup #'app (clack:clackup #'app
:port (parse-integer (port cfg)) :port (parse-integer (port cfg))
:address (address cfg)))) :address (address cfg)
:silent t)))
(defun stop () (defun stop ()
(clack:stop *listener*)) (clack:stop *listener*))