@@ -5,13 +5,16 @@

    (%base :initarg :base :reader base)

    (%commands :initarg :commands :reader commands)

    (%src-size :initarg :src-size :reader src-size)

-   (%delta-size :initarg :delta-size :reader delta-size)))

+   (%delta-size :initarg :delta-size :reader delta-size))

+  (:documentation

+   "The base type for deltified git objects"))

 (defclass+ ofs-delta (delta)

   ())

 (defclass+ ref-delta (delta)

-  ())

+  ()

+  (:documentation "TODO: mostly unimplemented/untested"))

 (defun make-ofs-delta (base commands repository src-size delta-size)

   (fw.lu:new 'ofs-delta base commands repository src-size delta-size))

@@ -36,19 +39,22 @@

           :unless (zerop (aref bv ix))

             :sum (expt 2 n))))

-(defun expand-copy (copy)

-  (destructuring-bind (command layout numbers) copy

-    (let* ((next-idx 0)

-           (parts (map '(vector (unsigned-byte 8))

-                       (lambda (layout-bit)

-                         (if (= layout-bit 1)

-                             (prog1 (elt numbers next-idx)

-                               (incf next-idx))

-                             0))

-                       (reverse layout))))

-      (list command

-            (fwoar.bin-parser:le->int (subseq parts 0 4))

-            (fwoar.bin-parser:le->int (subseq parts 4))))))

