Skip to content

Instantly share code, notes, and snippets.

@c-spencer
Last active December 24, 2015 01:59
Show Gist options
  • Save c-spencer/6727453 to your computer and use it in GitHub Desktop.
Save c-spencer/6727453 to your computer and use it in GitHub Desktop.
Simple experiment in ClojureScript approach to Sysdea documents with undo/redo
; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment