(in-package :fwoar.cl-git)
 
 (defun edges-in-fanout (toc s sha)
   (let* ((fanout-offset (getf toc :fanout)))
     (file-position s (+ fanout-offset (* 4 (1- (elt sha 0)))))
     (destructuring-bind ((_ . cur) (__ . next))
         (fwoar.bin-parser:extract '((cur 4 fwoar.bin-parser:be->int)
                                     (next 4 fwoar.bin-parser:be->int))
                                   s)
       (declare (ignore _ __))
       (values cur next))))
 
 (defun find-sha-between-terms (toc s start end sha)
   (unless (>= start end)
     (let* ((sha-offset (getf toc :shas))
            (mid (floor (+ start end)
                        2)))
       (file-position s (+ sha-offset (* 20 mid)))
       (let ((sha-at-mid (read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s)))
         (cond ((string< sha sha-at-mid)
                (find-sha-between-terms toc s start mid sha))
               ((string> sha sha-at-mid)
                (find-sha-between-terms toc s (1+ mid) end sha))
               (t mid))))))
 
 (defun find-pack-containing (pack-file id)
   (with-open-file (s (index-file pack-file)
                      :element-type '(unsigned-byte 8))
     (let ((binary-sha (ironclad:hex-string-to-byte-array id))
           (toc (idx-toc s)))
       (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha)
         (declare (ignore _))
         (let ((midpoint (find-sha-between-terms toc s 0 end id)))
           (and midpoint
                (values pack-file
                        midpoint)))))))
 
 (defun find-object-in-pack-files (repo id)
   (dolist (pack-file (pack-files repo))
     (multiple-value-bind (pack mid) (find-pack-containing pack-file id)
       (when pack
         (return-from find-object-in-pack-files
           (values pack mid))))))
 

 (defun behead (data)
   (elt (partition 0 data)
        1))
 
 (defun tree-entry (data)
   (values-list (partition 0 data :with-offset 20)))
 
 (defun format-tree-entry (entry)
   (destructuring-bind (info sha) (partition 0 entry)
     (concatenate 'vector
                  (apply #'concatenate 'vector
                         (serapeum:intersperse (vector (char-code #\tab))
                                               (reverse
                                                (partition (char-code #\space)
                                                           info))))
                  (list (char-code #\tab))
                  (babel:string-to-octets (elt (->sha-string sha) 0) :encoding *git-encoding*))))
 
 (defun tree-entries (data &optional accum)
   (if (<= (length data) 0)
       (apply #'concatenate 'vector
              (serapeum:intersperse (vector (char-code #\newline))
                                    (nreverse accum)))
       (multiple-value-bind (next rest) (tree-entry data) 
         (tree-entries rest
                       (list* (format-tree-entry next)
                              accum)))))
 
 (defgeneric extract-object-of-type (type s repository)
   (:method ((type integer) s repository)

     (extract-object-of-type (object-type->sym type)

                             s
                             repository))
 
   (:method ((type (eql :commit)) (s stream) repository)
     (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))
 
   (:method ((type (eql :blob)) (s stream) repository)
     (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))
 

   (:method ((type (eql :tag)) (s stream) repository)
     (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s))
 

   (:method ((type (eql :tree)) (s stream) repository)
     (let* ((data (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))
       (tree-entries data))))

 (defun read-object-from-pack (s repository)

   (let* ((metadata (fwoar.bin-parser:extract-high s))
          (type (get-object-type metadata))
          (size (get-object-size metadata))

          (object-data (extract-object-of-type type s repository)))

     (list (cons :type (object-type->sym type))
           (cons :decompressed-size size)
           (cons :object-data object-data)
           (cons :raw-data object-data))))
 

 (defun extract-object-from-pack (pack obj-number)
   (with-open-file (s (index-file pack) :element-type '(unsigned-byte 8))
     (with-open-file (p (pack-file pack) :element-type '(unsigned-byte 8))
       (let* ((toc (idx-toc s))
              (offset-offset (getf toc :4-byte-offsets)))
         (file-position s (+ offset-offset (* 4 obj-number)))
         (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int s)))
           (file-position p object-offset-in-pack)

           (read-object-from-pack p (repository pack)))))))

 
 (defun extract-loose-object (repo id)
   (with-open-file (s (object repo id)
                      :element-type '(unsigned-byte 8))
     (alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib)
                                                     s)))
       (elt (partition 0 result)
            1))))
 
 (defun extract-object (repo id)
   (if (object repo id)
       (extract-loose-object repo id)
       (data-lens.lenses:view *object-data-lens*
                              (multiple-value-call 'extract-object-from-pack 
                                (find-object-in-pack-files (root repo) id)))))