@@ -24,6 +24,7 @@

   :components ((:file "package")

                (:file "types" :depends-on ("package"))

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

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

                ;; data model

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

@@ -48,11 +48,12 @@

 (defun trace-bases (pack delta)

   (assert (typep delta 'delta))

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

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

-                                   offset

-                                   (make-instance 'git-ref

-                                                  :hash "00000000"

-                                                  :repo nil)))

+         (o (fwoar.cl-git.pack::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)

@@ -68,8 +69,9 @@

 (defun resolve-delta (ref maybe-delta)

   (typecase maybe-delta

-    (delta (multiple-value-bind (raw-data type) (trace-bases (packed-ref-pack ref)

-                                                             maybe-delta)

+    (delta (multiple-value-bind (raw-data type) (trace-bases

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

+                                                 maybe-delta)

              (-extract-object-of-type type

                                       raw-data

                                       (ref-repo ref)

@@ -1,106 +1,5 @@

 (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 ((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 (values mid sha-at-mid)))))))

-

-(defun find-sha-in-pack (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 pack-file)))

-      (multiple-value-bind (_ end) (edges-in-fanout toc s binary-sha)

-        (declare (ignore _))

-        (multiple-value-bind (midpoint sha)

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

-          (and midpoint

-               (values pack-file

-                       midpoint

-                       sha)))))))

-

-(defun find-object-in-pack-files (repo id)

-  (dolist (pack-file (pack-files repo))

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

-      (when pack

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

-          (values pack mid sha))))))

-

-(defun raw-object-for-ref (packed-ref)

-  (let ((pack (packed-ref-pack packed-ref)))

-    (with-pack-streams (i p) pack

-      (file-position p (read-4-byte-offset pack (packed-ref-offset packed-ref)))

-      (get-object-from-pack p))))

-

-(defun get-object-from-pack (s)

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

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

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

-    (case type

-      (:ref-delta (error ":ref-delta not implemented yet"))

-      (:ofs-delta (get-ofs-delta-offset-streaming s)))

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

-      (values (concatenate

-               '(vector fwoar.cl-git.types:octet)

-               (ecase type

-                 (:commit #.(babel:string-to-octets "commit" :encoding :ascii))

-                 (:blob #.(babel:string-to-octets "blob" :encoding :ascii))

-                 (:tree #.(babel:string-to-octets "tree" :encoding :ascii)))

-               #(32)

-               (babel:string-to-octets (prin1-to-string size ):encoding :ascii)

-               #(0)

-               decompressed)

-              size

-              (length decompressed)))))

-

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

-  (let* ((idx 0))

-    (flet ((advance ()

-             (read-byte buf)))

-      (loop

-        for c = (advance)

-        for ofs = (logand c 127) then (+ (ash (1+ ofs)

-                                              7)

-                                         (logand c 127))

-        while (> (logand c 128) 0)

-        finally

-           (return (values (- ofs) idx))))))

-

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

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

-         (delta-base (case type

-                       (:ref-delta (error ":ref-delta not implemented yet"))

-                       (:ofs-delta (get-ofs-delta-offset-streaming s))))

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

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

-    (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 ref delta-base)

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

                                  type

@@ -113,32 +12,6 @@

                              :hash (ref-hash ref)

                              :base delta-base)))

-(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-at-pos (pack pos ref)

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

-    (file-position p pos)

-    (read-object-from-pack p

-                           (repository pack)

-                           ref)))

-

-(defun read-4-byte-offset (pack obj-number)

-  (with-pack-streams (s _) pack

-    (file-position s

-                   (pack-offset-for-object (idx-toc pack)

-                                           obj-number))

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

-

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

-  (let ((object-offset-in-pack (read-4-byte-offset pack obj-number)))

-    (extract-object-at-pos pack

-                           object-offset-in-pack

-                           ref)))

-

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

@@ -154,18 +27,8 @@

                                 ref

                                 nil)))))

-(defparameter *want-delta* nil)

 (defgeneric extract-object (object)

   (:method ((object loose-ref))

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

                           (loose-ref-file object)

-                          object))

-  (:method ((object packed-ref))

-    (let ((maybe-delta (data-lens.lenses:view *object-data-lens*

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

-                                                                        (packed-ref-offset object)

-                                                                        object))))

-      (if *want-delta*

-          maybe-delta

-          (resolve-delta object

-                         maybe-delta)))))

+                          object)))

@@ -1,13 +1,5 @@

 (in-package :fwoar.cl-git)

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

-  (let* ((toc (idx-toc pack))

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

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

-              object-offset-in-pack))))

-

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

   (with-pack-streams (s p) pack

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

@@ -54,46 +46,11 @@

 (defun object-offset (object-number s)

   (file-position s

                  (+ (file-position s)

-                     (* (1- object-number)

-                        4)))

+                    (* (1- object-number)

+                       4)))

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

                             s))

