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 | "~/")))) |