reducers.clj

;; -- clj macros

(defmacro defmodel
  ([name init [[state & args] & clauses]]
   `(defmodel ~name
      ~(str "Reducing following messages into " name ": "
            (clojure.string/join ", " (map first clauses)))
      ~init ([~state ~@args] ~@clauses)))
  ([name doc-string init [[state & args] & clauses]]
   `(do
      ~@(for [[s] clauses] ;; Message constructors
          `(defn ~s
             ~(str "Construct :" s " message for " name " reducer")
             [& args#]
             (into [~(keyword s)] args#)))
      (defn ~name ;; Reducing function
        ~doc-string
        ~init
        ([~state [typ# ~@args]]
         ;; consider cond, condp, match, etc.
         (case typ#
           ~@(interleave
              (for [[s & body] clauses]
                (keyword s))
              (for [[s & body] clauses]
                `(do ~@body)))
           ~state))))))

;; -- cljs lib

(defn reduce-in
  [reducer-map]
  (fn
    ([]
     (->>
      reducer-map
      (reduce
       (fn [acc [key reducing-fn]]
         (assoc acc key (reducing-fn))) {})))
    ([state input]
     (->>
      reducer-map
      (reduce
       (fn [acc [key reducing-fn]]
         (update acc key reducing-fn input))
       state)))))

;; -- cljs app

(defmodel sent
   ([] [])
   ([xs x]
    (email-sent (conj xs x))))

(defmodel inbox
  ([] #{})
  ([xs x]
   (add-to-inbox      (conj xs x))
   (remove-from-inbox (disj xs x))))

(defmodel contacts
  ([] {})
  ([xs {id :id :as x}]
   (add-contact    (assoc  xs id x))
   (remove-contact (dissoc xs id))))

(defmodel width
   ([] 0)
   ([w f & args]
    (update-width (apply f w args))))

(def app
  (reduce-in
   {:width    width
    :contacts contacts
    :emails
    (reduce-in
     {:inbox  inbox
      :sent   sent})}))

;; -- sample input

(transduce
 (map identity)
 (completing app)
 (app)

 [(add-contact     {:id 42 :name "Arthur"})
  (add-contact     {:id 43 :name "Zaphod"})
  (remove-contact  {:id 43})
  (email-sent      "Hello")
  (email-sent      "World")
  (update-width    + 10)
  (update-width    + 2)])