move additional config functionality from core to config

config.lisp

@@ -4,9 +4,9 @@
 
 (defpackage :scopes/config
   (:use :common-lisp)
-  (:export #:base #:root
+  (:export #:base #:root #:*root*
            #:env-data #:env-keys #:env-prefix #:env-path 
-           #:add #:children #:env-slots #:parent))
+           #:actions #:add #:add-action #:children #:env-slots #:name #:setup #:parent))
 
 (in-package :scopes/config)
 
@@ -22,6 +22,8 @@
 
 ;;;; config root (top-level) class with no parent
 
+(defvar *root* nil)
+
 (defclass root (common) 
   ((env-keys :reader env-keys 
              :initarg :env-keys
@@ -48,12 +50,17 @@
           (setf (gethash sl data) env-val)
           (setf (gethash sl data) dotenv-val))))))
 
+(defun root (&rest params)
+  (apply #'make-instance 'root params))
+
 ;;;; config base class
 
 (defclass base (common)
   ((env-slots :reader env-slots :initform nil :allocation :class)
-   (parent :reader parent
+   (name :reader name :initarg :name)
-           :initarg :parent)))
+   (parent :reader parent :initarg :parent)
+   (setup :reader setup :initarg :setup :initform #'(lambda (cfg)))
+   (actions :accessor actions :initarg :actions :initform nil)))
 
 (defmethod initialize-instance :after ((cfg base) &key parent &allow-other-keys)
   (when parent
@@ -64,15 +71,19 @@
   (push cfg (children parent))
   (env-override cfg))
 
-(defgeneric add (cfg child)
-  (:method ((cfg common) (child base))
-    (push child (children cfg))
-    (setf (parent child) cfg)
-    (env-override child)))
-
 (defmethod env-data ((cfg base))
   (env-data (parent cfg)))
 
+(defun add (parent name &rest params
+                   &key (class 'base)
+                   &allow-other-keys)
+  (apply #'make-instance class :parent parent :name name params))
+
+(defun add-action (cfg pattern handler &rest params)
+  (if params
+    (setf handler #'(lambda (ctx msg) (apply handler ctx msg params))))
+  (push (list pattern handler) (actions cfg)))
+
 ;;;; utility functions
 
 (defun hash-to-slots (ht obj slots)

core/core.lisp

@@ -4,7 +4,7 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:message :scopes/core/message))
-  (:export #:root-config #:service-config #:add-config #:add-action
+  (:export #:service-config #:add-config #:add-action
            #:default-setup #:setup-services
            #:context #:*root* #:find-service #:config #:name #:send
            #:printer))
@@ -13,25 +13,14 @@
 
 ;;;; config
 
-(defclass config (config:root) ())
-
-(defun root-config (&rest params)
-  (apply #'make-instance 'config params))
-
 (defclass service-config (config:base)
-  ((name :reader name :initarg :name)
+   ((setup :initform #'default-setup)))
-   (setup :reader setup :initarg :setup :initform #'default-setup)
-   (actions :accessor actions :initarg :actions :initform nil)))
 
 (defun add-config (parent name &rest params
                    &key (setup #'default-setup) (class 'service-config)
                    &allow-other-keys)
   (apply #'make-instance class :parent parent :name name :setup setup params))
 
-(defgeneric add-action (container pattern handler)
-  (:method ((cfg service-config) pattern handler)
-    (push (list pattern handler) (actions cfg))))
-
 ;;;; actions
 
 (defclass action-spec ()
@@ -70,7 +59,7 @@
     (services :initform (make-hash-table))))
 
 (defun default-setup (cfg &optional (cls 'context))
-  (make-instance cls :config cfg :name (name cfg)))
+  (make-instance cls :config cfg :name (config:name cfg)))
 
 (defun find-service (name)
   (with-slots (services) *root*
@@ -82,7 +71,7 @@
   (dolist (c (config:children cfg))
     (add-service *root* c)))
 
-(defmethod add-action ((ctx context) pat hdlr)
+(defun add-action (ctx pat hdlr)
   (let* ((acts (actions ctx))
          (act (find-action pat acts)))
     (if act
@@ -92,10 +81,10 @@
 
 (defun add-service (ctx cfg)
   (with-slots (services) ctx
-    (let ((child (funcall (setup cfg) cfg)))
+    (let ((child (funcall (config:setup cfg) cfg)))
-      (dolist (a (actions cfg))
+      (dolist (a (config:actions cfg))
         (add-action child (car a) (cadr a)))
-      (setf (gethash (name cfg) services) child))))
+      (setf (gethash (config:name cfg) services) child))))
 
 (defgeneric send (rcvr msg)
   (:method ((rcvr context) msg)

test/etc/config-core.lisp

@@ -2,7 +2,7 @@
 
 (in-package :scopes/test-core)
 
-(setf *config* (core:root-config))
+(setf *config* (config:root))
 
-(let ((cfg (core:add-config *config* :test-receiver :setup #'setup)))
+(let ((cfg (config:add *config* :test-receiver :setup #'setup)))
-  (core:add-action cfg '(:test) #'check-message))
+  (config:add-action cfg '(:test) #'check-message))

test/etc/config-web.lisp

@@ -2,7 +2,7 @@
 
 (in-package :scopes/test-web)
 
-(setf *config* (core:root-config :env-keys '(:address :port)))
+(setf *config* (config:root :env-keys '(:address :port)))
 
 (let ((cfg (core:add-config *config* :server 
                             :class 'server:config
@@ -10,4 +10,5 @@
                             :port "8899"))))
 
 (let ((cfg (core:add-config *config* :client 
-                            :class 'client:config))))
+                            :class 'client:config
+                            :base-url "http://localhost:8899"))))

test/test-web.lisp

@@ -32,6 +32,6 @@
     (== (parse-integer (server:port cfg)) 8899)))
 
 (t:deftest test-client ()
-  (let ((cfg (core:config (core:find-service :client))))
+  (let ((ctx (core:find-service :client)))
-    (== (client:url cfg) "http://localhost:8899")
+    (== (client:base-url (core:config ctx)) "http://localhost:8899")
-    (== (dexador:get (client:url cfg)) "Hello World!")))
+    (== (client:send-request ctx nil) "Hello World!")))

web/client.lisp

@@ -4,10 +4,17 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core))
-  (:export #:config #:url))
+  (:export #:config #:base-url
+           #:send-request))
 
 (in-package :scopes/web/client)
 
 (defclass config (core:service-config)
-  ((url :reader url :initarg :url :initform "http://localhost:8899")))
+  ((base-url :reader base-url 
+             :initarg :base-url 
+             :initform "http://localhost:8135")))
 
+;;;; client context (= service)
+
+(defun send-request (ctx msg)
+  (dex:get (base-url (core:config ctx))))

web/server.lisp

@@ -31,11 +31,11 @@
 (defun stop ()
   (clack:stop *listener*))
 
-;;;; context = service
+;;;; server context (= service)
 
 (defclass context (core:context) ())
 
 (defun setup (cfg)
   (prog1
-    (make-instance 'context :config cfg :name (core:name cfg))
+    (make-instance 'context :config cfg :name (config:name cfg))
     (start cfg)))