@@ -70,30 +70,36 @@

                       (list* (format-tree-entry next)

                              accum)))))

-(defgeneric extract-object-of-type (type s repository)

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

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

+  (:method ((type (eql :commit)) s repository)

+    s)

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

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

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

+    s)

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

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

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

+    s)

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

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

-      (tree-entries data))))

+  (: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 (get-object-type metadata))

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

          (size (get-object-size metadata))

-         (object-data (extract-object-of-type type s repository)))

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

@@ -114,8 +120,12 @@

                      :element-type '(unsigned-byte 8))

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

                                                     s)))

-      (elt (partition 0 result)

-           1))))

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

 (defun extract-object (repo id)

   (if (object repo id)

@@ -17,6 +17,12 @@

   (data-lens.lenses:over *object-data-lens* 'babel:octets-to-string object))

 (defgeneric object (repository id)

+  (:method ((repository string) id)

+    (when (probe-file (merge-pathnames ".git" repository))

+      (object (repository repository) id)))

+  (:method ((repository pathname) id)

+    (when (probe-file (merge-pathnames ".git" repository))

+      (object (repository repository) id)))

   (:method ((repository repository) id)

     (car

      (uiop:directory*

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

 (defclass commit (git-object)

   ())

-(defun object-type->sym (object-type)

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

+  (:method ((o-t symbol))

+    o-t))

+

+(defmethod object-type->sym ((object-type number))

   (ecase object-type

     (1 :commit)

     (2 :tree)

@@ -25,12 +29,20 @@

     (4 :tag)

     (6 :ofs-delta)

     (7 :ref-delta)))

+(defmethod object-type->sym ((object-type string))

+  (string-case:string-case ((string-downcase object-type))

+    ("commit" :commit)

+    ("tree" :tree)

+    ("blob" :blob)

+    ("tag" :tag)

+    ("ofs-delta" :ofs-delta)

+    ("ref-delta" :ref-delta)))

 (defgeneric repository (root)

   (:method ((root string))

-   (fw.lu:new 'repository root))

+    (fw.lu:new 'repository root))

   (:method ((root pathname))

-   (fw.lu:new 'repository root)))

+    (fw.lu:new 'repository root)))

 (defun get-local-branches (root)

   (append (get-local-unpacked-branches root)

@@ -14,18 +14,19 @@

 (defmacro git:git (&rest commands)

   `(uiop:nest ,@(reverse

-                 (mapcar (serapeum:op (case (car _1)

-                                        ((<<=) (list* 'mapcan

-                                                      (list 'quote

-                                                            (intern (symbol-name (cadadr _1))

-                                                                    :git))

-                                                      (cddr _1)))

-                                        ((map) (list* 'mapcar (cdr _1)))

-                                        ((unwrap) `(uiop:nest (car)

-                                                              (mapcar ,@(cdr _1))))

-                                        (t (cons (intern (symbol-name (car _1))

-                                                         :git)

-                                                 (cdr _1)))))

+                 (mapcar (serapeum:op (typecase _1

+                                        (string `(identity ,_1))

+                                        (list (case (car _1)

+                                                ((<<=) (list* 'mapcan

+                                                              (list 'quote

+                                                                    (cadadr _1))

+                                                              (cddr _1)))

+                                                ((map) (list* 'mapcar (cdr _1)))

+                                                ((unwrap) `(uiop:nest (car)

+                                                                      (mapcar ,@(cdr _1))))

+                                                (t (cons (intern (symbol-name (car _1))

+                                                                 :git)

+                                                         (cdr _1)))))))

                          commands))))

 (defun git:show (object)

@@ -4,10 +4,10 @@

   (+ (loop for v across vec

            for sum = (logand 127 v)

              then (+ (ash sum 7)

-                      (logand 127 v))

+                     (logand 127 v))

            finally (return sum))

-      (loop for x from 1 below 2

-            sum (expt 2 (* 7 x)))))

+     (loop for x from 1 below 2

+           sum (expt 2 (* 7 x)))))

 (defun extract-offset-to-base (s)

   (offset-distance