about summary refs log tree commit diff
diff options
context:
space:
mode:
authorArun Isaac2022-02-25 13:45:58 +0530
committerArun Isaac2022-02-28 17:41:09 +0530
commitcea51c4e6a70d60847c6e917af0199e564189e5d (patch)
treecfa45f02695f1090988bb525398db32142d302e5
parent3b3ef7a29ae60ca71f9dbd36f9d0c1236d05ce69 (diff)
downloadguix-forge-cea51c4e6a70d60847c6e917af0199e564189e5d.tar.gz
guix-forge-cea51c4e6a70d60847c6e917af0199e564189e5d.tar.lz
guix-forge-cea51c4e6a70d60847c6e917af0199e564189e5d.zip
forge: Deprecate <forge-derivation-job>.
* forge/forge.scm (<forge-derivation-job>): Delete record type.
(<forge-configuration>)[guix-daemon-uri]: Delete field.
(forge-project-configuration-laminar-jobs): Delete function.
(forge-activation, forge-service-type): Use
forge-project-configuration-ci-jobs instead of
forge-project-configuration-laminar-jobs.
(gexp-producer->job-script): Delete function.
-rw-r--r--forge/forge.scm92
1 files changed, 5 insertions, 87 deletions
diff --git a/forge/forge.scm b/forge/forge.scm
index 9790ed6..38976a4 100644
--- a/forge/forge.scm
+++ b/forge/forge.scm
@@ -39,7 +39,6 @@
   #:export (forge-service-type
             forge-configuration
             forge-configuration?
-            forge-configuration-guix-daemon-uri
             forge-configuration-projects
             forge-project-configuration
             forge-project-configuration?
@@ -51,11 +50,6 @@
             forge-project-configuration-website-directory
             forge-project-configuration-ci-jobs
             forge-project-configuration-ci-jobs-trigger
-            forge-derivation-job
-            forge-derivation-job?
-            forge-derivation-job-name
-            forge-derivation-job-run
-            forge-derivation-job-after
             gexp-producer->derivation-output))
 
 (define-record-type* <forge-project-configuration>
@@ -86,45 +80,12 @@
                              (else 'cron)))
                    (thunked)))
 
