X-Git-Url: https://code.consxy.com/gitweb/?a=blobdiff_plain;f=src%2Fmain%2Fserver.lisp;h=19780e24bed72a0baa095cafef23ef02da654b14;hb=b20fb177f8305dd8739d57c1bd832bd7a98ab25b;hp=409a804417cf3ee0c3521ae58e2a7ce81cb46ec2;hpb=20d2b44038975476f7f84a5aa222ef750c38e76d;p=candle diff --git a/src/main/server.lisp b/src/main/server.lisp index 409a804..19780e2 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -86,6 +86,47 @@ (defun project-job-information (name) (let - ((project (find name *all-project* :test #'string= :key #'project-name))) + ((project (when name (find name *all-project* :test #'string= :key #'project-name)))) + (when (and name (not project)) (error "Project does not exist")) + (mapcar #'job->job-information + (if project + (find-job-by-project project) + *all-job*)))) + +(defun find-job-by-project-and-sha (project-name sha) + (let* + ((project (find project-name *all-project* :test #'string= :key #'project-name)) + (job + (when project + (find-if + (lambda (job-sha) + (and (<= (length sha) (length job-sha)) (string= sha (subseq job-sha 0 (length sha))))) + (find-job-by-project project) + :key #'job-sha)))) (when (not project) (error "Project does not exist")) - (mapcar #'job->job-information (find-job-by-project project)))) + (when (not job) (error "Job does not exist")) + job)) + +(defun get-job-log (project-name sha) + (job-log (find-job-by-project-and-sha project-name sha))) + +(defun retry-job (project-name sha) + (set-job-status (find-job-by-project-and-sha project-name sha) :queued) + (awaken-processor-thread)) + +(defun list-projects () + (mapcar + (lambda (project) + (list + (project-name project) + (project-src project))) + *all-project*)) + +(defun failures (project-name) + (length + (remove-if-not + (lambda (branch) (eql :failed (job-status (branch-job branch)))) + (if project-name + (find-branch-by-project + (find project-name *all-project* :test #'string= :key #'project-name)) + *all-branch*))))