RailsOnLisp/rol-assets

diff --git a/asset.lisp b/asset.lisp
index cc61539..670bb72 100644
--- a/asset.lisp
+++ b/asset.lisp
@@ -35,7 +35,10 @@
    (sources :type list)
    (path :type string)
    (source-path :type string)
-   (url :type string)))
+   (url :type string)
+   (digest :type string
+           :initform nil
+           :accessor asset-digest)))
 
 (defgeneric asset-ext (asset))
 (defgeneric asset-url (asset))
@@ -47,30 +50,44 @@
 (defgeneric asset-sources% (asset))
 (defgeneric asset-write-date (asset))
 (defgeneric compile-asset (asset output))
+(defgeneric digest-asset (asset path))
 
 ;;  Base implementation
 
 (defmethod asset-ext ((asset asset))
   (asset-source-ext asset))
 
+(defmethod asset-digest ((asset asset))
+  (or (slot-value asset 'digest)
+      (let ((asset-path (expand-uri nil *assets-path-template*
+                                    :name (asset-name asset)
+                                    :ext (subseq (string-downcase (asset-ext asset))
+                                                 1))))
+        (when-let ((link (readlink asset-path)))
+          (cl-ppcre:register-groups-bind (name digest ext)
+              ("([^/]+)[.]([^./]+)([.][^./]+)$" link)
+            (when (and (string= name (asset-name asset))
+                       (string-equal ext (asset-ext asset)))
+              (setf (asset-digest asset) digest)
+              (slot-makunbound asset 'url)
+              (slot-makunbound asset 'path)
+              digest))))))
+
 (defmethod mime-type ((asset asset))
   (mime-type (asset-ext asset)))
 
 (defmethod asset-url ((asset asset))
-  (if (slot-boundp asset 'url)
-      #1=(slot-value asset 'url)
-      (setf #1# (expand-uri nil *assets-url-template*
-			    :name (asset-name asset)
-			    :ext (subseq (string-downcase (asset-ext asset))
-					 1)))))
+  (expand-uri nil *assets-url-template*
+              :name (asset-name asset)
+              :digest (asset-digest asset)
+              :ext (subseq (string-downcase (asset-ext asset))
+                           1)))
 
 (defmethod asset-path ((asset asset))
-  (if (slot-boundp asset 'path)
-      #1=(slot-value asset 'path)
-      (setf #1# (expand-uri nil *assets-path-template*
-			    :name (asset-name asset)
-			    :ext (subseq (string-downcase (asset-ext asset))
-					 1)))))
+  (expand-uri nil *assets-path-template*
+              :name (asset-name asset)
+              :digest (asset-digest asset)
+              :ext (subseq (string-downcase (asset-ext asset)) 1)))
 
 (defmethod asset-source-path ((asset asset))
   (if (slot-boundp asset 'source-path)
diff --git a/config.lisp b/config.lisp
index ca802ea..50275e9 100644
--- a/config.lisp
+++ b/config.lisp
@@ -44,8 +44,8 @@
 (defparameter *precompiled-assets*
   *default-precompiled-assets*)
 
-(defvar *assets-url-template* (uri-template "/assets{/name}{.ext}"))
-(defvar *assets-path-template* (uri-template "public/assets{/name}{.ext}"))
+(defvar *assets-url-template* (uri-template "/assets{/name}{.digest,ext}"))
+(defvar *assets-path-template* (uri-template "public/assets{/name}{.digest,ext}"))
 
 ;;  Config stanzas
 
diff --git a/digest.lisp b/digest.lisp
new file mode 100644
index 0000000..5907f27
--- /dev/null
+++ b/digest.lisp
@@ -0,0 +1,35 @@
+;;
+;;  RoL-assets  -  Asset pipeline
+;;
+;;  Copyright 2012-2015 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  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 :RoL-assets)
+
+(defun digest-file (path)
+  (positional:to-string
+   (ironclad:octets-to-integer
+    (ironclad:digest-file :sha1 path))
+   positional:+b26+))
+
+(defmethod digest-asset ((asset asset) (path pathname))
+  (setf (asset-digest asset) (digest-file path))
+  (let ((digest-path (asset-path asset)))
+    (sb-posix:link path digest-path)
+    (sb-posix:unlink path)
+    (sb-posix:symlink (make-pathname :name (pathname-name digest-path)
+                                     :type (pathname-type digest-path))
+                      path)
+    digest-path))
diff --git a/gzip.lisp b/gzip.lisp
new file mode 100644
index 0000000..d487723
--- /dev/null
+++ b/gzip.lisp
@@ -0,0 +1,36 @@
+;;
+;;  RoL-assets  -  Asset pipeline
+;;
+;;  Copyright 2012-2015 Thomas de Grivel <thomas@lowh.net>
+;;
+;;  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 :RoL-assets)
+
+(defvar *gzipped-extensions* '(.css .js .svg))
+
+(defun gzip (input &optional (output (str input ".gz")))
+  (with-temporary-file (tmp :element-type '(unsigned-byte 8)
+                            :prefix output)
+    (external-program:run "gzip" (list "-c")
+                          :input input
+                          :output tmp)
+    (sb-posix:link tmp output)
+    output))
+
+(defgeneric gzip-asset (asset path))
+
+(defmethod gzip-asset ((asset asset) path)
+  (when (find (asset-ext asset) *gzipped-extensions* :test #'eq)
+    (gzip path)))
diff --git a/package.lisp b/package.lisp
index 5077502..43f333f 100644
--- a/package.lisp
+++ b/package.lisp
@@ -54,6 +54,7 @@
    ;;  Observers
    #:asset-name
    #:asset-ext
+   #:asset-digest
    #:asset-path
    #:asset-url
    #:asset-sources
diff --git a/precompile.lisp b/precompile.lisp
index e341a99..fb66c48 100644
--- a/precompile.lisp
+++ b/precompile.lisp
@@ -26,8 +26,14 @@
 (defun precompile ()
   (msg "Precompile")
   (with-msg-indent (1)
+    (force-output)
     (dolist (asset (locate-precompiled-assets))
       (let ((output-path (asset-path asset)))
 	(msg "~A" output-path)
-	(with-msg-indent (1)
-	  (compile-asset asset (pathname output-path)))))))
+        (let ((pathname (pathname output-path)))
+          (with-msg-indent (1)
+            (compile-asset asset pathname))
+          (setq pathname (digest-asset asset pathname))
+          (msg "~A" pathname)
+          (when (setq pathname (gzip-asset asset pathname))
+            (msg "~A" pathname)))))))
diff --git a/rol-assets.asd b/rol-assets.asd
index f112b65..0c72495 100644
--- a/rol-assets.asd
+++ b/rol-assets.asd
@@ -30,12 +30,16 @@
   :description "Asset pipeline"
   :depends-on ("alexandria"
                "cfg"
+               "cl-base64"
 	       "cl-debug"
 	       "cl-fad"
                "cl-uglify-js"
 	       "closer-mop"
 	       "cl-json"
 	       "exec-js"
+               "external-program"
+               "ironclad"
+               "positional"
 	       "rol-files"
 	       "rol-uri"
 	       "str")
@@ -48,12 +52,14 @@
    (:file "mime-types" :depends-on ("extensions"))
    (:file "generate"   :depends-on ("lib"))
    (:file "asset"      :depends-on ("config" "mime-types" "lib"))
+   (:file "digest"     :depends-on ("asset"))
    (:file "find"       :depends-on ("asset"))
    (:file "font"       :depends-on ("asset"))
+   (:file "gzip"       :depends-on ("asset"))
    (:file "json"       :depends-on ("asset"))
-   (:file "precompile" :depends-on ("find"))
    (: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"))))
+   (:file "js"         :depends-on ("preprocess" "html"))
+   (:file "precompile" :depends-on ("find" "digest" "gzip"))))