Re-implement group-topo using streams
This commit is contained in:
parent
b0d9d005b8
commit
28d1866cb8
2 changed files with 52 additions and 6 deletions
|
@ -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
|
||||
|
|
32
git-graph.el
32
git-graph.el
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue