Commit e91c12ba authored by Eric Timmons's avatar Eric Timmons
Browse files

Rework session

It is now a single object (bound to *SESSION*) instead of a variety of objects
bound to a variety of variables. This is especially nice since it allows us to
easily use SLOT-UNBOUND to initialize pieces of the session as needed.
parent 616cb6e3
......@@ -40,9 +40,7 @@
(defun call-with-bundle-local-config (thunk pn)
"Call THUNK in a dynamic environment that has the local config for the
clpmfile located at PN added to the config."
;; Override because we need to invalidate any config reading that has been
;; cached. Also need to rebind *CONFIG-SOURCES* since we're going to
;; destructively modify it.
;; We need to override the session since we're adding a new config source.
(with-clpm-session (:override t)
(config-add-file-source! (merge-pathnames ".clpm/bundle.conf"
(uiop:pathname-directory-pathname pn)))
......
......@@ -34,9 +34,9 @@
(defun initialize-config-sources ()
(setf *config-sources* *default-config-sources*))
(uiop:register-image-restore-hook 'initialize-config-sources)
(defmethod slot-unbound (class (session clpm-session) (slot-name (eql 'config-sources)))
"Initialize the config sources of the session with *DEFAULT-CONFIG-SOURCES*."
(setf (config-sources session) (copy-list *default-config-sources*)))
(defun get-config-source (config-source-specifier)
(with-clpm-session (:key `(get-config-source ,config-source-specifier))
......@@ -52,7 +52,7 @@
(defun config-add-cli-source! (ht)
(push (make-instance 'config-cli-source
:arg-ht ht)
*config-sources*))
(config-sources)))
(defun config-type-p (obj type)
(or (and (typep obj 'config-source)
......@@ -63,22 +63,18 @@
(defun config-add-file-source! (pn)
(when (uiop:probe-file* pn)
(setf *config-sources*
(setf (config-sources)
(append (remove-if-not (lambda (x)
(or
(config-type-p x 'config-env-source)
(config-type-p x 'config-cli-source)))
*config-sources*)
(config-sources))
(list (make-instance 'config-file-source :pathname pn))
(remove-if (lambda (x)
(or
(config-type-p x 'config-env-source)
(config-type-p x 'config-cli-source)))
*config-sources*)))))
(defun clear-global-config ()
"Clear the *config-sources* variable."
(setf *config-sources* nil))
(config-sources))))))
......@@ -90,7 +86,7 @@
(if (equal defined-children '(:*))
(remove-duplicates (mapcan (compose (rcurry #'config-source-implicit-keys path)
#'get-config-source)
*config-sources*)
(config-sources))
:test #'equal)
defined-children))))
......@@ -108,7 +104,7 @@ variables, then the config file, then the default config."
(setf (gethash key out) (apply #'config-value (append path (list key)))))
out)
(loop
:for config-source-specifier :in *config-sources*
:for config-source-specifier :in (config-sources)
:for config-source := (get-config-source config-source-specifier)
:for (value exists-p) := (multiple-value-list (config-source-value config-source path))
:until exists-p
......@@ -158,5 +154,3 @@ variables, then the config file, then the default config."
"Print the configuration to ~stream~."
(format stream "(version \"0.2\")~%~%")
(print-table (config-value) nil stream))
(uiop:register-clear-configuration-hook 'clear-global-config)
......@@ -5,39 +5,55 @@
(uiop:define-package #:clpm/session
(:use #:cl)
(:export #:*config-sources*
(:export #:clpm-session
#:config-sources
#:with-clpm-session))
(in-package #:clpm/session)
(defvar *session-cache* nil
"Bound to a hash-table when inside a CLPM session. Used to cache function
return values.")
(defclass clpm-session ()
((cache
:initarg :cache
:initform (make-hash-table :test 'equal)
:reader clpm-session-cache
:documentation
"A hash table used to cache results of function calls.")
(config-sources
:initarg :config-sources
:accessor clpm-session-config-sources)))
(defvar *config-sources* nil
"Bound to a list of config source specifiers inside a CLPM session.")
(defvar *session* nil
"Bound to a CLPM-SESSION object when inside a CLPM session.")
(defun config-sources (&optional (session *session*))
(clpm-session-config-sources session))
(defun (setf config-sources) (new-value &optional (session *session*))
(setf (clpm-session-config-sources session) new-value))
(defun call-with-clpm-session (thunk &key override key)
"Starts a new CLPM session if one does not currently exist (unless OVERRIDE is
non-NIL).
non-NIL). A session consists of a function cache, config sources, and config
cache.
If KEY is provided and an entry exists in *SESSION-CACHE* with that key, it is
returned from the cache instead of invoking THUNK. If THUNK is invoked, its
results are stored in the cache."
If KEY is provided and an entry exists in the session's cache with that
key (compared with EQUAL), it is returned from the cache instead of invoking
THUNK. If THUNK is invoked, its results are stored in the cache."
(cond
((or override (not *session-cache*))
(let* ((*session-cache* (make-hash-table :test 'equal))
(*config-sources* *config-sources*))
((or override (not *session*))
(let* ((*session* (make-instance 'clpm-session)))
(funcall thunk)))
((and *session-cache* key)
((and *session* key)
(multiple-value-bind (cached-values cached-values-exist-p)
(gethash key *session-cache*)
(gethash key (clpm-session-cache *session*))
(if cached-values-exist-p
(values-list cached-values)
(let ((result (multiple-value-list (funcall thunk))))
(setf (gethash key *session-cache*) result)
(setf (gethash key (clpm-session-cache *session*)) result)
(values-list result)))))
(t (funcall thunk))))
(defmacro with-clpm-session ((&key override key) &body body)
`(call-with-clpm-session (lambda () ,@body) :override ,override :key ,key))
`(call-with-clpm-session (lambda () ,@body)
:override ,override
:key ,key))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment