Better deployment fudging

default-config-deploy.lisp

@@ -0,0 +1,19 @@
+((:interfaces
+  (:admin . "r-simple-admin")
+  (:auth . "r-simple-auth")
+  (:ban . "r-simple-ban")
+  (:cache . "r-simple-cache")
+  (:data-model . "r-simple-model")
+  (:database . "i-sqlite")
+  (:relational-database . "i-sqlite")
+  (:logger . "i-verbose")
+  (:mail . "i-smtp")
+  (:profile . "r-simple-profile")
+  (:rate . "r-simple-rate")
+  (:server . "i-hunchentoot")
+  (:session . "r-simple-sessions")
+  (:user . "r-simple-users"))
+ (:domains . ("localhost"))
+ (:startup)
+ (:routes)
+ (:debugger))

deploy.lisp

@@ -1,12 +1,15 @@
 (in-package #:org.shirakumo.radiance.core)
 
-(deploy:define-hook (:load load-modules) ()
+(deploy:define-hook (:pre-load set-environment) ()
   (deploy:status 0 "Configuring environment")
   (setf *deploying-p* T)
-  (setf (environment) (if (boundp 'cl-user::environment)
-                          (symbol-value 'cl-user::environment)
-                          "deploy"))
-
+  (unless *environment*
+    (let ((*default-environment-config* (asdf:system-relative-pathname :radiance "default-config-deploy.lisp")))
+      (setf (environment) (if (boundp 'cl-user::environment)
+                              (symbol-value 'cl-user::environment)
+                              "deploy")))))
+
+(deploy:define-hook (:load load-modules) ()
   (when (boundp 'cl-user::modules)
     (deploy:status 1 "Loading target modules")
     (dolist (module (symbol-value 'cl-user::modules))
@@ -20,10 +23,12 @@
     #-quicklisp (asdf:load-system module))
 
   ;; Clear ASDF/QL
-  (mapc #'asdf:register-immutable-system (asdf:already-loaded-systems))
-  (asdf:clear-source-registry)
-  (setf asdf:*central-registry* NIL)
-  #+quicklisp (setf ql:*local-project-directories* ()))
+  (asdf:clear-configuration)
+  (setf (fdefinition 'asdf:upgrade-asdf) (lambda ()))
+  #+quicklisp (setf ql:*local-project-directories* ())
+  (dolist (system (asdf:already-loaded-systems))
+    (asdf:register-immutable-system system)
+    (asdf:clear-system system)))
 
 (deploy:define-hook (:deploy copy-resources) (directory)
   ;; Ensure expected directory structure:

environment.lisp

@@ -2,6 +2,8 @@
 
 (defvar *deploying-p* NIL)
 (defvar *environment* NIL)
+(defvar *default-environment-config*
+  (asdf:system-relative-pathname :radiance "default-config.lisp"))
 
 (define-hook environment-change ())
 
@@ -71,7 +73,7 @@
       (ubiquitous:restore #.*package*)
     (ubiquitous:no-storage-file ()
       (warn "Configuration for ~s not found-- creating from defaults." environment)
-      (ubiquitous:restore (asdf:system-relative-pathname :radiance "default-config.lisp"))
+      (ubiquitous:restore *default-environment-config*)
       (ubiquitous:offload #.*package*)))
   (trigger 'environment-change))