Merge pull request #1 from ololabs/initial-commit

initial commit

1 files changed, 104 insertions, 0 deletions

diff --git a/lisp/git/git.lisp b/lisp/git/git.lisp
new file mode 100644
index 0000000..403c25e
--- /dev/null
+++ b/lisp/git/git.lisp
@@ -0,0 +1,104 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :snow)
+
+(defun shell-wrapper-as-string (command)
+  (multiple-value-bind (outlist return-code)
+      (org-ckons-core::shell-wrapper command)
+    (values (ppcre:regex-replace-all (format nil "~a" #\Return)
+                                     (org-ckons-core::reduce-to-newline-separated-string outlist)
+                                     (format nil "~a" #\Newline))
+            return-code)))
+
+(defclass git ()
+  ((stdout :initarg :stdout
+           :initform nil
+           :accessor stdout)
+   (pwd :initarg :pwd
+        :initform (sb-ext:posix-getenv "OLO_PROJECT_HOME")
+        :accessor pwd)
+   (exclude-dirs :initarg :exclude-dirs
+                 :initform (getf (getf (queue (get-webapp "snow")) :git) :exclude-dirs)
+                 :accessor exclude-dirs))
+  (:documentation ""))
+
+(defclass git-update (git)
+  ()
+  (:documentation ""))
+
+(defclass git-update-task (git-update)
+  ((remote :initarg :remote
+           :initform nil
+           :accessor remote))
+  (:documentation ""))
+
+(defmethod bg-perform ((git-update git-update))
+  (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t))
+        (all-remotes-command "gh repo list ololabs -L 9999 --no-archived --json sshUrl | jq -M '.[].sshUrl'")
+        (all-locals-command (format nil "cd ~a ; find . -maxdepth 1 -type d" (pwd git-update)))
+        all-remotes
+        all-remote-dirs
+        all-locals)
+    (setf all-remotes (sort (remove-if (lambda (item)
+                                         (or (org-ckons-core::match-it "CDN.git" item)
+                                             (org-ckons-core::match-it "terraform-github-import-playground.git" item)
+                                             (org-ckons-core::match-it "MvvmCross.git" item)))
+                                       (loop for remote in (org-ckons-core::shell-wrapper all-remotes-command)
+                                             collect (ppcre:regex-replace-all "\"" remote "")))
+                            'string<))
+    (setf all-remote-dirs (loop for remote in all-remotes
+                                collect (subseq remote 23 (- (length remote) 4))))
+    (setf all-locals (sort (set-difference (loop for dir in (org-ckons-core::shell-wrapper all-locals-command)
+                                                 when (not (string= dir "."))
+                                                   collect (if (string= "./" (subseq dir 0 2))
+                                                               (subseq dir 2)
+                                                               dir))
+                                           (exclude-dirs git-update)
+                                           :test 'string=)
+                           'string<))
+    (with-output-to-string (stream output)
+      (format stream "~a~%~%" all-remotes)
+      (loop for dir in (set-difference all-remote-dirs all-locals :test 'string=)
+            do (progn
+                 (format stream "Deleting ~a/~a~%" (pwd git-update) dir)
+                 (org-ckons-core::shell-wrapper (format nil "rm -rf ~a/~a~%" (pwd git-update) dir))))
+      (loop for remote in all-remotes
+            do (enqueue *queue-git* (make-instance 'git-update-task
+                                                          :stdout (stdout git-update)
+                                                          :remote remote)))
+      (format stream "~%~%~%"))
+    (with-open-file (stream (stdout git-update) :direction :output :if-exists :append :if-does-not-exist :create)
+      (format stream output))))
+
+(defmethod update-git ((git-update git-update))
+  (enqueue *queue-git* git-update))
+
+(defmethod bg-perform ((git-update-task git-update-task))
+  (let* ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t))
+         (dir (subseq (remote git-update-task) 23 (- (length (remote git-update-task)) 4)))
+         (status-command (format nil "cd ~a/~a ; git status" (pwd git-update-task) dir))
+         (fetch-command (format nil "cd ~a/~a ; git fetch --prune" (pwd git-update-task) dir))
+         (branch-command (format nil "cd ~a/~a ; PAGER=cat git branch | grep -F '*' | awk '{print $2}'" (pwd git-update-task) dir))
+         (clone-command (format nil "cd ~a ; git clone ~a" (pwd git-update-task) (remote git-update-task))))
+    (with-output-to-string (stream output)
+      (if (probe-file (format nil "~a/~a" (pwd git-update-task) dir))
+          (progn
+            (format stream "Checking ~a~%" dir)
+            (multiple-value-bind (stdout return-code)
+                (shell-wrapper-as-string status-command)
+              (format stream "~a~%" stdout)
+              (when (= return-code 0)
+                (format stream (shell-wrapper-as-string fetch-command))
+                (let ((branch (string-trim '(#\Space #\Tab #\Newline) (shell-wrapper-as-string branch-command))))
+                  (if (position branch '("main" "develop" "master") :test 'string=)
+                      (progn
+                        (format stream "Updating repo ~a on branch ~a~%" dir branch)
+                        (format stream (shell-wrapper-as-string (format nil "cd ~a/~a ; git pull origin ~a" (pwd git-update-task) dir branch))))
+                      (format stream "~a not pulled because it is on branch ~a~%" dir branch))))))
+          (progn
+            (format stream "Cloning ~a~%" dir)
+            (format stream (shell-wrapper-as-string clone-command))))
+      (format stream "~%~%~%"))
+    (with-open-file (stream (stdout git-update-task) :direction :output :if-exists :append :if-does-not-exist :create)
+      (format stream output))))