core: rename 'start' to 'setup' - used only for creation and initial set-up (with name)
This commit is contained in:
parent
0eeabb4321
commit
978c3ee8bc
4 changed files with 15 additions and 15 deletions
|
@ -5,8 +5,8 @@
|
|||
(:local-nicknames (:config :scopes/config)
|
||||
(:message :scopes/core/message))
|
||||
(:export #:root-config #:add-config #:add-action
|
||||
#:default-start
|
||||
#:context #:*root* #:setup #:find-service #:config #:name #:send
|
||||
#:default-setup #:setup-services
|
||||
#:context #:*root* #:find-service #:config #:name #:send
|
||||
#:printer))
|
||||
|
||||
(in-package :scopes/core)
|
||||
|
@ -20,11 +20,11 @@
|
|||
|
||||
(defclass service-config (config:base)
|
||||
((name :reader name :initarg :name)
|
||||
(start :reader start :initarg :start :initform #'default-start)
|
||||
(setup :reader setup :initarg :setup :initform #'default-setup)
|
||||
(actions :accessor actions :initarg :actions :initform nil)))
|
||||
|
||||
(defun add-config (parent name start &rest actions)
|
||||
(make-instance 'service-config :parent parent :name name :start start
|
||||
(defun add-config (parent name setup &rest actions)
|
||||
(make-instance 'service-config :parent parent :name name :setup setup
|
||||
:actions actions))
|
||||
|
||||
(defgeneric add-action (container pattern handler)
|
||||
|
@ -64,18 +64,19 @@
|
|||
|
||||
(defclass context ()
|
||||
((config :reader config :initarg :config)
|
||||
(name :reader name :initarg :name)
|
||||
(actions :accessor actions :initform nil)
|
||||
(services :initform (make-hash-table))))
|
||||
|
||||
(defun default-start (cfg &optional (cls 'context))
|
||||
(make-instance cls :config cfg))
|
||||
(defun default-setup (cfg &optional (cls 'context))
|
||||
(make-instance cls :config cfg :name (name cfg)))
|
||||
|
||||
(defun find-service (name)
|
||||
(with-slots (services) *root*
|
||||
(when services
|
||||
(gethash name services))))
|
||||
|
||||
(defun setup (cfg)
|
||||
(defun setup-services (cfg)
|
||||
(setf *root* (make-instance 'context :config cfg))
|
||||
(dolist (c (config:children cfg))
|
||||
(add-service *root* c)))
|
||||
|
@ -90,7 +91,7 @@
|
|||
|
||||
(defun add-service (ctx cfg)
|
||||
(with-slots (services) ctx
|
||||
(let ((child (funcall (start cfg) cfg)))
|
||||
(let ((child (funcall (setup cfg) cfg)))
|
||||
(dolist (a (actions cfg))
|
||||
(add-action child (car a) (cadr a)))
|
||||
(setf (gethash (name cfg) services) child))))
|
||||
|
|
|
@ -4,5 +4,5 @@
|
|||
|
||||
(setf *config* (core:root-config))
|
||||
|
||||
(let ((cfg (core:add-config *config* :test-receiver #'start)))
|
||||
(let ((cfg (core:add-config *config* :test-receiver #'setup)))
|
||||
(core:add-action cfg '(:test) #'check-message))
|
||||
|
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
(in-package :scopes/test-config)
|
||||
|
||||
(setf *config*
|
||||
(make-instance 'test-config))
|
||||
(setf *config* (make-instance 'test-config))
|
||||
|
||||
(make-instance 'child-config :parent *config*)
|
||||
|
|
|
@ -21,8 +21,8 @@
|
|||
((expected :accessor expected
|
||||
:initform (make-hash-table :test #'equalp))))
|
||||
|
||||
(defun start (cfg)
|
||||
(core:default-start cfg 'test-receiver))
|
||||
(defun setup (cfg)
|
||||
(core:default-setup cfg 'test-receiver))
|
||||
|
||||
(defun check-message (ctx msg)
|
||||
(let ((key (message:head-as-list msg)))
|
||||
|
@ -53,7 +53,7 @@
|
|||
(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:setup *config*)
|
||||
(core:setup-services *config*)
|
||||
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
|
||||
(test-send)
|
||||
(check-expected)
|
||||
|
|
Loading…
Add table
Reference in a new issue