git.fiddlerwoaroof.com
Raw Blame History
(in-package :fwoar.cl-git)

(defclass git-tree (git-object)
  ((%entries :initarg :entries :reader entries)))

(defun git-tree (entries)
  (fw.lu:new 'git-tree entries))

(defclass tree-entry (git-object)
  ((%repo :initarg :repo :reader repository)
   (%mode :initarg :mode :reader te-mode)
   (%name :initarg :name :reader te-name)))

(defun tree-entry (repo name mode hash)
  (fw.lu:new 'tree-entry repo name mode hash))

(defmethod print-object ((o tree-entry) s)
  (if *print-readably*
      (format s "#.(~s ~s ~s ~s)"
              'tree-entry
              (te-name o)
              (te-mode o)
              (hash o))
      (print-unreadable-object (o s :type t :identity t)
        (format s "(~a: ~a)"
                (te-name o)
                (subseq (hash o) 0 8)))))

(defun parse-tree-entry (data)
  (values-list (partition 0 data :with-offset 20)))

(defun format-tree-entry (repo entry)
  (destructuring-bind (info sha) (partition 0 entry)
    (destructuring-bind (mode name)
        (partition #\space
                   (babel:octets-to-string info :encoding *git-encoding*))
      (tree-entry repo name mode (elt (->sha-string sha) 0)))))

(defun tree-entries (repo data &optional accum)
  (if (<= (length data) 0)
      (nreverse accum)
      (multiple-value-bind (next rest) (parse-tree-entry data)
        (tree-entries repo
                      rest
                      (list* (format-tree-entry repo next)
                             accum)))))

(defmethod -extract-object-of-type ((type (eql :tree)) s repository &key)
  (git-tree (tree-entries repository s)))

(defmethod component ((component (eql :entries)) (object git-tree))
  (entries object))
(defmethod component ((component string) (object git-tree))
  (car (remove component (entries object)
               :test-not #'equal
               :key 'te-name)))
(defmethod component ((component pathname) (object git-tree))
  (remove-if-not (lambda (it)
                   (pathname-match-p it component))
                 (entries object)
                 :key 'te-name))

(defmethod component ((component (eql :name)) (object tree-entry))
  (te-name object))
(defmethod component ((component (eql :mode)) (object tree-entry))
  (te-mode object))
(defmethod component ((component (eql :ref)) (object tree-entry))
  (ref (repository object)
       (hash object)))