@@ -20,9 +20,10 @@

                :serapeum

                :split-sequence

                :uiop)

-  :in-order-to ((test-op (test-op :data-lens/test)))

+  :in-order-to ((test-op (test-op :co.fwoar.cl-git/tests)))

   :components ((:file "package")

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

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

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

                ;; data model

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

@@ -34,7 +35,7 @@

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

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

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

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

                ;; stable programmer interface

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

@@ -4,6 +4,12 @@

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

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

+(defun git-commit (hash metadata data)

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

+

+(defun clamp-string (s len)

+  (subseq s 0 (min len (length s))))

+

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

   (if *print-readably*

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

@@ -11,10 +17,7 @@

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

+        (format s "~a" (format nil "~7,1,1,'x@a" (clamp-string (hash o) 7))))))

 (defun parse-commit (commit)

   (destructuring-bind (metadata message)

@@ -25,11 +25,11 @@

                (find-sha-between-terms toc s (1+ mid) end sha))

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

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

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

+          (toc (idx-toc pack-file)))

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

         (declare (ignore _))

         (multiple-value-bind (midpoint sha)

@@ -41,7 +41,7 @@

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

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

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

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

@@ -86,14 +86,18 @@

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

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

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

-      (extract-object-at-pos pack

-                             object-offset-in-pack

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

@@ -1,26 +1,21 @@

 (in-package :fwoar.cl-git)

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

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

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

+

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

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

+  (with-pack-streams (s p) pack

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

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

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

@@ -67,38 +62,40 @@

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

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

@@ -125,15 +122,16 @@

     (values (cons :type type)

             (cons :decompressed-size size))))

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

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

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

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

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

+    (with-pack-streams (idx pack-s) pack

+      (dotimes (i n (reverse result))

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

+          (declare (ignore _ __))

+          (file-position pack-s offset)

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

+                  ,@(multiple-value-list

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

+                  (:offset . ,offset))

+                result))))))

@@ -7,6 +7,11 @@

    #:repository

    #:component))

+(defpackage :fwoar.cl-git.types

+  (:use :cl )

+  (:export

+   #:octet))

+

 (defpackage :cl-git-user

   (:use :cl :fwoar.cl-git))

@@ -20,11 +20,11 @@

               'tree-entry

               (te-name o)

               (te-mode o)

-              (te-hash o))

+              (hash o))

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

         (format s "(~a: ~a)"

                 (te-name o)

-                (subseq (te-hash o) 0 7)))))

+                (subseq (hash o) 0 7)))))

 (defun parse-tree-entry (data)

   (values-list (partition 0 data :with-offset 20)))

@@ -66,4 +66,4 @@

   (te-mode object))

 (defmethod component ((component (eql :ref)) (object tree-entry))

   (ref (repository object)

-       (te-hash object)))

+       (hash object)))

new file mode 100644

@@ -0,0 +1,4 @@

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

+

+(deftype octet ()

+  '(unsigned-byte 8))

@@ -66,7 +66,7 @@

                  'batch-20))

 (defun read-bytes (count format stream)

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

+  (let ((seq (make-array count :element-type 'fwoar.cl-git.types:octet)))

     (read-sequence seq stream)

     (funcall format

              seq)))

@@ -86,6 +86,9 @@

               (list type

                     (parse-integer length))))))

-(defun behead (data)

-  (elt (partition 0 data)

-       1))

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

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

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

+                        bindings)

+              (progn

+                ,@body)))