Plaster
New
List
Login
common-lisp
default
shinmera
2023.09.21 11:53:01
#| sbcl --noinform --load "$0" --eval "(main)" --quit; exit |# (ql:quickload '(legit lparallel) :silent T) (setf lparallel:*kernel* (lparallel:make-kernel 8)) (defvar *terminal* (and (uiop:getenv "TERM") (string/= "" (uiop:getenv "TERM")) (string/= "dumb" (uiop:getenv "TERM")))) (defun spawn-task (tasks channel function &rest args) (let ((i (length tasks))) (vector-push-extend :waiting tasks) (flet ((thunk () (setf (aref tasks i) :running) (handler-case (setf (aref tasks i) (apply function args)) (error () (setf (aref tasks i) :failed))) (list* i args))) (lparallel:submit-task channel #'thunk)))) (defun spinner (&key (offset 0) (charset "░▒▓▒")) (aref charset (mod (+ offset (floor (* 10 (get-internal-real-time)) INTERNAL-TIME-UNITS-PER-SECOND)) (length charset)))) (defun report-tasks (tasks &optional (stream *standard-output*)) (flet ((f (text color) (if *terminal* (format stream "~c[38;5;~dm~a~c[0m" (code-char #x1B) color text (code-char #x1B)) (format stream "~a" text)))) (when (< 0 (length tasks)) (loop with complete = T with lines = 1 for state across tasks for i from 0 do (case state (:running (f (spinner :offset i) 8) (setf complete NIL)) (:waiting (f "┈" 39) (setf complete NIL)) (:failed (f "█" 196)) (T (f "█" 46))) (when (and (< 0 i) (= 0 (mod i 40))) (terpri stream) (incf lines)) finally (progn (when (and *terminal* (not complete)) (format stream "~c[~dA" (code-char #x1B) (1- lines)) (format stream "~c[0G" (code-char #x1B))) (finish-output stream) (return complete)))))) (defun update-repo (path) (let ((legit:*git-output* NIL)) (legit:pull (make-instance 'legit:repository :location path)) path)) (defun spawn-updates (tasks channel root) (dolist (path (uiop:subdirectories root) tasks) (unless (string= ".git" (car (last (pathname-directory path)))) (when (probe-file (merge-pathnames ".git/" path)) (spawn-task tasks channel #'update-repo path)) (spawn-updates tasks channel path)))) (defun update-all (root &optional (stream *standard-output*)) (let* ((channel (lparallel:make-channel)) (tasks (make-array 0 :adjustable T :fill-pointer T)) succeeded failed) (bt:make-thread (lambda () (spawn-updates tasks channel root))) (with-simple-restart (abort "Stop waiting for threads and quit.") (loop until (report-tasks tasks stream) do (sleep 0.1)) (loop repeat (length tasks) for (i path) = (lparallel:receive-result channel) for status = (aref tasks i) do (case status (:failed (push path failed)) (T (push path succeeded))))) (values succeeded failed))) (defun main (&optional (root (uiop:getcwd))) (format T "Searching for and updating repositories...~%~%") (multiple-value-bind (succeeded failed) (update-all root) (format T "~&~% >> ~d projects successfully updated, ~d projects failed" (length succeeded) (length failed)) (format T "~& >> Failed projects: ~&~a~%" (sort (map 'list #'namestring failed) #'string<))))
Raw
Annotate
Repaste