-(defgeneric idx-toc (pack)

-  (:method ((pack pack))

-    (with-pack-streams (idx-stream _) pack

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

@@ -3,11 +3,6 @@

 (defparameter *object-data-lens*

   (data-lens.lenses:make-alist-lens :object-data))

-(defclass pack ()

-  ((%pack :initarg :pack :reader pack-file)

-   (%index :initarg :index :reader index-file)

-   (%repository :initarg :repository :reader repository)))

-

 (defclass repository ()

   ((%root :initarg :root :reader root)))

 (defclass git-repository (repository)

@@ -97,22 +92,13 @@

   (let ((obj-path (fwoar.string-utils:insert-at 2 #\/ sha)))

     (merge-pathnames obj-path ".git/objects/")))

-(defun pack (index pack repository)

-  (fw.lu:new 'pack index pack repository))

-

-(defmacro with-pack-streams ((idx-sym pack-sym) pack &body body)

-  (alexandria:once-only (pack)

-    `(with-open-file (,idx-sym (index-file ,pack) :element-type 'fwoar.cl-git.types:octet)

-       (with-open-file (,pack-sym (pack-file ,pack) :element-type 'fwoar.cl-git.types:octet)

-         ,@body))))

-

 (defgeneric pack-files (repo)

   (:method ((repo git-repository))

     (mapcar (serapeum:op

-              (pack _1

-                    (merge-pathnames

-                     (make-pathname :type "pack") _1)

-                    repo))

+              (fwoar.cl-git.pack:pack _1

+                                      (merge-pathnames

+                                       (make-pathname :type "pack") _1)

+                                      repo))

             (uiop:directory*

              (merge-pathnames ".git/objects/pack/*.idx"

                               (root-of repo))))))

@@ -141,9 +127,6 @@

    (%hash :initarg :hash :reader ref-hash)))

 (defclass loose-ref (git-ref)

   ((%file :initarg :file :reader loose-ref-file)))

-(defclass packed-ref (git-ref)

-  ((%pack :initarg :pack :reader packed-ref-pack)

-   (%offset :initarg :offset :reader packed-ref-offset)))

 (defmethod print-object ((obj git-ref) s)

   (print-unreadable-object (obj s :type t :identity t)

@@ -6,15 +6,6 @@

     ((or pathname string) (namestring

                            (truename repo)))))

-(defun packed-ref (repo id)

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

-    (when pack

-      (make-instance 'packed-ref

-                     :hash sha

-                     :repo repo

-                     :offset offset

-                     :pack pack))))

-

 (defgeneric ref (repo id)

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

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

@@ -73,13 +73,13 @@

   (fake-ref repo hash))

 (defmethod fwoar.cl-git::pack-files ((repo (eql *fake-repo*)))

   (list

-   (fwoar.cl-git::pack (asdf:system-relative-pathname

-                        :co.fwoar.cl-git

-                        "tests/sample-git-objects/hello-world-pack.idx")

-                       (asdf:system-relative-pathname

-                        :co.fwoar.cl-git

-                        "tests/sample-git-objects/hello-world-pack.pack")

-                       repo)))

+   (fwoar.cl-git.pack::pack (asdf:system-relative-pathname

+                             :co.fwoar.cl-git

+                             "tests/sample-git-objects/hello-world-pack.idx")

+                            (asdf:system-relative-pathname

+                             :co.fwoar.cl-git

+                             "tests/sample-git-objects/hello-world-pack.pack")

+                            repo)))

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

   (let* ((hash "7d7b56a6a64e090041f55293511f48aba6699f1a")

@@ -162,20 +162,20 @@

   ())

 (defun fake-ref-2 (repo hash)

   (fwoar.lisputils:new 'fake-ref-2 repo hash))

-(defmethod fwoar.cl-git::packed-ref-pack ((ref fake-ref-2))

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

   (let* ((pack-file (asdf:system-relative-pathname

                      :co.fwoar.cl-git/tests

                      "tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.pack"))

          (index-file (asdf:system-relative-pathname

                       :co.fwoar.cl-git/tests

                       "tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.idx")))

-    (make-instance 'fwoar.cl-git::pack

+    (make-instance 'fwoar.cl-git.pack::pack

                    :repository nil

                    :index index-file

                    :pack pack-file)))

-(defmethod fwoar.cl-git::packed-ref-offset ((ref fake-ref-2))

-  (nth-value 1 (fwoar.cl-git::find-sha-in-pack (fwoar.cl-git::packed-ref-pack ref)

-                                               (fwoar.cl-git::ref-hash ref))))

+(defmethod fwoar.cl-git.pack::packed-ref-offset ((ref fake-ref-2))

+  (nth-value 1 (fwoar.cl-git.pack::find-sha-in-pack (fwoar.cl-git.pack::packed-ref-pack ref)

+                                                    (fwoar.cl-git::ref-hash ref))))

 (defmethod fwoar.cl-git::ref ((repo (eql *fake-repo-2*)) hash)

   (fake-ref-2 repo hash))

 (defmethod fwoar.cl-git::pack-files ((repo (eql *fake-repo-2*)))

@@ -186,13 +186,13 @@

           (index-file (asdf:system-relative-pathname

                        :co.fwoar.cl-git/tests

                        "tests/sample-git-objects/pack-a0533639fdee4493fdbfc1b701872ace63b95e5f.idx")))

-     (make-instance 'fwoar.cl-git::pack

+     (make-instance 'fwoar.cl-git.pack::pack

                     :repository nil

                     :index index-file

                     :pack pack-file))))

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

-  (let* ((fwoar.cl-git:*want-delta* t)

+  (let* ((fwoar.cl-git.pack::*want-delta* t)

          (expectations-file

            (asdf:system-relative-pathname

             :co.fwoar.cl-git/tests

@@ -272,7 +272,7 @@

                 "cab7cafae3b61c5b101ee914cd4f5c8357e77fad"

                 "f03a8d1b4cea085ee9555037d09bca2dbfb990cb")))

     (loop for commit in shas

-          for obj = (fwoar.cl-git::raw-object-for-ref

+          for obj = (fwoar.cl-git.pack::raw-object-for-ref

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

           do (5am:is (equal (crypto:byte-array-to-hex-string

                              (crypto:digest-sequence :sha1 obj))

@@ -96,5 +96,5 @@

 (defpackage :fwoar.cl-git.utils

   (:use :cl)

-  (:import-from :fwoar.cl-git #:partition-subseq)

-  (:export #:partition-subseq))

+  (:import-from :fwoar.cl-git #:partition-subseq #:sym->plist #:read-bytes)

+  (:export #:partition-subseq #:sym->plist #:read-bytes))