(defpackage :co.fwoar.cl-git.graph
   (:use :cl :fwoar.cl-git)
   (:export ))
 (in-package :co.fwoar.cl-git.graph)

 
 (defclass git-graph ()
   ((%repo :initarg :repo :reader repo)
    (%depth :initarg :depth :reader depth)

    (%stops :initarg :stops :reader stops :initform ())

    (%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
               (data-lens:<>1 (data-lens:applying #'cons)
                              (data-lens:transform-head
                               (serapeum:op (subseq _1 0
                                                    (min (length _1)
                                                         8))))
                              #'reverse))
              (fwoar.cl-git::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))

   (when commit
     (co.fwoar.git:with-repository (repository)
       (alexandria:when-let*
           ((ref (fwoar.cl-git:ensure-ref commit))
            (direct-obj (fwoar.cl-git::extract-object
                         ref))
            (obj (etypecase direct-obj
                   (fwoar.cl-git::delta
                    (fwoar.cl-git::-extract-object-of-type
                     :commit
                     (fwoar.cl-git::trace-bases
                      (fwoar.cl-git::packed-ref-pack
                       ref)
                      direct-obj)
                     fwoar.cl-git::*git-repository*
                     :hash (fwoar.cl-git::ref-hash ref)))
                   (fwoar.cl-git::git-object
                    direct-obj)))
            (parents (fwoar.cl-git:component
                      :parents
                      obj)))
         (when parents
           parents)))))

 
 (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 8)
                                                  (branches graph)
                                                  #1#)))))

 (defmethod cl-dot:graph-object-points-to
     ((graph git-graph) (commit string))
   (unless (member commit (stops graph)
                   :test 'serapeum:string-prefix-p)
     (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 8))))
              (get-commit-parents (repo graph) commit))))