Refactor images-resize to use content-task

This refactor will avoid re-modifying unchanged image files
between builds, and also pave the way for the manifest task

Author: bhagany

src/io/perun.clj

@@ -130,32 +130,6 @@
                          (io.perun.contrib.images-dimensions/images-dimensions ~metas {}))]
       (pm/set-meta fileset updated-metas))))
 
-(def ^:private ^:deps images-resize-deps
-  '[[image-resizer "0.1.8"]])
-
-(def ^:private +images-resize-defaults+
-  {:out-dir "public"
-   :resolutions #{3840 2560 1920 1280 1024 640}})
-
-(deftask images-resize
-  "Resize images to the provided resolutions.
-   Each image file would have resolution appended to it's name:
-   e.x. san-francisco.jpg would become san-francisco_3840.jpg"
-  [o out-dir     OUTDIR       str    "the output directory"
-   r resolutions RESOLUTIONS  #{int} "resoulitions to which images should be resized"]
-  (boot/with-pre-wrap fileset
-    (let [options (merge +images-resize-defaults+ *opts*)
-          tmp (boot/tmp-dir!)
-          pod (create-pod images-resize-deps)
-          metas (trace :io.perun/images-resize
-                       (meta-by-ext fileset [".png" ".jpeg" ".jpg"]))
-          updated-metas (pod/with-call-in @pod
-                         (io.perun.contrib.images-resize/images-resize ~(.getPath tmp) ~metas ~options))]
-      (perun/report-debug "images-resize" "new resized images" updated-metas)
-      (-> fileset
-          (commit tmp)
-          (pm/set-meta updated-metas)))))
-
 (defn apply-out-dir
   [path old-out-dir new-out-dir]
   (let [path-args (if (= old-out-dir new-out-dir)
@@ -238,9 +212,9 @@
   `passthru-fn` to handle setting changed metadata on files copied from the
   previous fileset. If input files should be removed from the fileset, set
   `rm-originals` to `true`."
-  [{:keys [task-name render-form-fn paths-fn passthru-fn tracer pod rm-originals]}]
-  (let [tmp  (boot/tmp-dir!)
-        prev (atom {})
+  [{:keys [task-name render-form-fn paths-fn passthru-fn tracer pod tmp rm-originals]}]
+  (let [prev (atom {})
+        tmp (or tmp (boot/tmp-dir!))
         pod (or pod (create-pod content-deps))]
     (fn [next-task]
       (fn [fileset]
@@ -332,6 +306,69 @@
          (for [[path {:keys [entry]}] inputs]
            (merge entry (pm/path-meta path global-meta)))))
 
+(defn resize-paths
+  "Returns a map of path -> input for images-resize"
+  [fileset {:keys [out-dir parent-path meta resolutions] :as options} tmp-dir]
+  (let [global-meta (pm/get-global-meta fileset)
+        files (boot/ls fileset)]
+    (reduce
+     (fn [result {:keys [slug path extension] :as entry}]
+       (reduce
+        (fn [result* resolution]
+          (let [new-filename (str slug "_" resolution "." extension)
+                new-path (-> (perun/create-filepath parent-path new-filename)
+                             (apply-out-dir (:out-dir entry) out-dir))
+                input-file (first (boot/by-path [path] files))
+                img-meta (assoc (pm/path-meta new-path global-meta)
+                                :resolution resolution
+                                :input-paths #{path}
+                                :input-meta (merge (pm/meta-from-file fileset input-file)
+                                                   (select-keys input-file [:hash]))
+                                :tmp-dir tmp-dir)]
+            (assoc result*
+                   new-path (merge entry
+                                   meta
+                                   (when out-dir
+                                     {:out-dir out-dir})
+                                   img-meta))))
+        result
+        resolutions))
+     {}
+     (filter-meta-by-ext fileset options))))
+
+(def ^:private ^:deps images-resize-deps
+  '[[org.clojure/tools.namespace "0.3.0-alpha3"]
+    [image-resizer "0.1.8"]])
+
+(def ^:private +images-resize-defaults+
+  {:out-dir "public"
+   :resolutions #{3840 2560 1920 1280 1024 640}
+   :filterer identity
+   :extensions [".png" ".jpeg" ".jpg"]})
+
+(deftask images-resize
+  "Resize images to the provided resolutions.
+   Each image file would have resolution appended to it's name:
+   e.x. san-francisco.jpg would become san-francisco_3840.jpg"
+  [o out-dir     OUTDIR      str    "the output directory"
+   r resolutions RESOLUTIONS #{int} "resolutions to which images should be resized"
+   _ filterer    FILTER      code   "predicate to use for selecting entries (default: `identity`)"
+   e extensions  EXTENSIONS  [str]  "extensions of files to include (default: `[]`, aka, all extensions)"
+   m meta        META        edn    "metadata to set on each entry"]
+  ;; This prevents a Java icon appearing in the dock on a Mac, and stealing program focus
+  (System/setProperty "java.awt.headless" "true")
+  (let [pod (create-pod images-resize-deps)
+        tmp (boot/tmp-dir!)
+        options (merge +images-resize-defaults+ *opts*)]
+    (content-task
+     {:render-form-fn (fn [data] `(io.perun.contrib.images-resize/image-resize ~data))
+      :paths-fn #(resize-paths % options (.getPath tmp))
+      :passthru-fn content-passthru
+      :task-name "images-resize"
+      :tracer :io.perun/images-resize
+      :pod pod
+      :tmp tmp})))
+
 (def ^:private ^:deps yaml-metadata-deps
   '[[org.clojure/tools.namespace "0.3.0-alpha3"]
     [circleci/clj-yaml "0.5.5"]])

src/io/perun/contrib/images_resize.clj

@@ -9,29 +9,29 @@
      [java.awt.image BufferedImage]
      [javax.imageio ImageIO ImageWriter]))
 
-(defn write-file [options tmp file ^BufferedImage buffered-file resolution]
-  (let [{:keys [slug extension parent-path]} file
-        new-filename (str slug "_" resolution "." extension)
-        new-path (perun/create-filepath (:out-dir options) parent-path new-filename)
-        new-file (io/file tmp new-path)]
-    (io/make-parents new-file)
-    (ImageIO/write buffered-file extension new-file)
-    {:path new-path}))
-
-(defn resize-to [tgt-path file options resolution]
-  (let [io-file (-> file :full-path io/file)
-        buffered-image (iu/buffered-image io-file)
-        resized-buffered-image (resize/resize-to-width buffered-image resolution)
-        new-dimensions (iu/dimensions resized-buffered-image)
-        new-meta (write-file options tgt-path file resized-buffered-image resolution)
-        dimensions {:width (first new-dimensions) :height (second new-dimensions)}]
-    (merge file new-meta dimensions (select-keys options [:out-dir]))))
+(def img-cache (atom {}))
 
-(defn process-image [tgt-path file options]
-  (perun/report-debug "image-resize" "resizing" (:path file))
-  (pmap #(resize-to tgt-path file options %) (:resolutions options)))
+(defn get-input-img
+  [{:keys [input-meta]}]
+  (let [input-path (:full-path input-meta)
+        key (str input-path "-" (:hash input-meta))]
+    (if-let [buffered-image (get @img-cache key)]
+      @buffered-image
+      (let [buffered-image (future (-> input-path
+                                       io/file
+                                       iu/buffered-image))]
+        (swap! img-cache assoc key buffered-image)
+        @buffered-image))))
 
-(defn images-resize [tgt-path files options]
-  (let [updated-files (doall (mapcat #(process-image tgt-path % options) files))]
-    (perun/report-info "image-resize" "processed %s image files" (count files))
-    updated-files))
+(defn image-resize
+  [{:keys [path resolution extension tmp-dir] :as data}]
+  (perun/report-debug "image-resize" "resizing" path)
+  (let [buffered-image (get-input-img data)
+        resized-buffered-image (resize/resize-to-width buffered-image resolution)
+        new-file (io/file tmp-dir path)]
+    (io/make-parents new-file)
+    (ImageIO/write resized-buffered-image extension new-file)
+    (merge (dissoc data :input-meta :tmp-dir)
+           (into {} (map vector
+                         [:width :height]
+                         (iu/dimensions resized-buffered-image))))))