Move channel modules into subdirectory.

We don't want the scm files in doc to be picked up on `guix pull'.

* .guix-channel: New file.
* forge: Move to guix/forge.

1 files changed, 0 insertions, 287 deletions

diff --git a/forge/forge.scm b/forge/forge.scm
deleted file mode 100644
index e88edb0..0000000
--- a/forge/forge.scm
+++ /dev/null
@@ -1,287 +0,0 @@
-;;; guix-forge --- Guix software forge meta-service
-;;; Copyright © 2021, 2022 Arun Isaac <arunisaac@systemreboot.net>
-;;;
-;;; This file is part of guix-forge.
-;;;
-;;; guix-forge is free software: you can redistribute it and/or modify
-;;; it under the terms of the GNU General Public License as published
-;;; by the Free Software Foundation, either version 3 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; guix-forge is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with guix-forge.  If not, see
-;;; <https://www.gnu.org/licenses/>.
-
-(define-module (forge forge)
-  #:use-module (gnu)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 match)
-  #:use-module ((gnu packages certs) #:select (nss-certs))
-  #:use-module (gnu packages ci)
-  #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
-  #:use-module ((gnu packages guile) #:select (guile-3.0 guile-zlib))
-  #:use-module ((gnu packages version-control) #:select (git-minimal))
-  #:use-module (gnu services mcron)
-  #:use-module (guix modules)
-  #:use-module (guix packages)
-  #:use-module (guix records)
-  #:use-module (guix store)
-  #:use-module (forge laminar)
-  #:use-module (forge utils)
-  #:use-module (forge webhook)
-  #:export (forge-service-type
-            forge-configuration
-            forge-configuration?
-            forge-configuration-projects
-            forge-project
-            forge-project?
-            this-forge-project
-            forge-project-name
-            forge-project-user
-            forge-project-repository
-            forge-project-repository-branch
-            forge-project-website-directory
-            forge-project-ci-jobs
-            forge-project-ci-jobs-trigger
-            derivation-job-gexp))
-
-(define-record-type* <forge-project>
-  forge-project make-forge-project
-  forge-project?
-  this-forge-project
-  (name forge-project-name)
-  ;; The user field is optional because the repository may be remote
-  ;; and not need to be owned by any user.
-  (user forge-project-user
-        (default #f))
-  (repository forge-project-repository)
-  (repository-branch forge-project-repository-branch
-                     (default "main"))
-  (description forge-project-description
-               (default #f))
-  (website-directory forge-project-website-directory
-                     (default #f))
-  (ci-jobs forge-project-ci-jobs
-           (default '()) (thunked))
-  (ci-jobs-trigger forge-project-ci-jobs-trigger ; one of 'post-receive-hook, 'cron, 'webhook
-                   (default (cond
-                             ;; 'post-receive-hook for local repositories
-                             ((string-prefix? "/" (forge-project-repository this-forge-project))
-                              'post-receive-hook)
-                             ;; 'cron for remote repositories
-                             (else 'cron)))
-                   (thunked)))
-
-(define-record-type* <forge-configuration>
-  forge-configuration make-forge-configuration
-  forge-configuration?
-  (projects forge-configuration-projects
-            (default '())))
-
-(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."
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
-        ;; TODO: Only trigger on updates to the main/master branch.
-        (display "Triggering continuous integration jobs..." (current-error-port))
-        (newline (current-error-port))
-        (when #$reason
-          (setenv "LAMINAR_REASON" #$reason))
-        (apply invoke
-               #$(file-append laminar "/bin/laminarc")
-               "queue" '#$(map forge-laminar-job-name ci-jobs)))))
-
-(define (forge-activation config)
-  (let ((projects
-         (map (lambda (project)
-                (list (forge-project-user project)
-                      (forge-project-repository project)
-                      (forge-project-description project)
-                      (forge-project-website-directory project)
-                      (program-file
-                       (forge-project-name project)
-                       (ci-jobs-trigger-gexp
-                        (forge-project-ci-jobs project)
-                        #:reason "post-receive hook"))
-                      (forge-project-ci-jobs-trigger project)))
-              (forge-configuration-projects config))))
-    #~(begin
-        (use-modules (rnrs io ports)
-                     (srfi srfi-26)
-                     (ice-9 match))
-        
-        (define (find-regular-files dir)
-          (find-files dir (lambda (file stat)
-                            (memq (stat:type stat)
-                                  '(regular directory)))
-                      #:directories? #t))
-        
-        (for-each (match-lambda
-                    ((username repository description website-directory ci-jobs-trigger ci-jobs-trigger-type)
-                     ;; For local repositories only
-                     (when (string-prefix? "/" repository)
-                       ;; Set description.
-                       (when description
-                         (call-with-output-file (string-append repository "/description")
-                           (cut put-string <> description)))
-                       ;; Set ownership of repository files.
-                       (for-each (lambda (file)
-                                   (let ((user (getpw username)))
-                                     (chown file (passwd:uid user) (passwd:gid user))))
-                                 (append (find-regular-files repository))))
-                     ;; Install post receive hook.
-                     (when (eq? ci-jobs-trigger-type 'post-receive-hook)
-                       (let ((hook-link (string-append repository "/hooks/post-receive")))
-                         (when (file-exists? hook-link)
-                           (delete-file hook-link))
-                         (symlink ci-jobs-trigger hook-link)))
-                     ;; Set ownership of website directory.
-                     (when website-directory
-                       (let ((user (getpw "laminar")))
-                         (chown website-directory (passwd:uid user) (passwd:gid user))))))
-                  '#$projects))))
-
-(define (import-module? name)
-  "Return #t if module NAME may be imported.  Else, return #f."
-  (match name
-    (('forge _ ...) #t)
-    (name (guix-module-name? name))))
-
-(define* (derivation-job-gexp project job gexp-producer
-                              #:key (guix-daemon-uri (%daemon-socket-uri)))
-  "Return a G-expression that builds another G-expression as a
-derivation and returns its output path. GEXP-PRODUCER is a
-G-expression that expands to a lambda function. The lambda function
-takes one argument---the latest git checkout of PROJECT, a
-<forge-project> object---and returns a G-expression describing a
-derivation to run. JOB is a <forge-laminar-job> object representing
-the job that this derivation will be part of. GUIX_DAEMON_URI is a
-file name or URI designating the Guix daemon endpoint."
-  (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
-            ;; We pull out macros using module-ref and functions using
-            ;; @@ instead of using use-modules because this gexp might
-            ;; be substituted into other gexps and use-modules only
-            ;; works at the top-level.
-            (let-syntax ((guard (macro-transformer
-                                 (module-ref (resolve-module '(rnrs exceptions))
-                                             'guard)))
-                         (mbegin (macro-transformer
-                                  (module-ref (resolve-module '(guix monads))
-                                              'mbegin)))
-                         (mlet* (macro-transformer
-                                 (module-ref (resolve-module '(guix monads))
-                                             'mlet*)))
-                         (with-store (macro-transformer
-                                      (module-ref (resolve-module '(guix store))
-                                                  'with-store)))
-                         (return (identifier-syntax ((@@ (guix store) %store-monad)
-                                                     %return))))
-              (let* ((latest-git-checkout (@@ (forge build git) latest-git-checkout))
-                     (built-derivations (@@ (guix derivations) built-derivations))
-                     (derivation->output-path (@@ (guix derivations) derivation->output-path))
-                     (read-derivation-from-file (@@ (guix derivations) read-derivation-from-file))
-                     (gexp->derivation (@@ (guix gexp) gexp->derivation))
-                     (%daemon-socket-uri (@@ (guix store) %daemon-socket-uri))
-                     (%store-monad (@@ (guix store) %store-monad))
-                     (store-protocol-error? (@@ (guix store) store-protocol-error?))
-                     (run-with-store (@@ (guix store) run-with-store))
-                     (derivation-output
-                      (parameterize ((%daemon-socket-uri #$guix-daemon-uri))
-                        (with-store store
-                          (guard (condition ((store-protocol-error? condition)
-                                             (exit #f)))
-                            (run-with-store store
-                              (mlet* %store-monad ((git-checkout (latest-git-checkout
-                                                                  #$(string-append (forge-project-name project)
-                                                                                   "-checkout")
-                                                                  #$(forge-project-repository project)
-                                                                  #:show-commit? #t))
-                                                   (drv (gexp->derivation #$(string-append
-                                                                             (forge-laminar-job-name job)
-                                                                             "-derivation")
-                                                          (#$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 drv))
-                                  (return (derivation->output-path drv))))))))))
-                (format (current-error-port) "Built ~a successfully~%" derivation-output)
-                derivation-output)))))))
-
-(define forge-service-type
-  (service-type
-   (name 'forge)
-   (description "Run guix-forge.")
-   (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.
-                     ;; 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)
-                                                             #~(job '(next-day)
-                                                                    #$(program-file
-                                                                       (forge-project-name project)
-                                                                       (ci-jobs-trigger-gexp
-                                                                        (forge-project-ci-jobs project)
-                                                                        #:reason "Cron job"))
-                                                                    #:user "laminar")))
-                                                      (forge-configuration-projects config))))
-                     (service-extension webhook-service-type
-                                        (lambda (config)
-                                          (filter-map (lambda (project)
-                                                        (and (eq? (forge-project-ci-jobs-trigger project)
-                                                                  'webhook)
-                                                             (webhook-hook
-                                                              (id (forge-project-name project))
-                                                              (run (ci-jobs-trigger-gexp
-                                                                    (forge-project-ci-jobs project)
-                                                                    #:reason "Webhook")))))
-                                                      (forge-configuration-projects config))))))
-   (compose concatenate)
-   (extend (lambda (config projects)
-             (forge-configuration
-              (inherit config)
-              (projects (append (forge-configuration-projects config)
-                                projects)))))
-   (default-value (forge-configuration))))