Commit c4335b89a9ef5ce7de9c850affddea27201d0dc0

Thomas de Grivel 2014-01-13T13:52:01

Fix ASSET-WRITE-DATE for .less files.

diff --git a/asset.lisp b/asset.lisp
index a543410..32a62b0 100644
--- a/asset.lisp
+++ b/asset.lisp
@@ -111,17 +111,20 @@
 (defmethod asset-class-extensions ((asset asset))
   (asset-class-extensions (class-of asset)))
 
-;;  Extension -> asset class
+;;  Extension -> asset classes
 
-(defun extension-asset-class (extension
-			      &optional (class (find-class 'asset)))
+(defun extension-asset-classes (extension
+				&optional (class (find-class 'asset)))
   (declare (type extension extension)
 	   (type class class))
   (when extension
-    (labels ((matching-asset-class (c)
-	       (if (find extension (asset-class-extensions c))
-		   c
-		   (some #'matching-asset-class
-			 (closer-mop:class-direct-subclasses c)))))
-      (or (matching-asset-class class)
-	  class))))
+    (labels ((add (classes a)
+	       (reduce #'add (closer-mop:class-direct-subclasses a)
+		       :initial-value (cons a classes)))
+	     (matching-class (a)
+	       (if (find extension (asset-class-extensions a))
+		   (add nil a)
+		   (some #'matching-class
+			 (closer-mop:class-direct-subclasses a)))))
+      (or (matching-class class)
+	  `(,class)))))
diff --git a/css.lisp b/css.lisp
index 523b46b..21d8127 100644
--- a/css.lisp
+++ b/css.lisp
@@ -26,7 +26,7 @@
   '.css)
 
 (defmethod asset-class-extensions ((class (eql 'css-asset)))
-  '(.css .less))
+  '(.css))
 
 (defmethod asset-include ((output stream)
 			  (context (eql :html))
@@ -38,69 +38,6 @@
 " output)
   (values))
 
-;;  Compile
-
-(defmethod json:encode-json ((object pathname) &optional stream)
-  (json:encode-json (namestring object) stream))
-
-(defun less (src-path parser-options css-options &optional out)
-  (let* ((fmt "~
-var path = require('path'),
-    fs = require('fs'),
-    sys = require('util'),
-    os = require('os');
-var less = require('less');
-var src = ~A;
-var parser_opts = ~A;
-var css_opts = ~A;
-
-var print_error = function (e) {
-  less.writeError(e);
-  process.exit(2);
-}
-var print_tree = function (e, tree) {
-  if (e)
-    print_error(e);
-  try {
-    var css = tree.toCSS(css_opts);
-    process.stdout.write(css);
-  } catch (e) {
-    print_error(e);
-  }
-}
-var parse_data = function (e, data) {
-  if (e)
-    print_error(e);
-  try {
-    new(less.Parser)(parser_opts).parse(data, print_tree)
-  } catch (e) {
-    print_error(e);
-  }
-}
-try {
-  fs.readFile(path.resolve(process.cwd(), src), 'utf8', parse_data);
-} catch (e) {
-  print_error(e);
-}
-")
-	 (js (format nil fmt
-		     (json:encode-json-to-string src-path)
-		     (json:encode-json-plist-to-string parser-options)
-		     (json:encode-json-plist-to-string css-options))))
-    #+nil(format *error-output* "~%~A~%" js)
-    (exec-js:from-string js :safely nil :out out)))
-
-(defmethod process-asset ((asset css-asset)
-			  (output stream))
-  (let ((true-assets-dirs (cache-1 (eq *assets-dirs*)
-			    (mapcar #'truename (assets-dirs))))
-	(path (truename (asset-source-path asset))))
-    (less path
-	  (list :paths true-assets-dirs	:filename path)
-	  (list :yuicompress (not *debug*))
-	  output))
-  (values))
-
 (defmethod include-asset ((asset css-asset)
 			  (output stream))
   (format output "@import url('~A');~%" (asset-url asset)))
diff --git a/find.lisp b/find.lisp
index 939c0c9..838633d 100644
--- a/find.lisp
+++ b/find.lisp
@@ -113,22 +113,26 @@
   `(let (,name ,ext)
      (cl-ppcre:register-groups-bind (n e)
 	 ("^\\s*(.*?)(?:\\.([^./]+))?\\s*$" ,spec)
-       (setf ,name n ,ext (intern-extension e)))
+       (setf ,name n ,ext (when e (intern-extension e))))
      (let ((,name ,name) (,ext ,ext))
        ,@body)))
 
 (defun find-assets-from-spec (spec &optional class assets)
-  (let ((new-assets (if class
-			(find-assets class nil spec nil assets)
-			assets)))
-    (if (eq assets new-assets)
+  (labels ((assets-matching (class name ext)
+	     (if class
+		 (let ((new (find-assets class nil name
+					 (asset-class-extensions class)
+					 assets)))
+		   (unless (eq new assets)
+		     new))
+		 (when ext
+		   (some (lambda (class) (assets-matching class name ext))
+			 (extension-asset-classes ext))))))
+    (or (assets-matching class spec nil)
 	(with-asset-spec spec (name ext)
-	  (find-assets (or class (extension-asset-class ext))
-		       nil name ext assets)
-	  (when (eq assets new-assets)
-	    (find-assets (or class (extension-asset-class ext))
-			 nil name nil assets)))
-	new-assets)))
+	  (when ext
+	    (assets-matching class name ext)))
+	assets)))
 
 (defun find-assets-from-specs (specs &optional class assets)
   (reduce (lambda (assets spec)
diff --git a/less.lisp b/less.lisp
new file mode 100644
index 0000000..79cf8cd
--- /dev/null
+++ b/less.lisp
@@ -0,0 +1,114 @@
+;;
+;;  LowH Triangle Assets  -  Asset pipeline
+;;
+;;  Copyright 2012 Thomas de Grivel <billitch@gmail.com>
+;;
+;;  Permission to use, copy, modify, and distribute this software for any
+;;  purpose with or without fee is hereby granted, provided that the above
+;;  copyright notice and this permission notice appear in all copies.
+;;
+;;  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;;  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;;  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;;  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;;  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;;  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;;  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :lowh.triangle.assets)
+
+;;  Compile
+
+(defmethod json:encode-json ((object pathname) &optional stream)
+  (json:encode-json (namestring object) stream))
+
+(defun less (src-path parser-options css-options &optional out)
+  (let* ((fmt "~
+var path = require('path'),
+    fs = require('fs'),
+    sys = require('util'),
+    os = require('os');
+var less = require('less');
+var src = ~A;
+var parser_opts = ~A;
+var css_opts = ~A;
+
+var print_error = function (e) {
+  less.writeError(e);
+  process.exit(2);
+}
+var print_tree = function (e, tree) {
+  if (e)
+    print_error(e);
+  try {
+    var css = tree.toCSS(css_opts);
+    process.stdout.write(css);
+  } catch (e) {
+    print_error(e);
+  }
+}
+var parse_data = function (e, data) {
+  if (e)
+    print_error(e);
+  try {
+    new(less.Parser)(parser_opts).parse(data, print_tree)
+  } catch (e) {
+    print_error(e);
+  }
+}
+try {
+  fs.readFile(path.resolve(process.cwd(), src), 'utf8', parse_data);
+} catch (e) {
+  print_error(e);
+}
+")
+	 (js (format nil fmt
+		     (json:encode-json-to-string src-path)
+		     (json:encode-json-plist-to-string parser-options)
+		     (json:encode-json-plist-to-string css-options))))
+    #+nil(format *error-output* "~%~A~%" js)
+    (exec-js:from-string js :safely nil :out out)))
+
+;;  LESS
+
+(defclass less-asset (css-asset)
+  ((less-sources :type list)))
+
+(defmethod asset-class-extensions ((class (eql 'less-asset)))
+  '(.less))
+
+(defun less-imports (asset)
+  (let ((imports))
+    (regex-lines "(?:^|\\b)@import\\s+\"([^\"]+)\"\\s*;"
+		 (pathname (asset-source-path asset))
+		 :match (lambda (whole i)
+			  (declare (ignore whole))
+			  (pushnew i imports :test #'string=)))
+    imports))
+
+(defgeneric less-sources (asset))
+
+(defmethod less-sources ((asset less-asset))
+  (if (slot-boundp asset 'less-sources)
+      (slot-value asset 'less-sources)
+      (setf (slot-value asset 'less-sources)
+	    (mapcan (lambda (import)
+		      (let ((asset (find-asset import 'less-asset)))
+			(cons asset (less-sources asset))))
+		    (less-imports asset)))))
+
+(defmethod asset-write-date ((asset less-asset))
+  (loop for a in (less-sources asset)
+     maximize (file-write-date (asset-source-path a))))
+
+(defmethod process-asset ((asset less-asset)
+			  (output stream))
+  (let ((true-assets-dirs (cache-1 (eq *assets-dirs*)
+			    (mapcar #'truename (assets-dirs))))
+	(path (truename (asset-source-path asset))))
+    (less path
+	  (list :paths true-assets-dirs	:filename path)
+	  (list :yuicompress (not *debug*))
+	  output))
+  (values))
diff --git a/lowh.triangle.assets.asd b/lowh.triangle.assets.asd
index 4f6ae1c..4291b4c 100644
--- a/lowh.triangle.assets.asd
+++ b/lowh.triangle.assets.asd
@@ -28,7 +28,8 @@
 	       "cl-json"
 	       "exec-js"
 	       "lowh.triangle.files"
-	       "lowh.triangle.uri")
+	       "lowh.triangle.uri"
+	       "str")
   :components
   ((:file "package")
    (:file "config"     :depends-on ("package"))
@@ -45,4 +46,5 @@
    (:file "preprocess" :depends-on ("find"))
    (:file "image"      :depends-on ("asset" "html"))
    (:file "css"        :depends-on ("preprocess" "html"))
+   (:file "less"       :depends-on ("css"))
    (:file "js"         :depends-on ("preprocess" "html"))))
diff --git a/package.lisp b/package.lisp
index 1d92baf..aee5eca 100644
--- a/package.lisp
+++ b/package.lisp
@@ -28,7 +28,7 @@
 
 (defpackage :lowh.triangle.assets
   (:nicknames :L>assets)
-  (:use :cl :alexandria :L>ext :L>files :L>uri)
+  (:use :cl :alexandria :L>ext :L>files :L>uri :str)
   (:export
    ;;  Config
    #:*debug*