git.fiddlerwoaroof.com
Browse code

chore: basic initial implementation

Edward authored on 14/04/2021 07:57:47
Showing 2 changed files
git-systems.lisp
History View file @ 166acc5
... ... 
@@ -0,0 +1,80 @@
1 
+(in-package :fwoar.git-systems)
2 
+
3 
+(defmacro new (class &rest initializer-syms)
4 
+  `(make-instance ,class
5 
+                  ,@(mapcan (lambda (_1)
6 
+                              (list (alexandria:make-keyword _1)
7 
+                                    _1))
8 
+                            initializer-syms)))
9 
+
10 
+
11 
+(defclass spec ()
12 
+  ((%name :reader name :initarg :name :initform (error "need a dep name")
13 
+          :documentation "name of directory for specced dependency")))
14 
+
15 
+(defclass git-spec (spec)
16 
+  ((%url :reader url :initarg :url :initform (error "need a git url"))
17 
+   (%ref :reader ref :initarg :ref :initform (error "need a git ref"))))
18 
+(defun git-spec (name url ref)
19 
+  (new 'git-spec name url ref))
20 
+
21 
+(defgeneric ensure-dep (spec base)
22 
+  (:method ((spec git-spec) base)
23 
+    (let ((target-dir (merge-pathnames (make-pathname :directory (list :relative (name spec)))
24 
+                                       base)))
25 
+      (if (probe-file target-dir)
26 
+          (legit:fetch target-dir)
27 
+          (progn (ensure-directories-exist target-dir)
28 
+                 (legit:clone (url spec) target-dir)))
29 
+      (legit:checkout target-dir (ref spec))
30 
+      target-dir)))
31 
+
32 
+(defmacro define-system-dependencies (system &body dep-specs)
33 
+  (flet ((make-dep-spec (spec)
34 
+           (ecase (car spec)
35 
+             (:git `(git-spec ,@(cdr spec))))))
36 
+    `(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
37 
+            (target-dir (asdf:system-relative-pathname ,system "deps/"))
38 
+            (source-registry `(:source-registry :inherit-configuration
39 
+                                                (:tree ,target-dir))))
40 
+       (mapc (lambda (dep)
41 
+               (ensure-dep dep target-dir))
42 
+             deps)
43 
+       source-registry)))
44 
+
45 
+(defmacro define-dir-deps ((&optional (dir *default-pathname-defaults*)) &body dep-specs)
46 
+  (flet ((make-dep-spec (spec)
47 
+           (ecase (car spec)
48 
+             (:git `(git-spec ,@(cdr spec))))))
49 
+    `(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
50 
+            (target-dir (merge-pathnames (make-pathname :directory (list :relative "deps"))
51 
+                                         ,dir))
52 
+            (source-registry `(:source-registry :inherit-configuration
53 
+                                                (:tree ,target-dir))))
54 
+       (mapc (lambda (dep)
55 
+               (ensure-dep dep target-dir))
56 
+             deps)
57 
+       source-registry)))
58 
+
59 
+
60 
+
61 
+(defmacro define-local-projects (&body dep-specs)
62 
+  (flet ((make-dep-spec (spec)
63 
+           (ecase (car spec)
64 
+             (:git `(git-spec ,@(cdr spec))))))
65 
+    `(let* ((deps (list ,@(mapcar #'make-dep-spec dep-specs)))
66 
+            (target-dir (merge-pathnames (make-pathname :directory (list :relative "quicklisp" "local-projects"))
67 
+                                         (user-homedir-pathname))))
68 
+       (mapcar (lambda (dep)
69 
+                 (ensure-dep dep target-dir))
70 
+               deps))))
71 
+
72 
+#+(or)
73 
+(progn
74 
+  ;; sample ussage
75 
+  (defun initialize ()
76 
+    (asdf:initialize-source-registry
77 
+     (define-system-dependencies :git-systems
78 
+       (:git "fwoar-lisputils" "https://github.com/fiddlerwoaroof/fwoar.lisputils.git" "751faf8a933f1a7a023945b544f0f1b563964391")
79 
+       (:git "cl-git" "https://github.com/fiddlerwoaroof/cl-git.git" "master"))))
80 
+  )
package.lisp
History View file @ 166acc5
... ... 
@@ -0,0 +1,13 @@
1 
+(defpackage :fwoar.git-systems.package
2 
+  (:use :cl )
3 
+  (:export ))
4 
+(in-package :fwoar.git-systems.package)
5 
+
6 
+(defpackage :fwoar.git-systems
7 
+  (:use :cl )
8 
+  (:export
9 
+   #:define-local-projects
10 
+   #:define-system-dependencies
11 
+   #:spec
12 
+   #:git-spec
13 
+   #:define-dir-deps))