Simple experiment in ClojureScript approach to Sysdea documents with undo/redo

sysdea.clj

; adapted from clojure.core.incubator
(defn dissoc-in
  "Dissociates a number of entries from the object at the given path,
  removing empty maps on the path.
  e.g. (dissoc-in {:a {:b {:e 6} :c 6}} [:a :b] [:e]) -> {:a {:c 6}}"
  [m [k & ks :as keys] rems]
  (if k
    (if-let [nextmap (get m k)]
      (let [newmap (dissoc-in nextmap ks rems)]
        (if (seq newmap)
          (assoc m k newmap)
          (dissoc m k)))
      m)
    (apply (partial dissoc m) rems)))

; Changes and Changesets, for modification of maps with deltas
(defrecord Changes [assocs updates dissocs])
(defrecord Changeset [forward backward])

(defn infer-dissocs [doc assocs]
  (reduce #(update-in %1 [(pop %2)] (fnil conj #{}) (peek %2))
          {}
          (keys assocs)))

(defn infer-assocs [doc dissocs]
  (reduce-kv
   (fn [assocs k-path ks]
     (reduce
      (fn [m k]
        (let [p (conj k-path k)]
          (assoc m p (get-in doc p))))
      assocs
      ks))
   {}
   dissocs))

(defn infer-updates [doc updates]
  (reduce-kv
   (fn [new-updates k-path update-map]
     (assoc new-updates k-path
       (select-keys (get-in doc k-path) (keys update-map))))
   {}
   updates))

(defn infer-changeset [doc changes]
  (Changeset.
   changes
   (Changes.
    (infer-assocs doc (:dissocs changes))
    (infer-updates doc (:updates changes))
    (infer-dissocs doc (:assocs changes)))))

(defn changes [& {:keys [assocs dissocs updates]}]
  (Changes. (or assocs {}) (or updates {}) (or dissocs {})))

(def merge-changes (partial merge-with (partial apply conj)))
(def merge-changesets (partial merge-with merge-changes))

; Commands

; run a command in one direction or another, utility function
; not sure on best place to put
(defn exec-command [target direction changeset]
  (let [spec (get changeset direction)]
    (let [assoced (reduce-kv assoc-in target (:assocs spec))
          dissoced (reduce-kv dissoc-in assoced (:dissocs spec))]
      (reduce-kv #(update-in %1 %2 merge %3) dissoced (:updates spec)))))

(defprotocol Commandable
  (run [me f attrs])
  (undo [me])
  (redo [me]))

(defrecord Commanded [target chain position]
  Commandable
  (run
   [_ command-function attrs]
   (let [command (->> (command-function target attrs)
                      (infer-changeset target))]
     (Commanded.
      (exec-command target :forward command)
      (conj (subvec chain 0 position) command)
      (inc position))))
  (undo
   [me]
   (if (> position 0)
    (let [new-position (dec position)
          command (nth chain new-position)]
      (Commanded.
        (exec-command target :backward command)
        chain
        new-position))
    me))
  (redo
   [me]
   (if (< position (count chain))
     (let [command (nth chain position)]
       (Commanded.
         (exec-command target :forward command)
         chain
         (inc position)))
     me)))

(defn commanded [target]
  (Commanded. target [] 0))

;; Using it

; some simple records
(defrecord Document [id model-name elements links counter])
(defrecord Resource [id x y el-name formula note])

(defn create-doc [id n]
  (Document. id n {} {} (atom 0)))

; some commands

(defn add-resource [doc {:keys [x y el-name formula note]}]
  (let [new-id (str "SID!" (swap! (:counter doc) inc))]
    (changes
     :assocs
     {[:elements new-id] (Resource. new-id x y el-name formula note)})))


(defn move-element [doc {:keys [id x y]}]
  (changes :updates
           {[:elements id] {:x x :y y}}))

(def doc (-> (commanded (create-doc "myid" "my doc"))
             (run add-resource {:x 50 :y 50
                               :el-name "my resource"
                               :formula "50"
                               :note ""})
             :target))

(merge-changes (move-element doc {:id "SID!1" :x 100 :y 100})
               (move-element doc {:id "SID!1" :x 120 :y 160}))

(-> (commanded (create-doc "hsgd2723j1h" "my model"))
    (run add-resource {:x 50 :y 50
                               :el-name "my resource"
                               :formula "50"
                               :note ""})
    (run add-resource {:x 150 :y 250
                               :el-name "my resource 2"
                               :formula "150"
                               :note "whee"})
   (undo)
   (redo)
   (run move-element {:id "SID!1" :x 100 :y 100})
   (undo)
   :target)