From c51267914d1ad8979554d8e751df7fa5ff42cb3d Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Tue, 20 Dec 2022 21:15:55 +0000 Subject: forge: Refactor extension functions into named functions. * guix/forge/forge.scm (forge-service-type): Refactor lambda functions into ... (forge-ci-jobs, forge-ci-job-groups, forge-ci-jobs-and-groups, forge-cron-jobs, forge-webhooks): ... new functions. --- guix/forge/forge.scm | 114 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 67 insertions(+), 47 deletions(-) (limited to 'guix/forge/forge.scm') diff --git a/guix/forge/forge.scm b/guix/forge/forge.scm index f9ef272..a5445b9 100644 --- a/guix/forge/forge.scm +++ b/guix/forge/forge.scm @@ -252,6 +252,70 @@ clone and does not include the .git directory." (format (current-error-port) "Built ~a successfully~%" derivation-output) derivation-output))))))) +(define (forge-ci-jobs config) + "Return list of CI jobs for forge configuraion @var{config}. Each +value of the returned list is a @code{} object." + (append-map forge-project-ci-jobs + (forge-configuration-projects config))) + +(define (forge-ci-job-groups config) + "Return list of CI job groups for forge configuration +@var{config}. Each element of the returned list is a +@code{} object." + (filter-map (lambda (project) + (match (forge-project-ci-jobs project) + (() #f) + ((job) #f) + (jobs + (forge-laminar-group + (name (forge-project-name project)) + (regex (string-append "^(?:" + (string-join (map forge-laminar-job-name jobs) + "|") + ")$")))))) + (forge-configuration-projects config))) + +(define (forge-ci-jobs-and-groups config) + "Return list of CI jobs and job groups for forge configuration +@var{config}. Each element of the returned list is either a +@code{} or a @code{} object." + (append (forge-ci-jobs config) + (forge-ci-job-groups config))) + +(define (forge-cron-jobs config) + "Return list of cron jobs for forge configuration @var{config}. Each +element of the returned list is a G-expression corresponding to an +mcron job specification." + (filter-map (lambda (project) + (and (eq? (forge-project-ci-jobs-trigger project) + 'cron) + (any forge-laminar-job-trigger? + (forge-project-ci-jobs project)) + #~(job '(next-day) + #$(program-file + (string-append (forge-project-name project) + "-cron-job") + (ci-jobs-trigger-gexp + (forge-project-ci-jobs project) + #:reason "Cron job")) + #:user "laminar"))) + (forge-configuration-projects config))) + +(define (forge-webhooks config) + "Return list of webhooks for forge configuration @var{config}. Return +value is a list of @code{} objects." + (filter-map (lambda (project) + (and (eq? (forge-project-ci-jobs-trigger project) + 'webhook) + (any forge-laminar-job-trigger? + (forge-project-ci-jobs project)) + (webhook-hook + (id (forge-project-name project)) + (run (ci-jobs-trigger-gexp + (forge-project-ci-jobs project) + #:reason "Webhook"))))) + (forge-configuration-projects config))) + (define forge-service-type (service-type (name 'forge) @@ -259,57 +323,13 @@ clone and does not include the .git directory." (extensions (list (service-extension activation-service-type forge-activation) (service-extension forge-laminar-service-type - (lambda (config) - (append - ;; jobs - (append-map forge-project-ci-jobs - (forge-configuration-projects config)) - ;; group jobs by project - (filter-map (lambda (project) - (match (forge-project-ci-jobs project) - (() #f) - ((job) #f) - (jobs - (forge-laminar-group - (name (forge-project-name project)) - (regex (string-append "^(?:" - (string-join (map forge-laminar-job-name jobs) - "|") - ")$")))))) - (forge-configuration-projects config))))) - ;; Set up cron jobs to trigger CI jobs for remote - ;; repositories. + forge-ci-jobs-and-groups) ;; TODO: Run CI job only if there are new commits ;; in the remote repository. (service-extension mcron-service-type - (lambda (config) - (filter-map (lambda (project) - (and (eq? (forge-project-ci-jobs-trigger project) - 'cron) - (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) - #~(job '(next-day) - #$(program-file - (string-append (forge-project-name project) - "-cron-job") - (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) - #:reason "Cron job")) - #:user "laminar"))) - (forge-configuration-projects config)))) + forge-cron-jobs) (service-extension webhook-service-type - (lambda (config) - (filter-map (lambda (project) - (and (eq? (forge-project-ci-jobs-trigger project) - 'webhook) - (any forge-laminar-job-trigger? - (forge-project-ci-jobs project)) - (webhook-hook - (id (forge-project-name project)) - (run (ci-jobs-trigger-gexp - (forge-project-ci-jobs project) - #:reason "Webhook"))))) - (forge-configuration-projects config)))))) + forge-webhooks))) (compose concatenate) (extend (lambda (config projects) (forge-configuration -- cgit v1.2.3