git.fiddlerwoaroof.com
model.lisp
a7c6e622
 (in-package :fwoar.cl-git)
 
 (defparameter *object-data-lens*
   (data-lens.lenses:make-alist-lens :object-data))
 
 (defclass pack ()
   ((%pack :initarg :pack :reader pack-file)
0b3ed859
    (%index :initarg :index :reader index-file)
    (%repository :initarg :repository :reader repository)))
a7c6e622
 
 (defclass repository ()
   ((%root :initarg :root :reader root)))
 
 (defclass git-object ()
   ())
 
077088c8
 (defgeneric object-type->sym (object-type)
   (:method ((o-t symbol))
     o-t))
 
 (defmethod object-type->sym ((object-type number))
a7c6e622
   (ecase object-type
     (1 :commit)
     (2 :tree)
     (3 :blob)
     (4 :tag)
     (6 :ofs-delta)
     (7 :ref-delta)))
4cc1ee49
 
077088c8
 (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)))
a7c6e622
 
0b3ed859
 (defgeneric repository (root)
   (:method ((root string))
077088c8
     (fw.lu:new 'repository root))
0b3ed859
   (:method ((root pathname))
077088c8
     (fw.lu:new 'repository root)))
a7c6e622
 
 (defun get-local-branches (root)
   (append (get-local-unpacked-branches root)
           (get-local-packed-branches root)))
 
 (defun loose-object-path (sha)
   (let ((obj-path (fwoar.string-utils:insert-at 2 #\/ sha)))
     (merge-pathnames obj-path ".git/objects/")))
 
0b3ed859
 (defun pack (index pack repository)
   (fw.lu:new 'pack index pack repository))
a7c6e622
 
 (defun pack-files (repo)
0b3ed859
   (mapcar (serapeum:op
f09f6f1b
             (pack _1
                   (merge-pathnames
                    (make-pathname :type "pack") _1)
                   (repository repo)))
a7c6e622
           (uiop:directory*
            (merge-pathnames ".git/objects/pack/*.idx"
                             repo))))
846489f7
 
 (defgeneric loose-object (repository id)
   (:method ((repository string) id)
     (when (probe-file (merge-pathnames ".git" repository))
       (loose-object (repository repository) id)))
   (:method ((repository pathname) id)
     (when (probe-file (merge-pathnames ".git" repository))
       (loose-object (repository repository) id)))
   (:method ((repository repository) id)
     (car
      (uiop:directory*
       (merge-pathnames (loose-object-path (serapeum:concat id "*"))
                        (root repository))))))
 
 (defun loose-object-p (repository id)
   "Is ID an ID of a loose object?"
   (loose-object repository id))
 
4cc1ee49
 (defclass git-ref ()
   ((%repo :initarg :repo :reader ref-repo)
    (%hash :initarg :hash :reader ref-hash)))
 (defclass loose-ref (git-ref)
   ((%file :initarg :file :reader loose-ref-file)))
 (defclass packed-ref (git-ref)
   ((%pack :initarg :pack :reader packed-ref-pack)
    (%offset :initarg :offset :reader packed-ref-offset)))
 
 (defmethod print-object ((obj git-ref) s)
846489f7
   (print-unreadable-object (obj s :type t)
     (format s "~a of ~a"
4cc1ee49
             (subseq (ref-hash obj) 0 7)
846489f7
             (serapeum:string-replace (namestring (user-homedir-pathname))
4cc1ee49
                                      (root-of (ref-repo obj))
846489f7
                                      "~/"))))