153 lines
3.6 KiB
Clojure
153 lines
3.6 KiB
Clojure
(ns auto-ap.cursor
|
|
(:import (clojure.lang IDeref Atom ILookup Counted IFn AFn Indexed ISeq Seqable)))
|
|
|
|
(defprotocol ICursor
|
|
(path [cursor])
|
|
(state [cursor]))
|
|
|
|
|
|
(defprotocol ITransact
|
|
(-transact! [cursor f]))
|
|
|
|
|
|
(declare to-cursor cursor?)
|
|
|
|
|
|
(deftype ValCursor [value state path]
|
|
IDeref
|
|
(deref [_]
|
|
(get-in @state path value))
|
|
ICursor
|
|
(path [_] path)
|
|
(state [_] state)
|
|
ITransact
|
|
(-transact! [_ f]
|
|
(get-in
|
|
(swap! state (if (empty? path) f #(update-in % path f)))
|
|
path)))
|
|
|
|
|
|
(deftype MapCursor [value state path]
|
|
Counted
|
|
(count [_]
|
|
(count (get-in @state path value)))
|
|
ICursor
|
|
(path [_] path)
|
|
(state [_] state)
|
|
IDeref
|
|
(deref [_]
|
|
(get-in @state path value))
|
|
IFn
|
|
(invoke [this key]
|
|
(get this key))
|
|
(invoke [this key defval]
|
|
(get this key defval))
|
|
(applyTo [this args]
|
|
(AFn/applyToHelper this args))
|
|
ILookup
|
|
(valAt [obj key]
|
|
(.valAt obj key nil))
|
|
(valAt [_ key defv]
|
|
(let [value (get-in @state path value)]
|
|
(to-cursor (get value key defv) state (conj path key) defv)))
|
|
ITransact
|
|
(-transact! [cursor f]
|
|
(get-in
|
|
(swap! state (if (empty? path) f #(update-in % path f)))
|
|
path))
|
|
Seqable
|
|
(seq [this]
|
|
(for [[k v] @this]
|
|
[k (to-cursor v state (conj path k) nil)])))
|
|
|
|
|
|
(deftype VecCursor [value state path]
|
|
Counted
|
|
(count [_]
|
|
(count (get-in @state path)))
|
|
ICursor
|
|
(path [_] path)
|
|
(state [_] state)
|
|
IDeref
|
|
(deref [_]
|
|
(get-in @state path))
|
|
IFn
|
|
(invoke [this i]
|
|
(nth this i))
|
|
(applyTo [this args]
|
|
(AFn/applyToHelper this args))
|
|
ILookup
|
|
(valAt [this i]
|
|
(nth this i))
|
|
(valAt [this i not-found]
|
|
(nth this i not-found))
|
|
Indexed
|
|
(nth [_ i]
|
|
(let [value (get-in @state path value)]
|
|
(to-cursor (nth value i) state (conj path i) nil)))
|
|
(nth [_ i not-found]
|
|
(let [value (get-in @state path value)]
|
|
(to-cursor (nth value i not-found) state (conj path i) not-found)))
|
|
ITransact
|
|
(-transact! [cursor f]
|
|
(get-in
|
|
(swap! state (if (empty? path) f #(update-in % path f)))
|
|
path))
|
|
Seqable
|
|
(seq [this]
|
|
(for [[v i] (map vector @this (range))]
|
|
(to-cursor v state (conj path i) nil))))
|
|
|
|
|
|
(defn- to-cursor
|
|
([v state path value]
|
|
(cond
|
|
(cursor? v) v
|
|
(map? v) (MapCursor. value state path)
|
|
(vector? v) (VecCursor. value state path)
|
|
:else (ValCursor. value state path)
|
|
)))
|
|
|
|
|
|
(defn cursor? [c]
|
|
"Returns true if c is a cursor."
|
|
(satisfies? ICursor c))
|
|
|
|
|
|
(defn cursor [v]
|
|
"Creates cursor from supplied value v. If v is an ordinary
|
|
data structure, it is wrapped into atom. If v is an atom,
|
|
it is used directly, so all changes by cursor modification
|
|
functions are reflected in supplied atom reference."
|
|
(to-cursor (if (instance? Atom v) @v v)
|
|
(if (instance? Atom v) v (atom v))
|
|
[] nil))
|
|
|
|
|
|
(defn synthetic-cursor [v prefix]
|
|
(let [internal-cursor (cursor v)]
|
|
(reify ICursor
|
|
(path [this]
|
|
(into prefix (path internal-cursor)))
|
|
(state [this]
|
|
(state internal-cursor)))))
|
|
|
|
|
|
(defn transact! [cursor f]
|
|
"Changes value beneath cursor by passing it to a single-argument
|
|
function f. Old value will be passed as function argument. Function
|
|
result will be the new value."
|
|
(-transact! cursor f))
|
|
|
|
|
|
(defn update! [cursor v]
|
|
"Replaces value supplied by cursor with value v."
|
|
(-transact! cursor (constantly v)))
|
|
|
|
(defn ensure-path! [cursor p default]
|
|
(let [next-to-last (get-in cursor (butlast p))
|
|
next-to-last-v @next-to-last]
|
|
(when (not (get next-to-last-v (last p)))
|
|
(transact! next-to-last #(assoc % (last p) default))))
|
|
cursor)
|