re-frame success! interceptor

success.cljs

(ns interceptors.success
  (:require [re-frame.core :as rf]
            [clojure.string :as string]))


(defn success-or-failure
  "Tests whether an event keyword is a success or failure callback,
   and returns one of :success, :failure, or nil."
  [event]
  (cond
    (string/ends-with? (str event) "success") :success
    (string/ends-with? (str event) "failure") :failure
    :else nil))


(defn success-or-failure-prefix
  "If an event is a success or failure, returns the prefix.
   Otherwise returns nil."
  [event]
  (let [event-nm (string/replace (str event) ":" "")]
    (case (success-or-failure event)
      :success  (keyword (string/replace event-nm #"[-/]success$" ""))
      :failure  (keyword (string/replace event-nm #"[-/]failure$" ""))
      nil)))


(defn run-actions
  "Dispatch a re-frame vector or execute a fn.

   Can dispatch a single event vector, or if given
   a vector of event vectors, will dispatch each."
  [event-vec-or-fn]
  (cond
    (fn? event-vec-or-fn)         (event-vec-or-fn)
    (sequential? event-vec-or-fn) (if (every? sequential? event-vec-or-fn)
                                    (doseq [event-vec event-vec-or-fn]
                                      (rf/dispatch event-vec))
                                    (rf/dispatch event-vec-or-fn))
    :else                         (js/console.warn "run-actions needs a re-frame vector or a fn; got"
                                    event-vec-or-fn)))


(defn extract-param-pairs
  "Given a set of keywords and an event vector,
   extract keyword-argument pairs from the event.

   Returns a 2-element vector: [new-event-v kw-arg-map]."
  [param-kw-set event-v]
  (loop [index 0
         actions {}
         new-event []]
    (if (< index (count event-v))
      (let [param     (get event-v index)
            arg-index (inc index)]
        (if (and (contains? param-kw-set param) (< arg-index (count event-v)))
          (recur (+ index 2)
                 (conj actions [param (get event-v arg-index)])
                 new-event)

          (recur arg-index
                 actions
                 (conj new-event param))))
      [new-event actions])))


(def ^:private *callback-actions (atom {}))


(defn async-callback
  "Create an interceptor that allows conditional execution of
   callback events related to an original event.

   The interceptor uses the success/failure prefix of the event keyword to
   correlate callbacks to original dispatches. (Non-success/fail keywords
   are unchanged)

   nm:
     A name for the interceptor, will be keywordized.

   extract-actions:
     A fn that takes an event-v and must return a 2-element vector:
     [new-event-v actions], or nil(s). It may not change the event keyword,
     but may change the subsequent vector items, allowing the event to indicate
     whether or not to invoke the interceptor and the fn may strip the actions
     from the original event. (see `extract-param-pairs`)

     The returned \"actions\" element should be a fn, an event-v, or a vector of
     event-v's to dispatch.

   match-callback:
     A fn that takes the event keyword (NOT the vector, just the first element),
     and must return a 2-element vector [matches? run?], or nil(s). This is
     used to partially recognise callback events. If matches? is logical true,
     registered actions will be run (if run?), and the registered actions will
     be unregistered."
  [nm extract-actions match-callback]
  (assert (fn? match-callback) "match-callback must be a fn")
  (assert (fn? extract-actions) "extract-actions must be a fn")
  (let [action-kw (keyword nm)]
    (rf/->interceptor
      :id     action-kw

      :before (fn [context]
                (let [[event & _ :as event-v] (rf/get-coeffect context :event)
                      [new-event-v actions]   (extract-actions event-v)
                      kw                      (or (success-or-failure-prefix event) event)]
                  (if-not (or (nil? actions) (nil? new-event-v))
                    (do
                      (assert (or (vector? actions) (fn? actions))
                        (str "actions must be an event-v or vector of event-v's, or a fn; got a " (type actions)))

                      (assert (vector? new-event-v)
                        (str "the returned new-event-v must be a re-frame event vector; got " new-event-v))

                      (assert (= event (first new-event-v))
                        (str "action fn may not change the event keyword from " event " to " (first new-event-v)))

                      ;(js/console.debug "saving actions for" kw action-kw)
                      (swap! *callback-actions assoc-in [kw action-kw] actions)

                      (rf/assoc-coeffect context :event new-event-v))
                    context)))

      :after  (fn [context]
                (let [[event & _]     (rf/get-coeffect context :event)
                      [matches? run?] (match-callback event)
                      kw              (success-or-failure-prefix event)
                      actions         (get-in @*callback-actions [kw action-kw])]
                  (when (and matches? (not (nil? kw)))
                    (when (and run? (not (nil? actions)))
                      ;(js/console.debug "running actions for" kw action-kw)
                      (run-actions actions))
                    (swap! *callback-actions dissoc kw)))
                context))))


(def ^:doc
  "Allow an event-vec to specify other dispatches/fns to execute when
   a successful asynchronous callback arrives which was triggered by
   the current event handler.
   
   Matches & extracts a single key-value pair in the current event vector
   of the form `:success! arg', where arg is either a single re-frame
   event vector, a vector of re-frame event vectors, or a fn to execute."
  success-actions
  (async-callback :success-actions
    (fn [event-v]
      (let [[new-event-v params] (extract-param-pairs #{:success!} event-v)]
        [new-event-v (:success! params)]))

    (fn [event]
      (case (success-or-failure event)
        :success [true true]
        nil))))