ninjudd

(defn mark-deleted [over-layer keyseq node]
  (letfn [(exists?  [id exists?]  (and exists? (not (node-deleted? over-layer id))))
          (deleted? [id deleted?] (or deleted? (node-deleted? over-layer id)))]
    (let [node (if-let [ks (deleted-node-keyseq keyseq)]
                 (update-in* node ks (partial deleted? (first keyseq)))
                 node)]
      (if-let [ks (edges-keyseq keyseq)]
        (update-in* node ks fixing map? map-vals-with-keys
                    (if (= :meta (first keyseq))
                      exists?

ninjudd

(defn- merge-edges [over-layer incoming? edges-seq]
  (->> (for [[i edges] (indexed (reverse edges-seq))
             [id edge] edges]
         (let [pos  (merge-position over-layer id)
               head (or (merge-head over-layer id) id)]
           [(if incoming? [pos i], [i pos])
            {head edge} id]))
       (sort-by first #(compare %2 %1))
       (map second)
       (apply merge-with adjoin)))

ninjudd

(macro-do [name]
  (let [{:keys [varname meta]} (graph-impl name)]
    `(defn ~name ~(:doc meta)
       (~'[id]
        (~name :over-layer ~'id))
       (~'[layer-name id]
        (~varname (layer ~'layer-name) ~'id))))
  delete-node! undelete-node!
  meta-node merge-head merged-into merge-ids merge-position node-deleted?)

ninjudd

(macro-do [name]
  (let [{:keys [varname meta]} (graph-impl name)]
    `(defn ~name ~(:doc meta)
       (~'[head-id tail-id]
        (~name :over-layer ~@'[head-id tail-id]))
       (~'[layer-name head-id tail-id]
        (~varname (layer ~'layer-name) ~@'[head-id tail-id]))))
  merge-node! unmerge-node!)

ninjudd

(defn- mark-edges-deleted [keyseq node]
  (cond-let [ks (edges-keyseq keyseq)]
            (update-in node ks map-vals-with-keys edge-deleted)
            [ks (deleted-edge-keyseq keyseq)]
            (update-in node ks edge-deleted?)
            :else node))

(defn- mark-incoming-deleted [keyseq node]
  (cond-let [ks (edges-keyseq keyseq)]
            (update-in node ks map-vals-with-keys incoming-exists?)

ninjudd

(letfn [(incoming-exists? [id exists?]  (and exists? (not (node-deleted? id))))
        (edge-deleted?    [id deleted?] (or deleted? (node-deleted? id)))
        (edge-deleted     [id edge]     (update edge :deleted (partial edge-deleted? id)))]
  (defn- mark-edges-deleted [keyseq node incoming]
    (cond-let [ks (edges-keyseq keyseq)]
              (update-in node ks map-vals-with-keys
                         (if incoming?
                           incoming-exists?
                           edge-deleted))
              [ks (deleted-edge-keyseq keyseq)]

ninjudd

(defn dissoc-in
  "Associates a value in a nested associative structure, where ks is a sequence of keys and returns
  a new nested structure. If any maps that result are empty, they will be removed from the new
  structure."
  [m [k & ks :as keys]]
  (if ks
    (if-let [old (get m k)]
      (let [new (dissoc-in old ks)]
        (if (seq new)
          (assoc m k new)

ninjudd

(defn merge-node
  "Functional version of merge-node!"
  [layer head-id tail-id]
  (verify (not= head-id tail-id)
          (format "cannot merge %s into itself" tail-id))
  (verify (= (type-key head-id) (type-key tail-id))
          (format "cannot merge %s into %s because they are not the same type" tail-id head-id))
  (let [head-merged (fix (merge-head head-id) #{head-id} nil)
        tail-merged (fix (merge-head tail-id) #{tail-id} nil)
        start-pos   (count (merge-ids head-id))]

ninjudd

(defn- find-codec [path codecs]
  (when (seq path)
    (let [expected-path `[~@keys :*]]
      (find-first (fn [[path codec]]
                    (= expected-path path))
                  codecs))))

(defn- seq-fn [layer path codecs not-found f]
  (when-let [[path codec] (find-codec path codecs)]
    (let [[id & keys] (seq path)

ninjudd

(deftest edge-merging-with-deleted
  (at-revision 1 (assoc-node! :people "A" {:edges {"C" {:deleted true}}}))
  (at-revision 2 (assoc-node! :people "B" {:edges {"D" {:deleted false}}}))
  (at-revision 3 (merge-node! "A" "B"))
  (at-revision 4 (merge-node! "D" "C"))

  (is (= {:edges {"D" {:deleted false}}} (get-node :people "A")))
  (is (= {:edges {"D" {:deleted false}}} (get-node :people "B")))
  (is (= {"A" true} (get-incoming-map :people "D")))
  (is (= {"A" true} (get-incoming-map :people "C"))))