defthreadfn.clj

(defmacro defthreadfn
  "Binds a var to a particular class of anonymous functions that
  accept a vector of arguments and a number of subexpressions. When
  calling the produced functions, the caller must supply a threading
  parameter as the first argument. This parameter will be threaded
  through the resulting forms; the extra parameters made available in
  the argument vector will be available to all subexpressions.

  In addition to the argument vector, `defthreadfn` accepts any number
  of watchdog functions, each of which are inserted into the thread
  after each subexpression invocation. These watchdog functions are
  required to accept 2 arguments -- the threaded argument, and a
  string representation of the previous subexpression. For example,

    (defthreadfn mapped-thread-fn
      (fn [arg sub-expr]
        (if (map? arg)
          arg
          (condition/raise
           :type :invalid-session
           :message
           (format \"Only maps are allowed, and %s is most definitely
                   not a map.\" sub-expr)))))

  Returns a `thread-fn` that makes sure the threaded argument remains
  a map, on every step of its journey.

  For a more specific example if `defthreadfn`, see
  `pallet.phase/phase-fn`."
  [macro-name & rest]
  (let [[macro-name checkers] (name-with-attributes macro-name rest)]
    `(defmacro ~macro-name
       ([argvec#] (~macro-name argvec# identity))
       ([argvec# subphase# & left#]
          `(fn [~'session# ~@argvec#]
             (--> ~'session#
                  ~subphase#
                  ~@(for [func# '~checkers]
                      `(~func# (str '~subphase#)))
                  ~@(when left#
                      [`((~'~macro-name ~argvec# ~@left#) ~@argvec#)])))))))

;; For example,
;;
;;     (defthreadfn ultrasafe-phase-fn
;;         "docstring!"
;;          watchdog-func-1 watchdog-func-2 watchdog-func-3)
;;
;; Will define a macro that can be called like this:
;;
;;     (ultrasafe-phase-fn [x y z]
;;         (phase1 x y)
;;         (phase2 x y z))
;;
;; Which will (recursively) expand into
;;
;;     (fn [arg x y z]
;;       (--> arg
;;            (phase1 x y)
;;            (watchdog-func-1 "(phase1 x y)")
;;            (watchdog-func-2 "(phase1 x y)")
;;            (watchdog-func-3 "(phase1 x y)")
;;            (phase2 x y z)
;;            (watchdog-func-1 "(phase2 x y z)")
;;            (watchdog-func-2 "(phase2 x y z)")
;;            (watchdog-func-3 "(phase2 x y z)")))