Оглавление

До сих пор мы игнорировали другую возможность зипперов. Во время обхода можно не только читать, но и менять локации. В широком плане нам доступны все операции CRUD (Create, Read, Update, Delete), знакомые вам из веб-разработки. Ниже мы разберем, как они работают в зипперах.

Напомним, зиппер принимает третью функцию make-node, в которую мы до сих пор передавали nil. В ней не было нужды, потому что мы только читали данные. Зиппер вызовет функцию в момент, когда мы просим вернуть данные с учетом изменений, которые внесли в локации. Функция принимает два параметра: ветку и потомков. Ее задача — соединить их так, как это принято в дереве.

Для простых коллекций вроде вектора функция проста — нужно только обернуть потомков в vec, чтобы получить из последовательности вектор. В vector-zip функция чуть сложнее, потому что учитывает метаданные. Новый вектор получит их из прошлой версии:

(defn vector-zip
  [root]
  (zipper vector?
          seq
          (fn [node children]
            (with-meta (vec children) (meta node)))
          root))

Желательно, чтобы результат make-node сохранял метаданные оригинала. Если вы дополняете его через assoc или conj, метаданные сохраняются. В случае с vector-zip мы строим новый вектор, поэтому оборачиваем его в with-meta. Если убрать with-meta, на выходе получим вектор без метаданных, что может повлиять на логику программы.

Для XML-зиппера сборка ветки чуть сложнее:

(fn [node children]
  (assoc node :content (and children (apply vector children))))

В ключ :content попадает либо nil, либо вектор потомков. Предположим, узел был пуст:

{:tag :organization
 :attrs {:name "DNS"}
 :content nil}

и в процессе мы добавили ему два потомка:

{:tag :product
 :attrs {:type "iphone"}
 :content ["iPhone 11 Pro"]}

{:tag :product
 :attrs {:type "fiber"}
 :content ["Premium iFiber"]}

Тогда новый узел станет следующим:

{:tag :organization
 :attrs {:name "DNS"}
 :content [{:tag :product
            :attrs {:type "iphone"}
            :content ["iPhone 11 Pro"]}
           {:tag :product
            :attrs {:type "fiber"}
            :content ["Premium iFiber"]}]}

Для изменения зиппера служат функции zip/edit, zip/replace и другие. Но перед тем, как рассматривать их, объясним, как именно протекают изменения в зиппере.

Особенность в том, что изменения сказываются не на исходных данных, а на локациях. Если изменить текущую локацию, исходные данные зиппера не изменятся. Когда вы изменили локацию, она помечается флагом :changed?. Это сигнал к пересборке данных с помощью функции zip/root, о которой расскажем чуть ниже.

Рассмотрим пример с вектором [1 2 3]. Переместимся на двойку и удвоим ее. Локация до изменений:

(-> [1 2 3]
    zip/vector-zip
    zip/down
    zip/right)

[2 {:l [1] :pnodes [[1 2 3]] :ppath nil :r (3)}]

и после:

(def loc-2
  (-> [1 2 3]
      zip/vector-zip
      zip/down
      zip/right
      (zip/edit * 2)))

[4 {:l [1] :pnodes [[1 2 3]] :ppath nil :r (3)
    :changed? true}]

Далее нам бы хотелось получить измененный вектор [1 4 3]. Сделаем это вручную:

(-> loc-2
    zip/up
    zip/node)
;; [1 4 3]

То же самое делает функция zip/root, которая принимает локацию с изменениями. Ее алгоритм следующий:

  • подняться до корневой локации;
  • вернуть ее узел.

Чтобы получить результат из прошлого вектора, добавим zip/root на конец стрелочного оператора:

(-> [1 2 3]
    zip/vector-zip
    zip/down
    zip/right
    (zip/edit * 2)
    zip/root)
;; [1 4 3]

Секрет кроется в функции zip/up, которую мы вызвали вручную или неявно под капотом zip/root. При подъеме вверх она проверяет, была ли изменена локация, и если да, перестраивает ее с помощью make-node. Приведем фрагмент ее кода:

(defn up
  [loc]
  (let [[node {... changed? :changed? :as path}] loc]
    (when pnodes
      (let [pnode (peek pnodes)]
        (with-meta (if changed?
                     [(make-node loc pnode (concat l ...))
                      (and ppath (assoc ...))]
                     [pnode ppath])
                   (meta loc))))))

