(let
((project (make-project :name name :src src)))
(ensure-directories-exist (project-dir project))
- (git project "clone" src "."))
+ (git project "clone" src ".")
+ (refresh-project project))
t)
-(defun add-job (project-name sha)
- (make-job :project (find project-name *all-project* :key #'project-name :test #'string=) :sha sha)
- t)
+(defun refresh-project (project)
+ (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*")
+ (declare (ignore code err))
+ (when (not success) (error "Failed to get branches"))
+ (let
+ ((branches (find-branch-by-project project)))
+ (mapcar (lambda (branch) (set-branch-in-git branch nil)) branches)
+ (mapcar
+ (lambda (line)
+ (cl-ppcre:register-groups-bind (branch-name sha) ("refs/remotes/origin/(.*) (.*)" line)
+ (let*
+ ((job
+ (or
+ (find sha (find-job-by-project project) :test #'string= :key #'job-sha)
+ (make-job :status :queued :sha sha :project project)))
+ (branch
+ (or
+ (find branch-name branches :test #'string= :key #'branch-name)
+ (make-branch :name branch-name :project project))))
+ (set-branch-in-git branch t)
+ (set-branch-job branch job))))
+ (cl-ppcre:split "\\n" out)))))
+
+(defun delete-project (name)
+ (let
+ ((project (find name *all-project* :test #'string= :key #'project-name)))
+ (when (not project)
+ (error "Project does not exists"))
+ (sb-ext:delete-directory (project-dir project) :recursive t)
+ (mapcar #'nremove-job (find-job-by-project project))
+ (mapcar #'nremove-branch (find-branch-by-project project))
+ (nremove-project project)))