Finding Clojure functions doing slow IO

example.clj

(defn slow1 [] (Thread/sleep 500))
(defn slow2 [] (slow1) (slow1))
(defn example [] (slow1) (slow2))

(profile-calls {:vars [#'slow1 #'slow2]} default-profile example)
;; Calling  backend.main/slow1  took  500                                                                                                                                                                                                                                                                                                                                                        
;; Calling  backend.main/slow1  took  500                                                                                                                                                                                                                                                                                                                                                        
;; Calling  backend.main/slow1  took  500                                                                                                                                                                                                                                                                                                                                                        
;; Calling  backend.main/slow2  took  1001    

(let [opts {:vars [#'slow1 #'slow2]}]
  (print-calls opts (profile-collect-calls opts example)))
;; backend.main/slow1                                           called      3 times, total     1500 ms, avg      500 ms                                                                                                                                                                                                                                                                          
;; backend.main/slow2                                           called      1 times, total     1000 ms, avg     1000 ms     

;; Use with Clojure.test
(use-fixtures :each
  (tp/profile-calls-fixture {:namespaces ['foo.bar]
                             :vars [#'asd.asd/slow]}))

test_profiling.clj

(ns backend.test-profiling)

(defn profile-calls [{:keys [namespaces vars]} profile-fn f]
  (let [ns-vars (->> (mapcat ns-interns namespaces)
                     vals
                     (filter (comp fn? deref)))]
    (with-redefs-fn (->> (concat ns-vars vars)
                         (map (fn [avar]
                                (let [afn (deref avar)
                                      aname (symbol (str (:ns (meta avar))) (name (:name (meta avar))))]
                                  [avar (fn [& args]
                                          (profile-fn aname (fn [] (apply afn args))))])))
                         (into {}))
      f)))

;; FIXME: Use System/nanoTime instead
(defn default-profile [aname f]
  (let [start (System/currentTimeMillis)]
    (try
      (f)
      (finally
        (println "Calling " aname " took " (- (System/currentTimeMillis) start))))))

(defn profile-collect [calls aname f]
  (let [start (System/currentTimeMillis)]
    (try
      (f)
      (finally
        (swap! calls update aname (fnil conj []) (- (System/currentTimeMillis) start))))))

(defn profile-collect-calls [opts f]
  (let [calls (atom {})]
     (profile-calls opts (partial profile-collect calls) f)
     @calls))

(defn print-calls [opts calls]
  (let [calls (map (fn [[aname calls]]
                     (let [acount (count calls)
                           total (reduce + calls)]
                       {:aname aname
                        :calls calls
                        :acount acount
                        :total total
                        :avg (int (/ total acount))}))
                   calls)
        calls (reverse (sort-by (:sort-by opts :total) calls))]
    (doseq [{:keys [aname acount total avg]} calls]
      (println (format "%-60s called %6d times, total %8d ms, avg %8d ms" (str (namespace aname) "/" (name aname)) acount total avg)))))

(defn profile-calls-fixture [opts]
  (fn [f]
    (print-calls opts (profile-collect-calls opts f))))