From 125487be12193539bf9572b699ba8fe8cf395621 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 9 Jan 2024 15:19:20 +0000
Subject: laminar: Allow creation of job contexts.

* guix/forge/laminar.scm (<forge-laminar-configuration>)[contexts]:
New field.
* guix/forge/laminar.scm (<forge-laminar-context>): New record type.
(laminar-contexts): New function.
(forge-laminar-activation): Configure contexts in configuration
directory.
(forge-laminar-service-type): Allow extension with contexts.
---
 guix/forge/laminar.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/guix/forge/laminar.scm b/guix/forge/laminar.scm
index 8819a2f..2ce5872 100644
--- a/guix/forge/laminar.scm
+++ b/guix/forge/laminar.scm
@@ -28,6 +28,7 @@
             forge-laminar-configuration?
             forge-laminar-configuration-state-directory
             forge-laminar-configuration-jobs
+            forge-laminar-configuration-contexts
             forge-laminar-job
             forge-laminar-job?
             this-forge-laminar-job
@@ -35,6 +36,10 @@
             forge-laminar-job-run
             forge-laminar-job-after
             forge-laminar-job-trigger?
+            forge-laminar-context
+            forge-laminar-context?
+            forge-laminar-context-name
+            forge-laminar-context-executors
             forge-laminar-group
             forge-laminar-group?
             forge-laminar-group-name
@@ -47,6 +52,8 @@
                    (default "/var/lib/laminar"))
   (jobs forge-laminar-configuration-jobs
         (default '()))
+  (contexts forge-laminar-configuration-contexts
+            (default '()))
   (groups forge-laminar-configuration-groups
           (default '())))
 
@@ -61,12 +68,33 @@
   (trigger? forge-laminar-job-trigger?
             (default #t)))
 
+(define-record-type* <forge-laminar-context>
+  forge-laminar-context make-forge-laminar-context
+  forge-laminar-context?
+  (name forge-laminar-context-name)
+  (executors forge-laminar-context-executors))
+
 (define-record-type* <forge-laminar-group>
   forge-laminar-group make-forge-laminar-group
   forge-laminar-group?
   (name forge-laminar-group-name)
   (regex forge-laminar-group-regex))
 
+(define (laminar-contexts contexts)
+  "Return a file-like object describing a directory of @var{contexts}, a
+list of @var{<forge-laminar-context>} objects."
+  (file-union "laminar-contexts"
+              (map (lambda (context)
+                     (let ((configuration-file
+                            (string-append (forge-laminar-context-name context)
+                                           ".conf")))
+                       (list configuration-file
+                             (mixed-text-file configuration-file
+                                              "EXECUTORS="
+                                              (number->string (forge-laminar-context-executors context))
+                                              "\n"))))
+                   contexts)))
+
 (define (laminar-groups groups)
   "Return a file-like object describing @var{groups}, a list of
 @code{<forge-laminar-groups>} objects."
@@ -99,6 +127,7 @@ of @var{<forge-laminar-job>} objects."
 (define (forge-laminar-activation config)
   (let* ((state-directory (forge-laminar-configuration-state-directory config))
          (configuration-directory (string-append state-directory "/cfg"))
+         (contexts-directory (string-append configuration-directory "/contexts"))
          (groups-configuration (string-append configuration-directory "/groups.conf"))
          (jobs-directory (string-append configuration-directory "/jobs")))
     (with-imported-modules '((guix build utils))
@@ -107,6 +136,9 @@ of @var{<forge-laminar-job>} objects."
 
           ;; Ensure configuration directory exists.
           (mkdir-p #$configuration-directory)
+          ;; Configure contexts.
+          (switch-symlinks #$contexts-directory
+                           #$(laminar-contexts (forge-laminar-configuration-contexts config)))
           ;; Configure groups.
           (switch-symlinks #$groups-configuration
                            #$(laminar-groups (forge-laminar-configuration-groups config)))
@@ -139,6 +171,8 @@ of @var{<forge-laminar-job>} objects."
               (inherit config)
               (jobs (append (forge-laminar-configuration-jobs config)
                             (filter forge-laminar-job? extended-values)))
+              (contexts (append (forge-laminar-configuration-contexts config)
+                                (filter forge-laminar-context? extended-values)))
               (groups (append (forge-laminar-configuration-groups config)
                               (filter forge-laminar-group? extended-values))))))
    (default-value (forge-laminar-configuration))))
-- 
cgit v1.2.3