core: provide functions for simple config

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
 

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)
+                 )

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))

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*))