git.fiddlerwoaroof.com
commit.lisp
4cc1ee49
 (in-package :fwoar.cl-git)
 
489818ad
 (defclass git-commit (git-object)
   ((%metadata :initarg :metadata :reader metadata)
4cc1ee49
    (%data :initarg :data :reader data)))
 
b7739814
 (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))))
 
744c84b5
 (defmethod print-object ((o git-commit) s)
   (if *print-readably*
       (format s "#.(git-commit ~<~s~_~s~_~s~:>)"
               (list (hash o)
                     (metadata o)
                     (data o)))
       (print-unreadable-object (o s :type t :identity t)
b7739814
         (format s "~a" (format nil "~7,1,1,'x@a" (clamp-string (hash o) 7))))))
4cc1ee49
 
 (defun parse-commit (commit)
   (destructuring-bind (metadata message)
       (partition-subseq #(#\newline #\newline)
                         commit #+(or)(babel:octets-to-string commit :encoding :latin1))
     (values message
             (map 'vector (serapeum:op (partition #\space _))
                  (fwoar.string-utils:split #\newline metadata)))))
 
744c84b5
 (defun make-commit (data hash)
4cc1ee49
   (multiple-value-bind (message metadata)
       (parse-commit data)
744c84b5
     (git-commit hash metadata message)))
 
 (defmethod -extract-object-of-type ((type (eql :commit)) s repository &key hash)
   (make-commit (babel:octets-to-string s :encoding *git-encoding*)
                hash))
4cc1ee49
 
 
 (defmethod component ((component (eql :tree)) (object git-commit))
   (ensure-ref
    (cadr
     (fw.lu:v-assoc :tree (metadata object)
                    :test 'string-equal))))
39d8aa31
 (defmethod component ((component (eql :author)) (object git-commit))
   (second
    (fw.lu:v-assoc :author (metadata object)
                   :test 'string-equal)))
 (defmethod component ((component (eql :committer)) (object git-commit))
   (second
    (fw.lu:v-assoc :committer (metadata object)
                   :test 'string-equal)))
4cc1ee49
 (defmethod component ((component (eql :parents)) (object git-commit))
77a9ad78
   (data-lens.transducers:into '()
                               (data-lens:•
                                (data-lens.transducers:filtering
                                 (data-lens:on (data-lens:== "parent" :test 'equal)
                                               #'car))
                                (data-lens.transducers:mapping #'cadr))
                               (metadata object)))
4cc1ee49
 (defmethod component ((component (eql :message)) (object git-commit))
   (data object))