Commit da938933c53d434862ab4436cf6df46a640da44a

Thomas de Grivel 2014-04-02T20:05:31

Use CL-DEBUG.

diff --git a/asset.lisp b/asset.lisp
index 1f3a45e..889bdff 100644
--- a/asset.lisp
+++ b/asset.lisp
@@ -30,9 +30,7 @@
    (source-ext :initarg :source-ext
 	       :reader asset-source-ext
 	       :type extension)
-   (sources :initarg :sources
-	    :reader asset-sources
-	    :type list)
+   (sources :type list)
    (path :type string)
    (source-path :type string)
    (url :type string)))
@@ -43,6 +41,8 @@
 (defgeneric asset-source-path (asset))
 (defgeneric asset-include (output context asset &key &allow-other-keys))
 
+(defgeneric asset-sources (asset))
+(defgeneric asset-sources% (asset))
 (defgeneric asset-write-date (asset))
 (defgeneric compile-asset (asset output))
 
@@ -81,12 +81,29 @@
     (ignore-errors (format stream "~S" (asset-path asset)))
     (ignore-errors (format stream " ~S" (asset-source-path asset)))))
 
-(defmethod slot-unbound (class (asset asset) (slot (eql 'sources)))
-  (setf (slot-value asset 'sources) (list asset)))
+(defmethod asset-write-date ((assets cons))
+  (loop for a in assets
+     maximize (file-write-date (asset-source-path a))))
+
+(defmethod asset-sources% ((asset asset))
+  (list asset))
+
+(defmethod asset-sources ((asset asset))
+  (flet ((miss ()
+	   (let ((sources (asset-sources% asset)))
+	     (setf (slot-value asset 'sources)
+		   (cons (asset-write-date sources) sources))
+	     sources)))
+    (if (slot-boundp asset 'sources)
+	(destructuring-bind (cached-date &rest cached-sources)
+	    (slot-value asset 'sources)
+	  (if (= cached-date (asset-write-date cached-sources))
+	      cached-sources
+	      (miss)))
+	(miss))))
 
 (defmethod asset-write-date ((asset asset))
-  (loop for a in (asset-sources asset)
-     maximize (file-write-date (asset-source-path a))))
+  (asset-write-date (asset-sources asset)))
 
 (defmethod compile-asset ((asset asset) (output stream))
   (let ((path (asset-source-path asset)))
diff --git a/config.lisp b/config.lisp
index 9314c94..67bc246 100644
--- a/config.lisp
+++ b/config.lisp
@@ -20,8 +20,6 @@
 
 ;;  Config
 
-(defvar *debug* nil)
-
 (defvar *default-assets-dirs*
   '("lib/*/triangle/assets/*/"
     "lib/triangle/*/triangle/assets/*/"
diff --git a/js.lisp b/js.lisp
index 42fb4b7..5422937 100644
--- a/js.lisp
+++ b/js.lisp
@@ -53,7 +53,7 @@
 (defmethod process-asset ((asset js-asset)
 			  (output stream))
   (with-input-from-file/utf-8 (js (asset-source-path asset))
-    (if (or (find :js *debug*) (find :assets *debug*))
+    (if (debug-p (or :js :assets))
 	(copy-stream js output)
 	(jsmin js output)))
   (force-output output)
diff --git a/less.lisp b/less.lisp
index 828d822..2b4f10d 100644
--- a/less.lisp
+++ b/less.lisp
@@ -75,10 +75,14 @@ try {
 (defclass less-asset (css-asset)
   ((less-imports :type list)))
 
+(defgeneric less-imports% (asset))
+(defgeneric less-imports (asset))
+(defgeneric less-sources (asset))
+
 (defmethod asset-class-extensions ((class (eql 'less-asset)))
   '(.less))
 
-(defun less-imports% (asset)
+(defmethod less-imports% ((asset less-asset))
   (let* ((head (cons nil nil))
 	 (tail head))
     (regex-lines "(?:^|\\b)@import\\s+\"([^\"]+)\"\\s*;"
@@ -93,8 +97,6 @@ try {
 					       (cons a nil)))))))
     (cdr head)))
 
-(defgeneric less-imports (asset))
-
 (defmethod less-imports ((asset less-asset))
   (let* ((source-path (pathname (asset-source-path asset)))
 	 (write-date (file-write-date source-path))
@@ -105,8 +107,6 @@ try {
 	(cdr (setf (slot-value asset 'less-imports)
 		   (cons write-date (less-imports% asset)))))))
 
-(defgeneric less-sources (asset))
-
 (defmethod less-sources ((asset less-asset))
   (let* ((head (cons nil nil))
 	 (tail head))
@@ -153,6 +153,6 @@ try {
 	(path (truename (asset-source-path asset))))
     (less path
 	  (list :paths true-assets-dirs	:filename path)
-	  (list :yuicompress (not *debug*))
+	  (list :yuicompress (not (debug-p (or :css :less :assets))))
 	  output))
   (values))
diff --git a/lib.lisp b/lib.lisp
index 4f436aa..8724091 100644
--- a/lib.lisp
+++ b/lib.lisp
@@ -54,5 +54,5 @@
     (force-output)))
 
 (defun debug-msg (fmt &rest args)
-  (when *debug*
+  (when (debug-p :assets)
     (apply #'msg fmt args)))
diff --git a/lowh.triangle.assets.asd b/lowh.triangle.assets.asd
index 4291b4c..a90ee69 100644
--- a/lowh.triangle.assets.asd
+++ b/lowh.triangle.assets.asd
@@ -23,6 +23,7 @@
   :version "0.1"
   :description "Asset pipeline"
   :depends-on ("alexandria"
+	       "cl-debug"
 	       "cl-fad"
 	       "closer-mop"
 	       "cl-json"
diff --git a/package.lisp b/package.lisp
index 9d30f46..39b2a54 100644
--- a/package.lisp
+++ b/package.lisp
@@ -28,10 +28,9 @@
 
 (defpackage :lowh.triangle.assets
   (:nicknames :L>assets)
-  (:use :cl :alexandria :L>ext :L>files :L>uri :str)
+  (:use :cl :debug :alexandria :L>ext :L>files :L>uri :str)
   (:export
    ;;  Config
-   #:*debug*
    #:*assets-url-template*
    #:*assets-path-template*
    #:*assets-dirs*
diff --git a/preprocess.lisp b/preprocess.lisp
index 00e7a1b..a0ba2f7 100644
--- a/preprocess.lisp
+++ b/preprocess.lisp
@@ -81,27 +81,20 @@
       (with-input-from-file/utf-8 (input path)
 	(preprocess/stream asset input assets)))))
 
-(defgeneric preprocess-asset (asset))
-
-(defmethod preprocess-asset ((asset preprocessed-asset))
+(defmethod asset-sources% ((asset preprocessed-asset))
   (nreverse (preprocess/asset asset nil)))
 
-(defmethod slot-unbound (class
-			 (asset preprocessed-asset)
-			 (slot (eql 'sources)))
-  (setf (slot-value asset 'sources) (preprocess-asset asset)))
-
 ;;  Compile preprocessed assets
 
 (defmethod compile-asset ((asset preprocessed-asset) (output stream))
-  (let ((assets (preprocess-asset asset)))
+  (let ((assets (asset-sources asset)))
     (loop for a in assets
        ;;do (msg "P ~A" (asset-source-path a))
        do (process-asset a output))))
 
 (defmethod compile-asset ((asset preprocessed-asset) (output pathname))
   (ensure-directories-exist output)
-  (let ((assets (preprocess-asset asset)))
+  (let ((assets (asset-sources asset)))
     (when (or (not (file-exists-p output))
 	      (some (lambda (asset)
 		      (file-more-recent-p (asset-source-path asset)