diff --git a/core/core.lisp b/core/core.lisp index 799b06f..13827a6 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -4,8 +4,10 @@ (:use :common-lisp) (:local-nicknames (:config :scopes/config) (:message :scopes/core/message)) - (:export #:config #:service-config - #:context #:name #:actions #:add-action #:send + (:export #:*root* #:setup #:find-service + #:config #:service-config + #:name #:start #:actions + #:context #:add-action #:add-service #:send #:action-spec #:printer)) @@ -13,11 +15,12 @@ ;;;; config -(defclass config (config:root) - (services)) +(defclass config (config:root) ()) (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) - (actions :accessor actions :initform nil))) + ((config :reader config :initarg :config) + (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)) diff --git a/test/etc/config-core.lisp b/test/etc/config-core.lisp index 5431f51..54380c4 100644 --- a/test/etc/config-core.lisp +++ b/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))) diff --git a/test/test-core.lisp b/test/test-core.lisp index 43f726a..4634677 100644 --- a/test/test-core.lisp +++ b/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 - :initform (make-instance 'test-receiver)))) + ((receiver :accessor receiver :initarg :receiver))) (defun run () (let* ((*config* nil) - (t:*test-suite* (make-instance 'test-suite :name "core")) - (rcvr (receiver t:*test-suite*))) + (t:*test-suite* (make-instance 'test-suite :name "core"))) (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) )) diff --git a/test/test-web.lisp b/test/test-web.lisp index c69428e..612e6a3 100644 --- a/test/test-web.lisp +++ b/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"))) - ;(print (dexador:get "http://127.0.0.1:8899"))) - (print (client:url cfg)) - (print (dexador:get (client:url cfg)))) + (== (dexador:get (client:url cfg)) "Hello World!")) diff --git a/web/server.lisp b/web/server.lisp index 4651415..3962ecf 100644 --- a/web/server.lisp +++ b/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))))