with-dir.clj

(defn same-val [m]
  (-> (fn [nm [k v]]
        (let [in-other? (-> (dissoc m k) vals set)]
          (if (in-other? v)
            (assoc nm k v)
            nm)))
      (reduce nil m)))

(defn dir-scoper
  "Returns a variadic function for one or two filesets."
  [dirs]
  (fn scope-unscope
    ([fileset]
     (let [pttrns      (re-pattern (string/join "|" (map #(str "^" %) dirs)))
           path->new   (fn [path] (string/replace path pttrns ""))
           mapping     (into {} (for [f    (ls fileset)
                                      :let [old (:path f)
                                            new (path->new (:path f))]]
                                  [old (if-not (= new old) new)]))
           {:keys [rm* mv*]} (group-by #(if (nil? (val %)) :rm* :mv*) mapping)
           in-scope    (by-path (map first mv*) (ls fileset))
           out-scope   (by-path (map first rm*) (ls fileset))
           only-in     (rm fileset out-scope)]
       (when-let [conflicts (same-val (into {} mv*))]
         (util/warn "Scoping conflict, files with same relative path exist\n%s"
                    (with-out-str (clojure.pprint/pprint conflicts))))
       (reduce #(mv %1 (first %2) (second %2)) only-in mv*)))
    ([original scoped]
     (reduce (fn [fs f]
               (let [exists?  (->> fs :tree keys set)
                     new-locs (map #(str % (:path f)) dirs)
                     matches  (->> new-locs (map exists?) (remove nil?))]
                 (let [new-loc (first matches)]
                   (if (exists? new-loc)
                     (do (util/dbug "Moving %s to %s\n" (:path f) new-loc)
                         (assoc-in fs [:tree new-loc] (assoc f :path new-loc)))
                     (do (util/dbug "Moving %s to %s\n" (:path f) (:path f))
                         (assoc-in fs [:tree (:path f)] f))))))
             original
             (ls scoped)))))

(deftask with-scope
  ;; TODO generalize to take transformation functions before/after
  [d dir          DIR  #{str}  "directory in fileset to use as root - must end with /"
   t task         TASK  code "task to run with scoped fileset as input"
   m transform-fn TRANS code "function to merge resulting fileset with prev"]
  (let [scope   #((dir-scoper dir) %)
        unscope #((dir-scoper dir) %1 %2)
        prev    (atom {})]
    (fn [next-handler]
      (fn [original-fs]
        (let [scoped (scope original-fs)
              diff   (fileset-diff @prev scoped)]
          (reset! prev scoped)
          (if (seq (ls diff))
            ((task
              (fn [scoped-fs]
                (next-handler (commit! (unscope original-fs scoped-fs)))))
             (commit! scoped))
            (next-handler original-fs)))))))