git.fiddlerwoaroof.com
git-systems.lisp
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"))))
   )