X-Git-Url: https://code.consxy.com/gitweb/?a=blobdiff_plain;f=src%2Fmain%2Fserver.lisp;h=f086aa24242e4d55f6036c2e8cd08d9b2c94001b;hb=09ef79e902dcf475d6cd9dc34bc74a46b39150c3;hp=ffd6e82ce1749f66093a62a210bce636b68f7ab5;hpb=92a8cc8928e1f5d6aa13708b35cb4551aa736a37;p=candle diff --git a/src/main/server.lisp b/src/main/server.lisp index ffd6e82..f086aa2 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -47,13 +47,13 @@ (defun add-project (name src) (when (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name)) - (error "Name contains invalid characters")) + (raise-candle-error :invalid-project-name)) (when (not (git nil "ls-remote" src)) - (error "Project uri is not a valid git repository")) + (raise-candle-error :invalid-project-uri)) (when (find name *all-project* :test #'string= :key #'project-name) - (error "Project name already taken")) + (raise-candle-error :project-name-taken)) (let ((project (make-project :name name :src src))) (ensure-directories-exist (project-dir project)) @@ -68,7 +68,7 @@ (git project "fetch" "origin" "--prune") (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")) + (when (not success) (raise-candle-error :project-failed-to-get-branches)) (mapcar (lambda (branch) (set-branch-in-git branch nil)) branches) (mapcar (lambda (line) @@ -90,7 +90,7 @@ (defun delete-project (name) (let ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (error "Project does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) (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)) @@ -102,7 +102,7 @@ (defun project-branch-information (name) (let ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (error "Project does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) (mapcar (lambda (branch) (list @@ -113,7 +113,7 @@ (defun project-job-information (name) (let ((project (when name (find name *all-project* :test #'string= :key #'project-name)))) - (when (and name (not project)) (error "Project does not exist")) + (when (and name (not project)) (raise-candle-error :project-does-not-exist)) (mapcar #'job->job-information (if project (find-job-by-project project) @@ -129,8 +129,8 @@ (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")) - (when (not job) (error "Job does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) + (when (not job) (raise-candle-error :job-does-not-exist)) job)) (defun get-job-log (project-name sha) @@ -149,10 +149,10 @@ *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*)))) + (let + ((project (when project-name (find project-name *all-project* :test #'string= :key #'project-name)))) + (when (and project-name (not project)) (raise-candle-error :project-does-not-exist)) + (length + (remove-if-not + (lambda (branch) (eql :failed (job-status (branch-job branch)))) + (if project (find-branch-by-project project) *all-branch*)))))