(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)

   #+lispworks
   (declare (notinline mismatch serapeum:string-prefix-p))

   (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)

                                                        (loose-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))

   #+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))))
 
   (funcall (data-lens:<>1 (data-lens:over (serapeum:op
                                             (setf (gethash (list commit _1)
                                                            (edge-cache graph))
                                                   t)
                                             _1))
                           (data-lens:exclude (serapeum:op
                                                (gethash (list commit _1)
                                                         (edge-cache graph))))
                           (data-lens:over (serapeum:op (subseq _ 0 7))))
            (get-commit-parents (repo graph) commit)))