parse-tree/update-leaves: revert to using operating on list

...instead of on zipper for simplicity.
chuan6 · Nov 7, 2016 · 4441c12 · 4441c12
1 parent 6e36bf5
commit 4441c12
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 42 deletions.
diff --git a/generator/src/generator/core.clj b/generator/src/generator/core.clj
@@ -86,7 +86,6 @@
             (let [[items rests] (its/read-items cs)]
               (recur rests (into ts (-> items
                                         its/parse
-                                        pt/create
                                         (pt/update-leaves :id genid)
                                         flatten
                                         its/second-pass))))
@@ -390,7 +389,7 @@
        ;; (clojure.pprint/pprint r)
        ;; (println "------------------------")
        (t/is (= src (str/join (map its/str-token (flatten r)))))))
-   (let [r (pt/create (its/parse (items (seq "本法第三十九条和第四十条第一项、第二项"))))]
+   (let [r (its/parse (items (seq "本法第三十九条和第四十条第一项、第二项")))]
      (t/is
       (= '({:token :法 :nth :this :text "本法"}
            ({:token :条 :nth 39 :text "三十九" :第? true :unit? true :id "条39"}
@@ -399,9 +398,9 @@
             ({:token :款 :nth 1}
              ({:token :项 :nth 1 :text "一" :第? true :unit? true :id "条40款1项1"}
               {:token :separator :text "、"})
-             ({:token :项 :nth 2 :text "二" :第? true :unit? true :id "条40款1项2"}))))
+             {:token :项 :nth 2 :text "二" :第? true :unit? true :id "条40款1项2"})))
          (pt/update-leaves r :id (partial id/generate {})))))
-   (let [r (pt/create (its/parse (items (seq "本规定第十、十八、二十六、二十七条"))))]
+   (let [r (its/parse (items (seq "本规定第十、十八、二十六、二十七条")))]
      (t/is
       (= '({:token :规定 :nth :this :text "本规定"}
            ({:token :条 :nth 10 :text "十" :第? true :unit? false :id "条10"}
@@ -410,5 +409,5 @@
             {:token :separator :text "、"})
            ({:token :条 :nth 26 :text "二十六" :第? false :unit? false :id "条26"}
             {:token :separator :text "、"})
-           ({:token :条 :nth 27 :text "二十七" :第? false :unit? true :id "条27"}))
+           {:token :条 :nth 27 :text "二十七" :第? false :unit? true :id "条27"})
          (pt/update-leaves r :id (partial id/generate {})))))))
diff --git a/generator/src/generator/parse_tree.clj b/generator/src/generator/parse_tree.clj
@@ -136,48 +136,29 @@
 (defn update-leaves
   {:test
    #(let [f update-leaves
-          t1 (create (linear-to-tree () doc-hierachy))
-          t2 (create (nth examples 1))
+          t1 (linear-to-tree () doc-hierachy)
+          t2 (nth examples 1)
           pf count
           k  :depth]
       (tt/comprehend-tests
-       (t/is (= '({:depth 1}) (f t1 k pf)))
+       (t/is (= {:depth 1} (f t1 k pf)))
        (t/is (= '({:token :法}
                   ({:token :条}
                    {:token :separator}
                    ({:token :款 :nth 1}
-                    ({:token :项 :depth 4}))))
+                    {:token :项 :depth 4})))
                 (f t2 k pf)))))}
-  [loc k f]
-  (letfn [(sep-token? [t]
-            (and (map? t) (= (:token t) :separator)))
-          (leaf? [loc]
-            (or (not (z/branch? loc))
-                (or (empty? (z/children loc))
-                    (and (every? map? (z/children loc))
-                         (every? sep-token? (z/children loc))))))
-          (ret-v [f loc]
-            (f (conj (vec (map first (z/path loc)))
-                     (node-val loc))))]
-    (if (z/end? loc)
-      (z/root loc)
-      (cond
-        (sep-token? (z/node loc))
-        (recur (z/next loc) k f)
-
-        (nil? (z/node loc))
-        (recur (z/next loc) k f)
-
-        (not (z/branch? loc))
-        (recur (z/next
-                (z/edit loc #(assoc % k (ret-v f loc)))) k f)
-
-        (or (empty? (z/children loc))
-            (every? sep-token? (z/children loc)))
-        (recur (z/next
-                (z/edit loc #(cons (assoc (first %) k (ret-v f loc))
-                                   (z/children loc))))
-               k f)
-
-        :else
-        (recur (z/next loc) k f)))))
+  ([tree k f] (update-leaves tree [] k f))
+  ([[v & children] path k f]
+   (let [sep-token? #(= (:token %) :separator)
+         path' (conj path v)]
+     (cond (empty? children)
+           (assoc v k (f path'))
+
+           (every? sep-token? children)
+           (cons (assoc v k (f path')) children)
+
+           :else
+           (cons v (map #(if (sep-token? %) %
+                             (update-leaves % path' k f))
+                        children))))))