При обходе зиппера мы раскладывали его в цепочку локаций с помощью iter-zip, а затем пропускали через серию map, filter и других функций. Для редактирования этот прием не подходит. Предположим, мы выбрали второй элемент из результата zip-iter и исправили его:

(def loc-seq
  (-> [1 2 3]
      zip/vector-zip
      iter-zip))

(-> loc-seq (nth 2) (zip/edit * 2))
;; [4 {:l [1] :pnodes [[1 2 3]] :ppath nil :r (3)
;;    :changed? true}]

Однако зипперы неизменяемы, и любое действие вернет новую локацию. В то же время функция zip-iter устроена так, что каждая следующая локация получается из предыдущей. Вызов zip/edit и аналогов на одном из элементов не повлияет на последующие. Если подняться вверх от последней локации, получим вектор без изменений.

(-> loc-seq last zip/up zip/node)
;; [1 2 3]

При редактировании зипперов применяют следующие паттерны.

Изменяется один элемент. В этом случае мы итерируем зиппер до тех пор, пока не встретим нужную локацию в цепочке. Затем меняем ее и вызываем zip/root.

Изменяются многие элементы. С помощью loop и zip/next мы вручную итерируем зиппер. При этом задана функция, которая либо меняет локацию, любо оставляет нетронутой. В форму recur попадает zip/next от ее результата. Это означает, что если изменения были, zip/next оттолкнется от новой, а не исходной локации.

Для изменения локаций служат функции:

  • replace — буквальная замена текущего узла на другой;
  • edit — более гибкая замена узла. По аналогии с update и swap!, принимает функцию и добавочные аргументы. Первым аргументом функция получит текущей узел локации. Результат заменит содержимое локации;
  • remove — удаляет локацию и перемещает указатель на родителя.

Функции для вставки соседей или потомков:

  • insert-left — добавить соседа слева от текущей локации;
  • insert-right — добавить соседа справа;
  • insert-child — добавить текущей локации потомка в начало;
  • append-child — добавить потомка в их конец.

Разница между соседом и потомком в иерархии. Сосед появляется на одном уровне с локацией, а потомок ниже.

Рассмотрим функции на простых примерах. Предположим, в глубине вложенных векторов находится ключ :error. Нужно исправить его :ok. Для этого ищем локацию, исправляем ее и поднимаемся к корню:

(def data [1 2 [3 4 [5 :error]]])

(defn loc-error? [loc]
  (some-> loc zip/node (= :error)))

(def loc-error
  (->> data
       zip/vector-zip
       iter-zip
       (some (fn [loc]
               (when (loc-error? loc)
                 loc)))))

(-> loc-error
    (zip/replace :ok)
    zip/root)

;; [1 2 [3 4 [5 :ok]]]

Другой пример — поменять во вложеном векторе все nil на 0, чтобы обезопасить математические расчеты. Для этого понадобится обход через loop. На каждом шаге мы проверяем, подходит ли локация, и если да, передаем в recur вызов zip/next от измененной версии:

(def data [1 2 [5 nil 2 [3 nil]] nil 1])

(loop [loc (zip/vector-zip data)]
  (if (zip/end? loc)
    (zip/node loc)
    (if (-> loc zip/node nil?)
      (recur (zip/next (zip/replace loc 0)))
      (recur (zip/next loc)))))

[1 2 [5 0 2 [3 0]] 0 1]

То же самое, но заменить все отрицательные числа по модулю. Для начала объявим функцию abs:

(defn abs [num]
  (if (neg? num)
    (- num)
    num))

Обход похож на предыдущий, но теперь вместо zip/replace мы вызываем zip/edit, который обновляет содержимое локации, отталкиваясь от ее прежнего значения:

(def data [-1 2 [5 -2 2 [-3 2]] -1 5])

(loop [loc (zip/vector-zip data)]
  (if (zip/end? loc)
    (zip/node loc)
    (if (and (-> loc zip/node number?)
             (-> loc zip/node neg?))
      (recur (zip/next (zip/edit loc abs)))
      (recur (zip/next loc)))))

В обоих случаях логика цикла проста. Если это конечная локация, вернем ее узел. Напомним, конечной считается исходная локация, когда к ней вернулись после серии вызовов zip/next. В противном случае, если в локации отрицательное число, мы меняем ее содержимое с помощью zip/edit. От измененной локации мы переходим к следующей. Это ключевой момент: в предпоследней строке вызов zip/next принимает результат zip/edit, а не исходную локацию. Значит, изменения в ней будут переданы на следующий шаг.

