(in-package :fwoar.cl-git)

(defclass git-graph ()
  ((%repo :initarg :repo :reader repo)
   (%depth :initarg :depth :reader depth)
   (%branches :reader branches)
   (%node-cache :reader node-cache :initform (make-hash-table :test 'equal))
   (%edge-cache :reader edge-cache :initform (make-hash-table :test 'equal))))

(defmethod initialize-instance :after ((object git-graph) &key)
  (setf (slot-value object '%branches)
        (fw.lu:alist-string-hash-table
         (funcall (data-lens:over
                   (<>1 (data-lens:applying #'cons)
                        (data-lens:transform-head
                         (serapeum:op (subseq _1 0 (min (length _1) 7))))
                        #'reverse))
                  (branches (repo object))))))

(defun git-graph (repo)
  (fw.lu:new 'git-graph repo))

(defun get-commit-parents (repository commit)
  (map 'list 
       (serapeum:op (second (partition #\space _)))
       (remove-if-not (lambda (it)
                        (serapeum:string-prefix-p "parent" it))
                      (nth-value 1 (parse-commit
                                    (split-object
                                     (chipz:decompress nil (chipz:make-dstate 'chipz:zlib)
                                                       (object repository
                                                               commit))))))))

(defmethod cl-dot:graph-object-node ((graph git-graph) (commit string))
  (alexandria:ensure-gethash commit
                             (node-cache graph)
                             (make-instance 'cl-dot:node
                                            :attributes `(:label ,(gethash #1=(subseq commit 0 7)
                                                                           (branches graph)
                                                                           #1#)))))

(defmethod cl-dot:graph-object-points-to ((graph git-graph) (commit string))
  (mapcar (lambda (c)
            (setf (gethash (list commit c)
                           (edge-cache graph))
                  t)
            c)
          (remove-if (lambda (it)
                       (gethash (list commit it)
                                (edge-cache graph)))
                     (mapcar (serapeum:op (subseq _ 0 7))
                             (get-commit-parents (repo graph) commit)
                             #+nil
                             (loop
                               for cur = (list commit) then parents
                               for parents = (let ((f (get-commit-parents (repo graph) (car cur))))
                                               f)
                               until (or (not parents)
                                         (cdr parents))
                               finally (return (or parents
                                                   (when (not (equal commit (car cur)))
                                                     cur))))))))