diff --git a/git-graph-tests.el b/git-graph-tests.el index 3141f69..1050328 100644 --- a/git-graph-tests.el +++ b/git-graph-tests.el @@ -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 diff --git a/git-graph.el b/git-graph.el index 7be0bf0..7d3a90e 100644 --- a/git-graph.el +++ b/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