From e6b3567e106602c3fa63c28b84b7f16bdb38bded Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Tue, 18 Jun 2024 18:04:01 +0200
Subject: [PATCH] core: provide functions for simple config

---
 core/core.lisp            | 23 +++++++++++++++--------
 test/etc/config-core.lisp |  9 ++++-----
 test/test-core.lisp       |  3 +++
 web/server.lisp           |  3 ++-
 4 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index e86102d..078dfa8 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -4,9 +4,9 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:message :scopes/core/message))
-  (:export #:config #:service-config
-           #:context #:*root* #:setup #:find-service
-           #:name #:send
+  (:export #:root-config #:add-config
+           #:default-start
+           #:context #:*root* #:setup #:find-service #:config #:name #:send
            #:printer))
 
 (in-package :scopes/core)
@@ -15,11 +15,18 @@
 
 (defclass config (config:root) ())
 
+(defun root-config ()
+  (make-instance 'config))
+
 (defclass service-config (config:base)
   ((name :reader name :initarg :name)
    (start :reader start :initarg :start :initform #'default-start)
    (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
 
 (defclass action-spec ()
@@ -56,8 +63,8 @@
     (actions :accessor actions :initform nil)
     (services :initform (make-hash-table))))
 
-(defun default-start (cfg)
-  (make-instance 'context :config cfg))
+(defun default-start (cfg &optional (cls 'context))
+  (make-instance cls :config cfg))
 
 (defun find-service (name)
   (with-slots (services) *root*
@@ -88,10 +95,10 @@
   (:method ((rcvr context) msg)
     (let* ((acts (actions rcvr))
            (hdlrs (select msg acts)))
-      (if (null hdlrs)
-        (log:warn "no action selected for ~s" msg)
+      (if hdlrs
         (dolist (hdlr hdlrs)
-          (funcall hdlr rcvr msg))))))
+          (funcall hdlr rcvr msg))
+        (log:warn "no action selected for ~s" msg)))))
 
 ;;;; simple printer service
 
diff --git a/test/etc/config-core.lisp b/test/etc/config-core.lisp
index 54380c4..fb0d977 100644
--- a/test/etc/config-core.lisp
+++ b/test/etc/config-core.lisp
@@ -2,9 +2,8 @@
 
 (in-package :scopes/test-core)
 
-(setf *config* (make-instance 'core:config))
+(setf *config* (core:root-config))
 
-(make-instance 'core:service-config :parent *config*
-               :name :test-receiver
-               :start #'(lambda (cfg) (make-instance 'test-receiver :config cfg))
-               :actions '(((:test) check-message)))
+(core:add-config *config* :test-receiver #'start
+                 '((:test) check-message)
+                 )
diff --git a/test/test-core.lisp b/test/test-core.lisp
index a5142e6..d1cade9 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -21,6 +21,9 @@
   ((expected :accessor expected 
              :initform (make-hash-table :test #'equalp))))
 
+(defun start (cfg)
+  (core:default-start cfg 'test-receiver))
+
 (defun check-message (ctx msg)
   (let ((key (message:head-as-list msg)))
     (multiple-value-bind (val found) (gethash key (expected ctx))
diff --git a/web/server.lisp b/web/server.lisp
index 3962ecf..dc04d3b 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -26,7 +26,8 @@
   (setf *listener*
     (clack:clackup #'app
                    :port (parse-integer (port cfg))
-                   :address (address cfg))))
+                   :address (address cfg)
+                   :silent t)))
 
 (defun stop ()
   (clack:stop *listener*))