(in-package :fwoar.cl-git)

(defmacro defclass+ (name (&rest super) &body (direct-slots &rest options))
  (let ((initargs (mapcan (lambda (slot)
                            (serapeum:unsplice
                             (make-symbol
                              (symbol-name
                               (getf (cdr slot)
                                     :initarg)))))
                          direct-slots)))
    `(progn (defclass ,name ,super
              ,direct-slots
              ,@options)
            (defun ,name (,@initargs)
              (fw.lu:new ',name ,@initargs)))))

(defclass delta ()
  ((%repository :initarg :repository :reader repository)
   (%base :initarg :base :reader base)
   (%commands :initarg :commands :reader commands)))

(defclass+ ofs-delta (delta)
  ())

(defclass+ ref-delta (delta)
  ())

(defun make-ofs-delta (base commands repository)
  (fw.lu:new 'ofs-delta base commands repository))
(defun make-ref-delta (base commands repository)
  (fw.lu:new 'ofs-delta base commands repository))

(defun int->bit-vector (n)
  (let* ((integer-length (integer-length n))
         (bv-size (* 8 (ceiling integer-length 8)))
         (bv (make-array bv-size :element-type 'bit)))
    (loop :for ix :below integer-length
          :do (setf (aref bv (- bv-size 1 ix))
                    (if (logbitp ix n)
                        1
                        0)))
    bv))

(defun bit-vector->int (bv)
  (let ((bv-size (array-total-size bv)))
    (loop :for ix :from (1- bv-size) :downto 0
          :for n :from 0
          :unless (zerop (aref bv ix))
            :sum (expt 2 n))))

(defun partition-commands (data)
  (let ((idx 0))
    (labels ((advance ()
               (prog1 (elt data idx)
                 (incf idx)))
             (get-command ()
               (let* ((bv (int->bit-vector (elt data idx)))
                      (discriminator (elt bv 0))
                      (insts (subseq bv 1)))
                 (incf idx)
                 (if (= 1 discriminator)
                     (list :copy
                           insts
                           (coerce (loop repeat (count 1 insts) collect (advance))
                                   '(vector (unsigned-byte 8))))
                     (list :add
                           (coerce (loop repeat (1- (bit-vector->int (reverse insts)))
                                         collect (advance))
                                   '(vector (unsigned-byte 8))))))))
      (loop while (< idx (length data))
            collect (get-command)))))

(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from)
  (format t "~&data: ~s~%" s)
  (make-ofs-delta offset-from
                  (partition-commands s)
                  repository))
(defmethod -extract-object-of-type ((type (eql :ref-delta)) s repository &key offset-from)
  (make-ref-delta offset-from
                  (partition-commands s)
                  repository))


#+(or) #+(or) #+(or)

(defmethod component ((component (eql :tree)) (object git-commit))
  (ensure-ref
   (cadr
    (fw.lu:v-assoc :tree (metadata object)
                   :test 'string-equal))))
(defmethod component ((component (eql :parents)) (object git-commit))
  (coerce (remove-if-not (serapeum:op
                           (string= "parent" _))
                         (metadata object)
                         :key #'car)
          'list))
(defmethod component ((component (eql :message)) (object git-commit))
  (data object))