correlr/git-graph
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Re-implement group-topo using streams

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

26
git-graph-tests.el
View file

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

32
git-graph.el
View file

@ -115,7 +115,7 @@
(defun git-graph/group-topo (nodelist) (defun git-graph/group-topo (nodelist)
(reverse (reverse
(car (car
(-reduce-from (seq-reduce
(lambda (acc node) (lambda (acc node)
(let* ((grouped-nodes (car acc)) (let* ((grouped-nodes (car acc))
(group-stack (cdr acc)) (group-stack (cdr acc))
@ -135,8 +135,34 @@
(label . ,(git-graph/node-label node)))) (label . ,(git-graph/node-label node))))
grouped-nodes) grouped-nodes)
group-stack))) 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) (defun git-graph/git-execute (repo-url command &rest args)
(with-temp-buffer (with-temp-buffer