@@ -1,11 +1,21 @@

 (in-package :fwoar.cl-git)

 (defclass git-commit ()

-  ((%metadata :initarg :metadata :reader metadata)

+  ((%hash :initarg :hash :reader hash)

+   (%metadata :initarg :metadata :reader metadata)

    (%data :initarg :data :reader data)))

-(defun git-commit (metadata data)

-  (fw.lu:new 'git-commit metadata data))

+(defmethod print-object ((o git-commit) s)

+  (if *print-readably*

+      (format s "#.(git-commit ~<~s~_~s~_~s~:>)"

+              (list (hash o)

+                    (metadata o)

+                    (data o)))

+      (print-unreadable-object (o s :type t :identity t)

+        (format s "~a" (subseq (hash o) 0 6)))))

+

+(defun git-commit (hash metadata data)

+  (fw.lu:new 'git-commit hash metadata data))

 (defun parse-commit (commit)

   (destructuring-bind (metadata message)

@@ -15,14 +25,18 @@

             (map 'vector (serapeum:op (partition #\space _))

                  (fwoar.string-utils:split #\newline metadata)))))

-(defun make-commit (data)

+(defun make-commit (data hash)

   (multiple-value-bind (message metadata)

       (parse-commit data)

-    (git-commit metadata message)))

+    (git-commit hash metadata message)))

+

+(defmethod -extract-object-of-type ((type (eql :commit)) s repository &key hash)

+  (make-commit (babel:octets-to-string s :encoding *git-encoding*)

+               hash))

-(defmethod -extract-object-of-type ((type (eql :commit)) s repository &key)

-  (make-commit (babel:octets-to-string s :encoding *git-encoding*)))

+(defmethod component ((component (eql :hash)) (object git-commit))

+  (hash object))

 (defmethod component ((component (eql :tree)) (object git-commit))

   (ensure-ref

@@ -17,11 +17,13 @@

                        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)

+        (cond ((serapeum:string-prefix-p sha sha-at-mid)

+               (values mid sha-at-mid))

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

+              (t (values mid sha-at-mid)))))))

 (defun find-pack-containing (pack-file id)

   (with-open-file (s (index-file pack-file)

@@ -30,19 +32,21 @@

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

+        (multiple-value-bind (midpoint sha)

+            (find-sha-between-terms toc s 0 end id)

           (and midpoint

                (values pack-file

-                       midpoint)))))))

+                       midpoint

+                       sha)))))))

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

+    (multiple-value-bind (pack mid sha) (find-pack-containing pack-file id)

       (when pack

         (return-from find-object-in-pack-files

-          (values pack mid))))))

+          (values pack mid sha))))))

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

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

   (let* ((pos (file-position s))

          (metadata (fwoar.bin-parser:extract-high s))

          (type (object-type->sym (get-object-type metadata)))

@@ -52,31 +56,41 @@

                              (read-sequence buffer s)

                              buffer)

                            (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))

-         (object-data (extract-object-of-type type decompressed repository pos (pathname s))))

+         (object-data (extract-object-of-type type decompressed repository pos (pathname s) ref)))

     (list (cons :type (object-type->sym type))

           (cons :decompressed-size size)

           (cons :object-data object-data)

           (cons :raw-data decompressed))))

-(defun extract-object-of-type (type s repository pos packfile)

-  (with-simple-restart (continue "Skip object of type ~s" type)

+(defun extract-object-of-type (type s repository pos packfile ref)

+  (with-simple-restart (continue "Skip object of type ~s at position ~d"

+                                 type

+                                 pos)

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

                              s

                              repository

                              :offset-from pos

-                             :packfile packfile)))

+                             :packfile packfile

+                             :hash (ref-hash ref))))

-(defun extract-object-from-pack (pack obj-number)

+(defun pack-offset-for-object (index-file obj-number)

+  (let ((offset-offset (getf index-file

+                             :4-byte-offsets)))

+    (+ offset-offset

+       (* 4 obj-number))))

+

+(defun extract-object-from-pack (pack obj-number ref)

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

+      (file-position s (pack-offset-for-object (idx-toc s)

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

+                               ref)))))

-(defun extract-loose-object (repo file)

+(defun extract-loose-object (repo file ref)

   (with-open-file (s file :element-type '(unsigned-byte 8))

     (alexandria:when-let ((result (chipz:decompress nil (chipz:make-dstate 'chipz:zlib)

                                                     s)))

@@ -87,13 +101,16 @@

                                      1)

                                 repo

                                 0

-                                nil)))))

+                                nil

+                                ref)))))

 (defgeneric extract-object (object)

   (:method ((object loose-ref))

     (extract-loose-object (ref-repo object)

-                          (loose-ref-file object)))

+                          (loose-ref-file object)

+                          object))

   (:method ((object packed-ref))

     (data-lens.lenses:view *object-data-lens*

                            (extract-object-from-pack (packed-ref-pack object)

-                                                     (packed-ref-offset object)))))

+                                                     (packed-ref-offset object)

+                                                     object))))

@@ -7,10 +7,10 @@

                            (truename repo)))))

 (defun packed-ref (repo id)

-  (multiple-value-bind (pack offset) (find-object-in-pack-files repo id)

+  (multiple-value-bind (pack offset sha) (find-object-in-pack-files repo id)

     (when pack

       (make-instance 'packed-ref

-                     :hash id

+                     :hash sha

                      :repo repo

                      :offset offset

                      :pack pack))))

@@ -18,13 +18,14 @@

 (defgeneric ref (repo id)

   (:documentation "Given a REPOsitory and a ref ID return the ref-id object.")

   (:method ((repo git-repository) (id string))

-    (let ((repo-root (root-of repo)))

-      (or (alexandria:when-let ((object-file (loose-object repo id)))

-            (make-instance 'loose-ref

-                           :repo repo-root

-                           :hash id

-                           :file object-file))

-          (packed-ref repo id)))))

+    (or (alexandria:when-let ((object-file (loose-object repo id)))

+          (make-instance 'loose-ref

+                         :repo repo

+                         :hash (concatenate 'string

+                                            (subseq id 0 2)

+                                            (pathname-name object-file))

+                         :file object-file))

+        (packed-ref repo id))))

 (defun ensure-ref (thing &optional (repo *git-repository*))

   (typecase thing