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

(defun extract-object-of-type (type s repository)
  (with-simple-restart (continue "Skip object of type ~s" type)
    (%extract-object-of-type type s repository)))

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

  (:method ((type (eql :blob)) s repository)
    s)

  (:method ((type (eql :tag)) s repository)
    s)

  (:method ((type (eql :tree)) s repository)
    (tree-entries s)))

(defun read-object-from-pack (s repository)
  (let* ((metadata (fwoar.bin-parser:extract-high s))
         (type (object-type->sym (get-object-type metadata)))
         (size (get-object-size metadata))
         (decompressed (if (member type '(:ofs-delta :ref-delta))
                           s
                           (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))
         (object-data (extract-object-of-type type decompressed 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)))))))

(defclass git-object ()
  ((%repo :initarg :repo :reader object-repo)
   (%hash :initarg :hash :reader object-hash)))
(defclass loose-object (git-object)
  ((%file :initarg :file :reader loose-object-file)))
(defclass packed-object (git-object)
  ((%pack :initarg :pack :reader packed-object-pack)
   (%offset :initarg :offset :reader packed-object-offset)))

(defun object (repo id)
  (let ((repo-root (typecase repo
                     (repository (root repo))
                     (string (namestring
                              (truename repo))))))
    (or (alexandria:when-let ((object-file (loose-object repo id)))
          (make-instance 'loose-object :repo repo-root :hash id :file object-file))
        (multiple-value-bind (pack offset) (find-object-in-pack-files repo id)
          (when pack
            (make-instance 'packed-object :repo repo-root :offset offset :pack pack))))))

(defun extract-loose-object (repo file)
  (with-open-file (s file :element-type '(unsigned-byte 8))
    (alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib)
                                                    s)))
      (destructuring-bind (type rest)
          (partition (char-code #\space) result)
        (extract-object-of-type (object-type->sym (babel:octets-to-string type))
                                (elt (partition 0 rest)
                                     1)
                                repo)))))

(defgeneric extract-object-next (object)
  (:method ((object loose-object))
    (extract-loose-object (object-repo object)
                          (loose-object-file object)))
  (:method ((object packed-object))
    (data-lens.lenses:view *object-data-lens*
                           (extract-object-from-pack (packed-object-pack object)
                                                     (packed-object-offset object)))))

(defun extract-object (repo id)
  (if (loose-object-p repo id)
      (extract-loose-object repo (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)))))