-(define-record-type* <forge-derivation-job>
-  forge-derivation-job make-forge-derivation-job
-  forge-derivation-job?
-  (name forge-derivation-job-name)
-  (run forge-derivation-job-run)
-  (after forge-derivation-job-after
-         (default #f)))
-
 (define-record-type* <forge-configuration>
   forge-configuration make-forge-configuration
   forge-configuration?
-  (guix-daemon-uri forge-configuration-guix-daemon-uri
-                   (default (%daemon-socket-uri)))
   (projects forge-configuration-projects
             (default '())))
 
-(define (forge-project-configuration-laminar-jobs project config)
-  "Return CI jobs of PROJECT as a list of <forge-laminar-job>
-objects. PROJECT is a <forge-project-configuration> object that is
-part of CONFIG, a <forge-configuration> object. If PROJECT has jobs
-described by <forge-derivation-job> objects, transform them to
-<forge-laminar-job> objects."
-  (map (lambda (job)
-         (if (forge-derivation-job? job)
-             (forge-laminar-job
-              (name (forge-derivation-job-name job))
-              (run (gexp-producer->job-script
-                    (forge-project-configuration-repository project)
-                    (forge-project-configuration-repository-branch project)
-                    (forge-derivation-job-run job)
-                    #:git-checkout-name (string-append (forge-project-configuration-name project)
-                                                       "-checkout")
-                    #:derivation-name (string-append (forge-derivation-job-name job)
-                                                     "-derivation")
-                    #:guix-daemon-uri (forge-configuration-guix-daemon-uri config)))
-              (after (forge-derivation-job-after job)))
-             job))
-       (forge-project-configuration-ci-jobs project)))
-
 (define* (ci-jobs-trigger-gexp ci-jobs #:key reason)
   "Return a G-expression that triggers CI-JOBS. CI-JOBS is a list of
 <forge-laminar-job> objects."
@@ -150,7 +111,7 @@ described by <forge-derivation-job> objects, transform them to
                       (program-file
                        (forge-project-configuration-name project)
                        (ci-jobs-trigger-gexp
-                        (forge-project-configuration-laminar-jobs project config)
+                        (forge-project-configuration-ci-jobs project)
                         #:reason "post-receive hook"))
                       (forge-project-configuration-ci-jobs-trigger project)))
               (forge-configuration-projects config))))
@@ -196,49 +157,6 @@ described by <forge-derivation-job> objects, transform them to
     (('forge _ ...) #t)
     (name (guix-module-name? name))))
 
-(define* (gexp-producer->job-script git-repository git-branch gexp-producer
-                                    #:key git-checkout-name derivation-name guix-daemon-uri)
-  "Return a G-expression describing a laminar job script.
-GEXP-PRODUCER is a G-expression that expands to a lambda function.
-The lambda function takes one argument---the latest git checkout of
-GIT-REPOSITORY at GIT-BRANCH---and returns a G-expression describing a
-derivation to run."
-  (with-imported-modules (source-module-closure '((forge build git)
-                                                  (guix gexp)
-                                                  (guix profiles))
-                                                #:select? import-module?)
-    (with-extensions (list guile-gcrypt guile-zlib)
-      (with-packages (list git-minimal nss-certs)
-        #~(begin
-            (use-modules (forge build git)
-                         (guix derivations)
-                         (guix gexp)
-                         (guix monads)
-                         (guix store)
-                         (rnrs exceptions))
-
-            (parameterize ((%daemon-socket-uri #$guix-daemon-uri))
-              (with-store store
-                (guard (condition ((store-protocol-error? condition)
-                                   (exit #f)))
-                  (format (current-error-port)
-                          "Built ~a successfully~%"
-                          (run-with-store store
-                            (mlet* %store-monad ((git-checkout (latest-git-checkout #$git-checkout-name
-                                                                                    #$git-repository
-                                                                                    #$git-branch
-                                                                                    #:show-commit? #t))
-                                                 (tests-drv (gexp->derivation #$derivation-name
-                                                              (#$gexp-producer git-checkout)
-                                                              #:guile-for-build (read-derivation-from-file
-                                                                                 #$(raw-derivation-file
-                                                                                    (with-store store
-                                                                                      (package-derivation store guile-3.0))))
-                                                              #:substitutable? #f)))
-                              (mbegin %store-monad
-                                (built-derivations (list tests-drv))
-                                (return (derivation->output-path tests-drv))))))))))))))
-
 (define* (gexp-producer->derivation-output project job gexp-producer
                                            #:key (guix-daemon-uri (%daemon-socket-uri)))
   "Return a G-expression that builds another G-expression as a
@@ -301,11 +219,11 @@ endpoint."
                                         (lambda (config)
                                           (append
                                            ;; jobs
-                                           (append-map (cut forge-project-configuration-laminar-jobs <> config)
+                                           (append-map forge-project-configuration-ci-jobs
                                                        (forge-configuration-projects config))
                                            ;; group jobs by project
                                            (filter-map (lambda (project)
-                                                         (match (forge-project-configuration-laminar-jobs project config)
+                                                         (match (forge-project-configuration-ci-jobs project)
                                                            (() #f)
                                                            ((job) #f)
                                                            (jobs
@@ -329,7 +247,7 @@ endpoint."
                                                                     #$(program-file
                                                                        (forge-project-configuration-name project)
                                                                        (ci-jobs-trigger-gexp
-                                                                        (forge-project-configuration-laminar-jobs project config)
+                                                                        (forge-project-configuration-ci-jobs project)
                                                                         #:reason "Cron job"))
                                                                     #:user "laminar")))
                                                       (forge-configuration-projects config))))
@@ -341,7 +259,7 @@ endpoint."
                                                              (webhook-hook
                                                               (id (forge-project-configuration-name project))
                                                               (run (ci-jobs-trigger-gexp
-                                                                    (forge-project-configuration-laminar-jobs project config)
+                                                                    (forge-project-configuration-ci-jobs project)
                                                                     #:reason "Webhook")))))
                                                       (forge-configuration-projects config))))))
    (compose concatenate)