166acc54 |
(in-package :fwoar.git-systems)
(defmacro new (class &rest initializer-syms)
`(make-instance ,class
,@(mapcan (lambda (_1)
(list (alexandria:make-keyword _1)
_1))
initializer-syms)))
(defclass spec ()
((%name :reader name :initarg :name :initform (error "need a dep name")
:documentation "name of directory for specced dependency")))
(defclass git-spec (spec)
((%url :reader url :initarg :url :initform (error "need a git url"))
(%ref :reader ref :initarg :ref :initform (error "need a git ref"))))
(defun git-spec (name url ref)
(new 'git-spec name url ref))
(defgeneric ensure-dep (spec base)
(:method ((spec git-spec) base)
(let ((target-dir (merge-pathnames (make-pathname :directory (list :relative (name spec)))
base)))
(if (probe-file target-dir)
(legit:fetch target-dir)
(progn (ensure-directories-exist target-dir)
(legit:clone (url spec) target-dir)))
(legit:checkout target-dir (ref spec))
target-dir)))
(defmacro define-system-dependencies (system &body dep-specs)
(flet ((make-dep-spec (spec)
(ecase (car spec)
(:git `(git-spec ,@(cdr spec))))))
`(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
(target-dir (asdf:system-relative-pathname ,system "deps/"))
(source-registry `(:source-registry :inherit-configuration
(:tree ,target-dir))))
(mapc (lambda (dep)
(ensure-dep dep target-dir))
deps)
source-registry)))
(defmacro define-dir-deps ((&optional (dir *default-pathname-defaults*)) &body dep-specs)
(flet ((make-dep-spec (spec)
(ecase (car spec)
(:git `(git-spec ,@(cdr spec))))))
`(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
(target-dir (merge-pathnames (make-pathname :directory (list :relative "deps"))
,dir))
(source-registry `(:source-registry :inherit-configuration
(:tree ,target-dir))))
(mapc (lambda (dep)
(ensure-dep dep target-dir))
deps)
source-registry)))
(defmacro define-local-projects (&body dep-specs)
(flet ((make-dep-spec (spec)
(ecase (car spec)
(:git `(git-spec ,@(cdr spec))))))
`(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
(target-dir (merge-pathnames (make-pathname :directory (list :relative "quicklisp" "local-projects"))
(user-homedir-pathname))))
(mapcar (lambda (dep)
(ensure-dep dep target-dir))
deps))))
#+(or)
(progn
;; sample ussage
(defun initialize ()
(asdf:initialize-source-registry
(define-system-dependencies :git-systems
(:git "fwoar-lisputils" "https://github.com/fiddlerwoaroof/fwoar.lisputils.git" "751faf8a933f1a7a023945b544f0f1b563964391")
(:git "cl-git" "https://github.com/fiddlerwoaroof/cl-git.git" "master"))))
)
|