Skip to content

Instantly share code, notes, and snippets.

@zajac

zajac/ot.cljc

Created April 11, 2016 07:44
Show Gist options
  • Save zajac/0d3b7d6f85f70ba5973f36898d6cf753 to your computer and use it in GitHub Desktop.
Save zajac/0d3b7d6f85f70ba5973f36898d6cf753 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
ot.cljc
(ns ot.core
(:require
#?(:clj
[clojure.core.match :refer [match]])
#?(:cljs
[cljs.core.match :refer-macros [match]]))
#?(:clj
(:gen-class
:methods [^:static [compose [clojure.lang.IPersistentVector clojure.lang.IPersistentVector] clojure.lang.IPersistentVector]
^:static [transformIdx [java.lang.Integer clojure.lang.IPersistentVector] java.lang.Integer]])))
#?(:clj (set! *warn-on-reflection* true))
(comment
(def operation [[:retain 12]
[:insert "some string"]
[:retain 5]
[:delete 3]
[:retain 7]]))
(defn noop? [op]
(match op
nil true
[:retain 0] true
[:delete 0] true
[:insert ""] true
_ false))
(defn transform
([op1 op2] (transform [] [] op1 op2))
([resop1 resop2 [op1 & restop1 :as ops1] [op2 & restop2 :as ops2]]
(if
(and (noop? op1) (noop? op2) (or (nil? op1) (nil? op2)))
[resop1 resop2]
(match [op1 op2]
[[:insert text] _] (recur (conj resop1 [:insert text])
(conj resop2 [:retain (count text)])
restop1
ops2)
[_ [:insert text]] (recur (conj resop1 [:retain (count text)])
(conj resop2 [:insert text])
ops1
restop2)
[[:retain l1] [:retain l2]] (cond
(> l1 l2) (recur (conj resop1 [:retain l2])
(conj resop2 [:retain l2])
(cons [:retain (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur (conj resop1 [:retain l2])
(conj resop2 [:retain l2])
restop1
restop2)
(< l1 l2) (recur (conj resop1 [:retain l1])
(conj resop2 [:retain l1])
restop1
(cons [:retain (- l2 l1)] restop2)))
[[:delete l1] [:delete l2]] (cond
(> l1 l2) (recur resop1
resop2
(cons [:delete (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur resop1
resop2
restop1
restop2)
(< l1 l2) (recur resop1
resop2
restop1
(cons [:delete (- l2 l1)] restop2)))
[[:delete l1] [:retain l2]] (cond
(> l1 l2) (recur (conj resop1 [:delete l2])
resop2
(cons [:delete (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur (conj resop1 [:delete l2])
resop2
restop1
restop2)
(< l1 l2) (recur (conj resop1 [:delete l1])
resop2
restop1
(cons [:retain (- l2 l1)] restop2)))
[[:retain l1] [:delete l2]] (cond
(> l1 l2) (recur resop1
(conj resop2 [:delete l2])
(cons [:retain (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur resop1
(conj resop2 [:delete l2])
restop1
restop2)
(< l1 l2) (recur resop1
(conj resop2 [:delete l1])
restop1
(cons [:delete (- l2 l1)] restop2)))))))
(defn compose
([op1 op2] (compose [] op1 op2))
([res [op1 & restop1 :as ops1] [op2 & restop2 :as ops2]]
(if (and (noop? op1) (noop? op2) (or (nil? op1) (nil? op2)))
res
(match [op1 op2]
[[:delete l1] _] (recur (conj res [:delete l1])
restop1
ops2)
[_ [:insert text]] (recur (conj res [:insert text])
ops1
restop2)
[[:retain l1] [:retain l2]] (cond
(> l1 l2) (recur (conj res [:retain l2])
(cons [:retain (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur (conj res [:retain l1])
restop1
restop2)
(< l1 l2) (recur (conj res [:retain l1])
restop1
(cons [:retain (- l2 l1)] restop2)))
[[:insert t1] [:delete l2]] (cond
(> (count t1) l2) (recur res
(cons [:insert (subs t1 l2)] restop1)
restop2)
(= (count t1) l2) (recur res
restop1
restop2)
(< (count t1) l2) (recur res
restop1
(cons [:delete (- l2 (count t1))] restop2)))
[[:insert t1] [:retain l2]] (cond
(> (count t1) l2) (recur (conj res [:insert (subs t1 0 l2)])
(cons [:insert (subs t1 l2)] restop1)
restop2)
(= (count t1) l2) (recur (conj res [:insert t1])
restop1
restop2)
(< (count t1) l2) (recur (conj res [:insert t1])
restop1
(cons [:retain (- l2 (count t1))] restop2)))
[[:retain l1] [:delete l2]] (cond
(> l1 l2) (recur (conj res [:delete l2])
(cons [:retain (- l1 l2)] restop1)
restop2)
(= l1 l2) (recur (conj res [:delete l2])
restop1
restop2)
(< l1 l2) (recur (conj res [:delete l1])
restop1
(cons [:delete (- l2 l1)] restop2)))))))
(defn transform-idx
([idx ops] (transform-idx idx idx ops))
([i idx [op & ops]]
(if (< i 0) idx
(match op
nil idx
[:retain x] (recur (- i x) idx ops)
[:insert x] (recur i (+ idx (count x)) ops)
[:delete x] (recur (- i x) (- idx (min x i)) ops)))))
(defprotocol ClientState
(apply-server [this operation])
(apply-client [this operation])
(ack [this])
(transform-server-idx [this idx]))
(defrecord Client [timestamp state]
ClientState
(apply-server [this operation]
(let [[new-state op] (apply-server state operation)]
[(Client. (inc timestamp) new-state) op]))
(apply-client [this operation]
(let [[new-state op] (apply-client state operation)]
[(Client. timestamp new-state) op]))
(ack [this]
(let [[new-state op] (ack state)]
[(Client. (inc timestamp) new-state) op]))
(transform-server-idx [this idx]
(transform-server-idx state idx)))
(declare awaiting-confirm synch)
(defn make-client [ts]
(Client. ts (synch)))
(defrecord AwaitingWithBuffer [outstanding buffer]
ClientState
(apply-server [this operation]
(let [[p11 p12] (transform outstanding operation)
[p21 p22] (transform buffer p12)]
[(AwaitingWithBuffer. p11 p21) p22]))
(apply-client [this operation]
[(AwaitingWithBuffer. outstanding (compose buffer operation)) nil])
(ack [this]
[(awaiting-confirm buffer) buffer])
(transform-server-idx [this idx]
(transform-idx idx buffer)))
(defrecord AwaitingConfirm [outstanding]
ClientState
(apply-server [this operation]
(let [[a b] (transform outstanding operation)]
[(AwaitingConfirm. a) b]))
(apply-client [this operation]
[(AwaitingWithBuffer. outstanding operation) nil])
(ack [this]
[(synch) nil])
(transform-server-idx [this idx]
(transform-idx idx outstanding)))
(defn awaiting-confirm [buffer]
(AwaitingConfirm. buffer))
(defrecord Synchronized []
ClientState
(apply-server [this operation]
[this operation])
(apply-client [this operation]
[(AwaitingConfirm. operation) operation])
(ack [this]
[(Synchronized.) nil])
(transform-server-idx [this idx]
idx))
(defn synch []
(Synchronized.))
(defprotocol ServerState
(apply-operation [this ts operation])
(transform-index [this ts idx]))
(comment
[{:timestamp 1
:operation [...]}])
(defn getbase [ts operations]
(map :operation
(filter #(>= (:timestamp %) ts) operations)))
(defrecord ServerStateImpl [timestamp operations]
ServerState
(apply-operation [this ts operation]
(let [base (getbase ts operations)
operation (reduce (comp first transform) operation base)]
[(ServerStateImpl. (inc timestamp) (conj operations {:timestamp timestamp
:operation operation})) operation]))
(transform-index [this ts idx]
(let [base (getbase ts operations)]
(reduce transform-idx idx base))))
(defn make-server []
(ServerStateImpl. 0 []))
(def -compose compose)
(def -transformIdx transform-idx)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment