Re-implement group-topo using streams

This commit is contained in:
Correl Roush 2015-12-04 23:06:38 -05:00
parent b0d9d005b8
commit 28d1866cb8
2 changed files with 52 additions and 6 deletions

View file

@ -24,12 +24,13 @@
;;; Code:
(require 'ert)
(require 'stream)
(require 'git-graph)
;; 1---2---5---6---7 [master]
;; \ /
;; 3---4 [topic]
(ert-deftest automatically-group-nodes ()
(ert-deftest automatically-group-nodes-list ()
(let* ((example-graph
(git-graph/group-topo
(list (git-graph/make-node 7 '(6) '((label . master)))
@ -45,7 +46,26 @@
(topic-nodes (seq-map #'git-graph/node-id
(seq-filter (lambda (node) (eq 4 (git-graph/node-group node)))
example-graph))))
(should (equal '(7 6 5 2 1) master-nodes))
(should (equal '(4 3) topic-nodes))))
(should (equal '(7 6 5 2 1) (seq-into-sequence master-nodes)))
(should (equal '(4 3) (seq-into-sequence topic-nodes)))))
(ert-deftest automatically-group-nodes-stream ()
(let* ((example-graph
(git-graph/group-topo
(stream (list (git-graph/make-node 7 '(6) '((label . master)))
(git-graph/make-node 6 '(5 4))
(git-graph/make-node 5 '(2))
(git-graph/make-node 4 '(3) '((label . topic)))
(git-graph/make-node 3 '(2))
(git-graph/make-node 2 '(1))
(git-graph/make-node 1 '())))))
(master-nodes (seq-map #'git-graph/node-id
(seq-filter (lambda (node) (eq 7 (git-graph/node-group node)))
example-graph)))
(topic-nodes (seq-map #'git-graph/node-id
(seq-filter (lambda (node) (eq 4 (git-graph/node-group node)))
example-graph))))
(should (equal '(7 6 5 2 1) (seq-into-sequence master-nodes)))
(should (equal '(4 3) (seq-into-sequence topic-nodes)))))
;;; git-graph-tests.el ends here

View file

@ -115,7 +115,7 @@
(defun git-graph/group-topo (nodelist)
(reverse
(car
(-reduce-from
(seq-reduce
(lambda (acc node)
(let* ((grouped-nodes (car acc))
(group-stack (cdr acc))
@ -135,8 +135,34 @@
(label . ,(git-graph/node-label node))))
grouped-nodes)
group-stack)))
nil
nodelist))))
nodelist
nil))))
(defun git-graph/group-topo (nodes)
(let ((node-stream (if (streamp nodes) nodes
(stream nodes))))
(git-graph/group-topo--with-stack node-stream '())))
(defun git-graph/group-topo--with-stack (node-stream group-stack)
(unless (stream-empty-p node-stream)
(let* ((node (stream-first node-stream))
(rest (stream-rest node-stream))
(node-id (git-graph/node-id node))
(group-from-stack (--if-let (assoc node-id group-stack)
(cdr it)))
(group (or group-from-stack node-id))
(parents (git-graph/node-parents node))
(first-parent (first parents)))
(if group-from-stack
(pop group-stack))
(if (and first-parent (not (assoc first-parent group-stack)))
(push (cons first-parent group) group-stack))
(stream-cons
(git-graph/make-node node-id
parents
`((group . ,group)
(label . ,(git-graph/node-label node))))
(git-graph/group-topo--with-stack rest group-stack)))))
(defun git-graph/git-execute (repo-url command &rest args)
(with-temp-buffer