Примеры выше позволяют увидеть паттерны — повторяющиеся приемы. Вынесем их в отдельные функции, чтобы не тратить на них внимание в будущем.

Поиск локации по предикату. Принимает начальную локацию и предикат. Вернет первую же локацию, которая подошла предикату:

(defn find-loc [loc loc-pred]
  (->> loc
       iter-zip
       (some (fn [loc]
               (when (loc-pred loc)
                 loc)))))

Прогон локаций с изменениями. Перебирает локации с помощью zip/next, но перед этим оборачивает локацию в функцию. Ожидается, что функция либо изменит локацию, либо вернет ее без изменений. Это обобщенная версия loop, что мы написали выше.

(defn alter-loc [loc loc-fn]
  (loop [loc loc]
    (if (zip/end? loc)
      loc
      (recur (-> loc loc-fn zip/next)))))

Перепишем примеры с новыми функциями. Найдем в векторе локацию, чей узел равен двойке:

(def loc-2
  (-> [1 2 3]
      zip/vector-zip
      (find-loc (fn [loc]
                  (-> loc zip/node (= 2))))))

Удвоим ее и выйдем на конечный вектор:

(-> loc-2 (zip/edit * 2) zip/root)
;; [1 4 2]

Изменим отрицательные числа по модулю. Для этого заведем функцию loc-abs. Если в ее узле отрицательное число, вернем исправленную локацию, а иначе — исходную:

(defn loc-abs [loc]
  (if (and (-> loc zip/node number?)
           (-> loc zip/node neg?))
    (zip/edit loc abs)
    loc))

Достаточно передать ее в alter-loc:

(-> [-1 2 [5 -2 2 [-3 2]] -1 5]
    zip/vector-zip
    (alter-loc loc-abs)
    zip/node)

;; [1 2 [5 2 2 [3 2]] 1 5]

Перейдем к промышленным примерам с XML и товарами. Подготовим следующий файл products-price.xml:

<?xml version="1.0" encoding="UTF-8"?>
<catalog>
  <organization name="re-Store">
    <product type="fiber" price="8.99">VIP Fiber Plus</product>
    <product type="iphone" price="899.99">iPhone 11 Pro</product>
  </organization>
  <organization name="DNS">
    <branch name="Office 2">
      <bundle>
        <product type="fiber" price="9.99">Premium iFiber</product>
        <product type="iphone" price="999.99">iPhone 11 Pro</product>
      </bundle>
    </branch>
  </organization>
</catalog>

Обратите внимание, что теперь у товаров появились цены.

Поскольку мы будем изменять зиппер, нам понадобится обратное действие — из структуры данных получить XML в виде текста. Для этого импортируем встроенный модуль clojure.xml. Его функция emit выводит XML на печать. Чтобы получить результат, emit оборачивают в with-out-str — макрос для перехвата печати в строку. В примерах ниже мы просто будем печатать XML.

Еще одно уточнение — emit не поддерживает отступы тегов. Мы добавим их вручную для ясности.

Первая задача — сделать скидку 10% на все айфоны. У нас уже готовы абстракции, так что опишем решение сверху вниз:

