core: provide context / services setup machinery

core/core.lisp

@@ -4,8 +4,10 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:message :scopes/core/message))
-  (:export #:config #:service-config
+  (:export #:*root* #:setup #:find-service
-           #:context #:name #:actions #:add-action #:send
+           #:config #:service-config
+           #:name #:start #:actions
+           #:context #:add-action #:add-service #:send
            #:action-spec
            #:printer))
 
@@ -13,11 +15,12 @@
 
 ;;;; config
 
-(defclass config (config:root) 
+(defclass config (config:root) ())
-  (services))
 
 (defclass service-config (config:base)
-  (start))
+  ((name :reader name :initarg :name)
+   (start :reader start :initarg :start :initform nil)
+   (actions :reader actions :initarg :actions :initform nil)))
 
 ;;;; actions
 
@@ -48,11 +51,22 @@
 
 ;;;; context
 
-(defvar *context* nil)
+(defvar *root* nil)
 
 (defclass context () 
-  ((name :reader name :initarg :name)
+   ((config :reader config :initarg :config)
-   (actions :accessor actions :initform nil)))
+    (actions :accessor actions :initform nil)
+    (services :accessor services :initform nil)))
+
+(defun find-service (name)
+  (with-slots (services) *root*
+    (when services
+      (gethash name services))))
+
+(defun setup (cfg)
+  (setf *root* (make-instance 'context :config cfg))
+  (dolist (c (config:children cfg))
+    (add-service *root* c)))
 
 (defun add-action (ctx pat hdlr)
   (let* ((acts (actions ctx))
@@ -62,6 +76,16 @@
       (push (make-instance 'action-spec :pattern pat :handlers (list hdlr)) 
             (actions ctx)))))
 
+(defun add-service (ctx cfg)
+  (with-slots (services) ctx
+    (unless services
+      (setf services (make-hash-table)))
+    ;(let ((child (make-instance 'context :config cfg)))
+    (let ((child (funcall (start cfg) cfg)))
+      (dolist (a (actions cfg))
+        (add-action child (car a) (cadr a)))
+      (setf (gethash (name cfg) services) child))))
+
 (defgeneric send (rcvr msg)
   (:method ((rcvr context) msg)
     (let* ((acts (actions rcvr))

test/etc/config-core.lisp

@@ -4,3 +4,7 @@
 
 (setf *config* (make-instance 'core:config))
 
+(make-instance 'core:service-config :parent *config*
+               :name :test-receiver
+               :start #'(lambda (cfg) (make-instance 'test-receiver :config cfg))
+               :actions '(((:test) check-message)))

test/test-core.lisp

@@ -18,8 +18,7 @@
 ;;;; core/testing: test-receiver
 
 (defclass test-receiver (core:context)
-  ((core:name :initform :test-rcvr)
+  ((expected :accessor expected 
-   (expected :accessor expected 
              :initform (make-hash-table :test #'equalp))))
 
 (defun check-message (ctx msg)
@@ -44,16 +43,16 @@
 ;;;; test runner
 
 (defclass test-suite (t:test-suite)
-  ((receiver :reader receiver 
+  ((receiver :accessor receiver :initarg :receiver)))
-             :initform (make-instance 'test-receiver))))
 
 (defun run ()
   (let* ((*config* nil)
-         (t:*test-suite* (make-instance 'test-suite :name "core"))
+         (t:*test-suite* (make-instance 'test-suite :name "core")))
-         (rcvr (receiver t:*test-suite*)))
     (log4cl:log-config :sane :daily (t:test-path "scopes-test.log" "log"))
     (load (t:test-path "config-core" "etc"))
-    (core:add-action rcvr '(:test) #'check-message)
+    ;(core:add-action rcvr '(:test) #'check-message)
+    (core:setup *config*)
+    (setf (receiver t:*test-suite*) (core:find-service :test-receiver))
     (test-send)
     (check-expected)
     (t:show-result)))
@@ -63,6 +62,6 @@
         (msg (message:simple-message '(:test :dummy) "dummy payload"))
         (msg-exp (message:simple-message '(:test :dummy) "dummy payload")))
     (expect rcvr msg-exp)
-    (== (core:name rcvr) :test-rcvr)
+    (== (core:name (core:config rcvr)) :test-receiver)
     (core:send rcvr msg)
     ))

test/test-web.lisp

@@ -33,7 +33,4 @@
 
 (t:deftest test-client (cfg)
   (== (client:url cfg) "http://localhost:8899")
-  ;(print (dexador:get "https://github.com")))
+  (== (dexador:get (client:url cfg)) "Hello World!"))
-  ;(print (dexador:get "http://127.0.0.1:8899")))
-  (print (client:url cfg))
-  (print (dexador:get (client:url cfg))))

web/server.lisp

@@ -24,7 +24,7 @@
 
 (defun start (cfg)
   (setf *listener*
-    (clack:clackup #'(lambda (env) (app env))
+    (clack:clackup #'app
                    :port (parse-integer (port cfg))
                    :address (address cfg))))