+(defun trace-bases (pack delta)

+  (if (typep delta 'delta)

+      (let* ((offset (second (base delta)))

+             (o (extract-object-at-pos pack

+                                       offset

+                                       (make-instance 'git-ref

+                                                      :hash "00000000"

+                                                      :repo nil)))

+             (obj (serapeum:assocdr :object-data o))

+             (raw (serapeum:assocdr :raw-data o)))

+        (if (typep obj 'delta)

+            (apply-commands (trace-bases pack obj)

+                            (commands delta))

+            (apply-commands (trace-bases pack raw)

+                            (commands delta))))

+      delta))

 (defun partition-commands (data)

   (let ((idx 0))

@@ -72,10 +78,35 @@

                      (list :add

                            (coerce (loop repeat (bit-vector->int insts)

                                          collect (advance))

-                                   '(vector (unsigned-byte 8))))))))

+                                   '(vector (unsigned-byte 8)))))))

+             (expand-copy (copy)

+               (destructuring-bind (command layout numbers) copy

+                 (let* ((next-idx 0)

+                        (parts (map '(vector (unsigned-byte 8))

+                                    (lambda (layout-bit)

+                                      (if (= layout-bit 1)

+                                          (prog1 (elt numbers next-idx)

+                                            (incf next-idx))

+                                          0))

+                                    (reverse layout))))

+                   (list command

+                         (fwoar.bin-parser:le->int (subseq parts 0 4))

+                         (fwoar.bin-parser:le->int (subseq parts 4)))))))

       (loop while (< idx (length data))

             collect (get-command)))))

+(defun apply-commands (base commands)

+  (flexi-streams:with-output-to-sequence (s)

+    (flet ((do-copy (offset cnt)

+             (write-sequence (subseq base offset (+ offset cnt))

+                             s))

+           (do-add (data)

+             (write-sequence data s)))

+      (loop for (command . args) in commands

+            when (eql command :copy) do

+              (apply #'do-copy args)

+            when (eql command :add) do

+              (apply #'do-add args)))))

 (defun get-ofs-delta-offset (buf)

   (let* ((idx 0))

@@ -174,7 +174,6 @@

                     :pack pack-file))))

 (fiveam:def-test pack-files-offsets ()

-

   (let* ((expectations-file

            (asdf:system-relative-pathname

             :co.fwoar.cl-git/tests

@@ -187,3 +186,37 @@

                               (fwoar.cl-git::extract-object

                                (fwoar.cl-git::packed-ref *fake-repo-2* ref)))))))

     ))

+

+(fiveam:def-test pack-file-apply-delta-commands ()

+  (flet ((test-ref (ref)

+           (let* ((extracted-ref

+                    (fwoar.cl-git::extract-object

+                     (fwoar.cl-git::packed-ref :fwoar.cl-git.git-objects.pack-2 ref)))

+                  (base-desc (fwoar.cl-git::base extracted-ref))

+                  (pack (car (fwoar.cl-git::pack-files *fake-repo-2*)))

+                  (expectations-file

+                    (asdf:system-relative-pathname

+                     :co.fwoar.cl-git/tests

+                     (format nil "tests/sample-git-objects/blob-~a-fixture"

+                             (subseq ref 0 7))))

+                  (expectations

+                    (alexandria:read-file-into-byte-vector expectations-file)))

+             (5am:is

+              (serapeum:vector=

+               expectations

+               (fwoar.cl-git::trace-bases pack extracted-ref))))))

+    (test-ref "87c2b9b2dfaa1fbf66b3fe88d3a925593886b159")

+

+    (test-ref "9776df71b5ddf298c56e99b7291f9e68906cf049")

+

+    #+(or) ;; broken

+    (test-ref "31576396aff0fff28f69e0ef84571c0dc8cc43ec")

+

+    #+(or) ;; broken

+    (test-ref "c516dfc248544509c3ae58e3a8c2ab81c225aa9c")

+

+    #+(or) ;; broken

+    (test-ref "53d13ed284f8b57297d1b216e2bab7fb43f8db60")

+

+    #+(or) ;; broken

+    (test-ref "912d31a169ddf1fca122d4c6fe1b1e6be7cd1176")))

new file mode 100644

@@ -0,0 +1,65 @@

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

new file mode 100644

@@ -0,0 +1,34 @@

+;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-

+(in-package :asdf-user)

+

+(defsystem :cl-git

+    :description "A pure-Lisp git implementation"

+    :author "Ed L <edward@elangley.org>"

+    :license "MIT"

+    :pathname #-fw.dev nil #+fw.dev #p"PROJECTS:cl-git;"

+    :depends-on (:alexandria

+                 :chipz

+                 :cl-dot

+                 :data-lens

+                 :fwoar-lisputils

+                 :fwoar-lisputils/bin-parser

+                 :ironclad

+                 :serapeum

+                 :split-sequence

+                 :uiop)

+    :components ((:file "package")

+                 (:file "util" :depends-on ("package"))

+

+                 ;; data model

+                 (:file "model" :depends-on ("package"))

+                 (:file "protocol" :depends-on ("package" "model"))

+                 (:file "repository" :depends-on ("package" "model"))

+                 (:file "tree" :depends-on ("package" "model"))

+                 (:file "commit" :depends-on ("package" "model"))

+

+               (:file "extract" :depends-on ("package" "commit" "tree"))

+                 (:file "branch" :depends-on ("package" "extract"))

+                 (:file "git" :depends-on ("package" "util" "model" "branch"))

+

+                 ;; stable programmer interface

+                 (:file "porcelain" :depends-on ("package" "git" "commit"))))

new file mode 100644

@@ -0,0 +1,81 @@

+(in-package :fwoar.cl-git)

+

+(fw.lu:defun-ct batch-4 (bytes)

+  (mapcar 'fwoar.bin-parser:be->int

+          (serapeum:batches bytes 4)))

+

+(fw.lu:defun-ct batch-20 (bytes)

+  (serapeum:batches bytes 20))

+

+(defmacro sym->plist (&rest syms)

+  `(list ,@(loop for sym in syms

+                 append (list (alexandria:make-keyword sym)

+                              sym))))

+

+(defmacro inspect- (s form)

+  `(let ((result ,form))

+     (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%"

+             ',form

+             ,(typecase form

+                (list `(list ',(car form) ,@(cdr form)))

+                (t `(list ,form)))

+             result)

+     result))

+

+(defun inspect-* (fn)

+  (lambda (&rest args)

+    (declare (dynamic-extent args))

+    (inspect- *trace-output*

+              (apply fn args))))

+

+(defun partition (char string &key from-end (with-offset nil wo-p))

+  (let ((pos (position char string :from-end from-end)))

+    (if pos

+        (if wo-p 

+            (list (subseq string 0 (+ pos with-offset 1))

+                  (subseq string (+ pos 1 with-offset)))

+            (list (subseq string 0 pos)

+                  (subseq string (1+ pos))))

+      (list string

+            nil))))

+

+(defun partition-subseq (subseq string &key from-end)

+  (let ((pos (search subseq string :from-end from-end)))

+    (if pos

+        (list (subseq string 0 pos)

+              (subseq string (+ (length subseq) pos)))

+      (list string

+            nil))))

+

+(serapeum:defalias ->sha-string

+  (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string)

+                 'batch-20))

+

+(defun read-bytes (count format stream)

+  (let ((seq (make-array count :element-type 'serapeum:octet)))

+    (read-sequence seq stream)

+    (funcall format

+             seq)))

+

+(defun sp-ob (ob-string)

+  (partition #\null

+             ob-string))

+

+(defun split-object (object-data)

+  (destructuring-bind (head tail)

+      (partition 0

+                 object-data)

+    (destructuring-bind (type length)

+        (partition #\space

+                   (babel:octets-to-string head :encoding :latin1))

+      (values tail

+              (list type

+                    (parse-integer length))))))

+

+(defun parse-commit (commit)

+  (destructuring-bind (metadata message)

+      (partition-subseq #(#\newline #\newline)

+                        commit #+(or)(babel:octets-to-string commit :encoding :latin1))

+    (values message

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

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

new file mode 100644

@@ -0,0 +1,49 @@

+(in-package :fwoar.cl-git)

+

+(fw.lu:defun-ct batch-4 (bytes)

+  (mapcar 'fwoar.bin-parser:be->int

+          (serapeum:batches bytes 4)))

+

+(fw.lu:defun-ct batch-20 (bytes)

+  (serapeum:batches bytes 20))

+

+(defmacro sym->plist (&rest syms)

+  `(list ,@(loop for sym in syms

+                 append (list (alexandria:make-keyword sym)

+                              sym))))

+

+(defmacro inspect- (s form)

+  `(let ((result ,form))

+     (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%"

+             ',form

+             ,(typecase form

+                (list `(list ',(car form) ,@(cdr form)))

+                (t `(list ,form)))

+             result)

+     result))

+

+(defun inspect-* (fn)

+  (lambda (&rest args)

+    (declare (dynamic-extent args))

+    (inspect- *trace-output*

+              (apply fn args))))

+

+(defun partition (char string &key from-end)

+  (let ((pos (position char string :from-end from-end)))

+    (if pos

+	      (list (subseq string 0 pos)

+	            (subseq string (1+ pos)))

+	      (list string

+	            nil))))

+

+(defun partition-subseq (subseq string &key from-end)

+  (let ((pos (search subseq string :from-end from-end)))

+    (if pos

+	      (list (subseq string 0 pos)

+	            (subseq string (+ (length subseq) pos)))

+	      (list string

+	            nil))))

+

+(serapeum:defalias ->sha-string

+  (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string)

+                 'batch-20))

new file mode 100644

@@ -0,0 +1,163 @@

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

new file mode 100644

@@ -0,0 +1,140 @@

+(in-package :fwoar.cl-git)

+

+(defun seek-to-object-in-pack (idx-stream pack-stream obj-number)

+  (let* ((toc (idx-toc idx-stream))

+         (offset-offset (getf toc :4-byte-offsets)))

+    (file-position idx-stream (+ offset-offset (* 4 obj-number)))

+    (let ((object-offset-in-pack (read-bytes 4 'fwoar.bin-parser:be->int idx-stream)))

+      (file-position pack-stream object-offset-in-pack))))

+

+(deftype octet ()

+  '(unsigned-byte 8))

+

+(defmacro with-open-files* ((&rest bindings) &body body)

+  `(uiop:nest ,@(mapcar (serapeum:op

+                          `(with-open-file ,_1))

+                        bindings)

+              (progn

+                ,@body)))

+

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

+  (with-open-files* ((s (index-file pack) :element-type 'octet)

+                     (p (pack-file pack) :element-type 'octet))

+    (seek-to-object-in-pack s p obj-number)

+    (read-object-metadata-from-pack p)))

+

+(defun turn-read-object-to-string (object)

+  (data-lens.lenses:over *object-data-lens*

+                         'babel:octets-to-string object))

+

+(defun fanout-table (s)

+  (coerce (alexandria:assoc-value

+           (fwoar.bin-parser:extract '((head 4)

+                                       (version 4)

+                                       (fanout-table #.(* 4 256) batch-4))

+                                     s)

+           'fanout-table)

+          'vector))

+

+(defun get-object-size (bytes)

+  (let ((first (elt bytes 0))

+        (rest (subseq bytes 1)))

+    (logior (ash (fwoar.bin-parser:be->int rest) 4)

+            (logand first 15))))

+

+(defun get-object-type (bytes)

+  (let ((first (elt bytes 0)))

+    (ldb (byte 3 4)

+         first)))

+

+(defun get-shas-before (fanout-table first-sha-byte s)

+  (let ((num-before (elt fanout-table first-sha-byte))

+        (num-total (alexandria:last-elt fanout-table)))

+    (values (fwoar.bin-parser:extract (list (list 'shas (* 20 num-before) '->sha-string))

+                                      s)

+            (- num-total num-before))))

+

+(defun advance-past-crcs (obj-count s)

+  (file-position s

+                 (+ (file-position s)

+                     (* 4 obj-count))))

+

+(defun object-offset (object-number s)

+  (file-position s

+                 (+ (file-position s)

+                     (* (1- object-number)

+                        4)))

+  (fwoar.bin-parser:extract '((offset 4 fwoar.bin-parser:be->int))

+                            s))

+

+(defun idx-toc (idx-stream)

+  (let* ((object-count (progn (file-position idx-stream 1028)

+                              (let ((buf (make-array 4)))

+                                (read-sequence buf idx-stream)

+                                (fwoar.bin-parser:be->int buf))))

+         (signature 0)

+         (version 4)

+         (fanout 8)

+         (shas (+ fanout

+                   (* 4 256)))

+         (packed-crcs (+ shas

+                          (* 20 object-count)))

+         (4-byte-offsets (+ packed-crcs

+                             (* 4 object-count)))

+         (8-byte-offsets-pro (+ 4-byte-offsets

+                                 (* object-count 4)))  

+         (pack-sha (- (file-length idx-stream)

+                       40))

+         (8-byte-offsets (when (/= 8-byte-offsets-pro pack-sha)

+                           8-byte-offsets-pro))

+         (idx-sha (- (file-length idx-stream)

+                      20)))

+    (values (sym->plist signature

+                        version

+                        fanout

+                        shas

+                        packed-crcs

+                        4-byte-offsets

+                        8-byte-offsets

+                        pack-sha

+                        idx-sha)

+            object-count)))

+

+(defun collect-data (idx-toc s num)

+  (let ((sha-idx (getf idx-toc :shas))

+        (crc-idx (getf idx-toc :packed-crcs))

+        (4-byte-offsets-idx (getf idx-toc :4-byte-offsets))

+        (8-byte-offsets-idx (getf idx-toc :8-byte-offsets)))

+    (declare (ignore 8-byte-offsets-idx))

+    (values num

+            (progn

+              (file-position s (+ sha-idx (* num 20)))

+              (read-bytes 20 'fwoar.bin-parser:byte-array-to-hex-string s))

+            (progn

+              (file-position s (+ crc-idx (* num 4)))

+              (read-bytes 4 'identity s))

+            (progn

+              (file-position s (+ 4-byte-offsets-idx (* num 4)))

+              (read-bytes 4 'fwoar.bin-parser:be->int s)))))

+

+(defun read-object-metadata-from-pack (s)

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

+         (type-raw (get-object-type metadata))

+         (size (get-object-size metadata))

+         (type (object-type->sym type-raw)))

+    (values (cons :type type)

+            (cons :decompressed-size size))))

+

+(defun get-first-commits-from-pack (idx pack n)

+  (let ((toc (idx-toc idx))

+        (result ()))

+    (dotimes (i n (reverse result))

+      (multiple-value-bind (_ sha __ offset) (collect-data toc idx i)

+        (declare (ignore _ __))

+        (file-position pack offset)

+        (push `((:sha . ,sha)

+                ,@(multiple-value-list

+                   (read-object-metadata-from-pack pack))

+                (:offset . ,offset))

+              result)))))

+