(require '[clojure.xml :as xml])

(-> "products-price.xml"
    ->xml-zipper
    (alter-loc alter-iphone-price)
    zip/node
    xml/emit)

Этих пяти строк достаточно для нашей задачи. Под вопросом только функция alter-iphone-price. Мы ожидаем, что для локации-айфона функция вернет ее же, но с другим атрибутом price. Локация другого типа останется без изменений. Опишем функцию:

(defn alter-iphone-price [loc]
  (if (loc-iphone? loc)
    (zip/edit loc alter-attr-price 0.9)
    loc))

Предикат loc-iphone? Проверяет локацию на “айфонность”. Мы уже писали его в прошлых занятиях:

(defn loc-iphone? [loc]
  (let [node (zip/node loc)]
    (and (-> node :tag (= :product))
         (-> node :attrs :type (= "iphone")))))

Осталась функция alter-attr-price. Она принимает узел (содержимое локации) и должна изменить его атрибут. Второй аргумент функции — коэффициент, на который нужно умножить текущую цену. Небольшая трудность в том, что атрибуты в XML — строки. Чтобы выполнить умножение, нужно вывести число из строки, умножить на коэффициент, а результат перевести обратно в строку с округлением до двух цифр. Все вместе дает нам функцию:

(defn alter-attr-price [node ratio]
  (update-in node [:attrs :price]
             (fn [price]
               (->> price
                    read-string
                    (* ratio)
                    (format "%.2f")))))

После запуска всей цепочки мы получим XML:

<?xml version="1.0" encoding="UTF-8"?>
<catalog>
  <organization name="re-Store">
    <product price="8.99" type="fiber">VIP Fiber Plus</product>
    <product price="809.99" type="iphone">iPhone 11 Pro</product>
  </organization>
  <organization name="DNS">
    <branch name="Office 2">
      <bundle>
        <product price="9.99" type="fiber">Premium iFiber</product>
        <product price="899.99" type="iphone">iPhone 11 Pro</product>
      </bundle>
    </branch>
  </organization>
</catalog>

Видим, что цена на айфоны изменилась на 10%, а у остальных товаров осталась прежней.

Более сложная задача – во все наборы (бандлы) добавить новый товар — гарнитуру. Опять же, опишем решение сверху вниз:

(-> "products-price.xml"
    ->xml-zipper
    (alter-loc add-to-bundle)
    zip/node
    xml/emit)

Решение отличается только функций add-to-bundle. Ее логика следующая: если текущая локация — бандл, добавить ему потомка, а если нет, просто вернуть локацию.

(defn add-to-bundle [loc]
  (if (loc-bundle? loc)
    (zip/append-child loc node-headset)
    loc))

Проверка на бандл:

(defn loc-bundle? [loc]
  (some-> loc zip/node :tag (= :bundle)))

Функция zip/append-child добавляет значение в конец потомков локации. В данном случае это XML-узел node-headset:

(def node-headset
  {:tag :product
   :attrs {:type "headset"
           :price "199.99"}
   :content ["AirPods Pro"]})

Итоговый XML, где в наборах появился новый товар:

<?xml version="1.0" encoding="UTF-8"?>
<catalog>
  <organization name="re-Store">
    <product price="8.99" type="fiber">VIP Fiber Plus</product>
    <product price="899.99" type="iphone">iPhone 11 Pro</product>
  </organization>
  <organization name="DNS">
    <branch name="Office 2">
      <bundle>
        <product price="9.99" type="fiber">Premium iFiber</product>
        <product price="999.99" type="iphone">iPhone 11 Pro</product>
        <product price="199.99" type="headset">AirPods Pro</product>
      </bundle>
    </branch>
  </organization>
</catalog>

Третья задача — упразднить все наборы. По каким-то причинам мы решили, что продавать товары в наборах невыгодно. Из XML должны уйти все теги <bundle>, однако их товары должны перейти в организацию.

И в третий раз решение отличается лишь целевой функцией:

(-> "products-price.xml"
    ->xml-zipper
    (alter-loc disband-bundle)
    zip/node
    xml/emit)

Опишем алгоритм disband-bundle. Если текущий узел — набор, мы сохраняем его потомков (товары) в переменную, чтобы не потерять их. Затем удаляем набор. Функция удаления строена так, что вернет предыдущую локацию. В нашем XML это будет организация. Присоединим ей товары и вернем ее.

(defn disband-bundle [loc]
  (if (loc-bundle? loc)
    (let [products (zip/children loc)
          loc-prev (zip/remove loc)]
      (append-childs loc-prev products))
    loc))

Функция append-childs – это наша обертка над встроенной zip/append-child. Последняя присоединяет только один элемент, что неудобно. Чтобы присоединить список, напишем свертку:

(defn append-childs [loc items]
  (reduce (fn [loc item]
            (zip/append-child loc item))
          loc
          items))

Финальный XML:

<?xml version="1.0" encoding="UTF-8"?>
<catalog>
  <organization name="re-Store">
    <product price="8.99" type="fiber">VIP Fiber Plus</product>
    <product price="899.99" type="iphone">iPhone 11 Pro</product>
  </organization>
  <organization name="DNS">
    <branch name="Office 2">
      <product price="9.99" type="fiber">Premium iFiber</product>
      <product price="999.99" type="iphone">iPhone 11 Pro</product>
    </branch>
  </organization>
</catalog>

Надеемся, этих примеров достаточно, чтобы читатель понял, как редактировать зипперы. Обратите внимание, что кода получается немного: для каждой задачи мы писали в среднем три функции. Другое преимущество в том, что нет состояния. Все функции чистые, и их вызов не сказывается на данных. Если где-то на середине вы “упадете” с исключением, дерево XML не будет наполовину испорченным.

(Продолжение следует)

Оглавление