Processing a zipper structure

Today I was working on processing some XML that I parsed into a zipper structure. After processing, I needed to turn it back into XML. I know functions exist to do this but I wanted to see what I could come up with. So here's what I wrote:

(defn render-element [open-or-close node]
  (let [slash (if (= open-or-close :open)
                ""
                "/")]
    (if (map? node)
      (str "<" slash (name (:tag node)) ">")
      node)))

(defn traverse [root arrive-fn leave-fn]
  (loop [loc root
         nodes []
         direction :arrive]
    (let [node-fn (if (= direction :arrive) arrive-fn leave-fn)
          new-nodes (conj nodes (node-fn (zip/node loc)))]
      (if (and (= loc root) (= direction :leave))
        new-nodes
        (let [child-loc (zip/down loc)
              right-loc (zip/right loc)]
          (if (or (nil? child-loc) (= direction :leave))
            (if (nil? right-loc)
              (recur (zip/up loc) new-nodes :leave)
              (recur right-loc new-nodes :arrive))
            (recur child-loc new-nodes :arrive)))))))

gist

Let's take a look at this a little bit at a time.

(defn render-element [open-or-close node]
  (let [slash (if (= open-or-close :open)
                ""
                "/")]
    (if (map? node)
      (str "<" slash (name (:tag node)) ">")
      node)))

The render-element is pretty self explanatory. It takes a node and an :open or :close flag. Based on those flags it will return a rendered xml element. The function is not complete but it's enough to get the idea.

(defn traverse [root arrive-fn leave-fn]

The traverse function takes a zipper location and 2 one arg functions. The first renders a node when we first arrive at it and the second renders it when we're leaving.

(loop [loc root
         nodes []
         direction :arrive]

Here I initialize the loop bindings. I set the current location to the current zipper and initialize the nodes list to an empty vector. The nodes list is where we will accumulate everything we process. Finally, I set the direction to :arrive since we're just starting to process the zipper.

(let [node-fn (if (= direction :arrive) arrive-fn leave-fn)
          new-nodes (conj nodes (node-fn (zip/node loc)))]

I tend to use a lot of local bindings just to make things a little cleaner. Here, I create a shortcut to the appropriate render function and I go ahead and add the current node to the node list because I know I'll need it later.

(if (and (= loc root) (= direction :leave))
        new-nodes

The next step is to determine whether we're at the end or not. If the current location is the same as the initial location and the direction is :leave then we know we're done so we just return the list of rendered nodes.

(let [child-loc (zip/down loc)
              right-loc (zip/right loc)]

Again, some more local bindings just to make the remaining code cleaner. I know I'm going to need the leftmost child and the sibling to the right of the current location so I create a binding for those.

(if (or (nil? child-loc) (= direction :leave))
            (if (nil? right-loc)
              (recur (zip/up loc) new-nodes :leave)
              (recur right-loc new-nodes :arrive))
            (recur child-loc new-nodes :arrive)))))))

Ok, here's where we navigate the tree. Let's deal with the else clause first. If there are children to process then we loop, setting the current location to the leftmost child and we set the direction as :arrive. If there aren't any children or we're done processing all of them (indicated by a direction of :leave) then we see if there are any siblings to the right. Again, the else clause causes us to move to the sibling to the right and to loop to process it. If there isn't a sibling to the right then we move back up to the parent and set the direction to :leave indicating that we're all done with this subtree.

This seems to work pretty well. To try it out, try something like:

(traverse my-zip (partial render-element :open) (partial render-element :close))

Comments and/or suggestions are always welcome.