;;; guix-forge --- Guix software forge meta-service
;;; Copyright © 2021–2022, 2024 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 laminar)
  #:use-module (gnu)
  #:use-module (srfi srfi-1)
  #:use-module (gnu packages ci)
  #:use-module (gnu services ci)
  #:use-module (guix records)
  #:export (forge-laminar-service-type
            forge-laminar-configuration
            forge-laminar-configuration?
            forge-laminar-configuration-state-directory
            forge-laminar-configuration-jobs
            forge-laminar-job
            forge-laminar-job?
            this-forge-laminar-job
            forge-laminar-job-name
            forge-laminar-job-run
            forge-laminar-job-after
            forge-laminar-job-trigger?
            forge-laminar-group
            forge-laminar-group?
            forge-laminar-group-name
            forge-laminar-group-regex))

(define-record-type* <forge-laminar-configuration>
  forge-laminar-configuration make-forge-laminar-configuration
  forge-laminar-configuration?
  (state-directory forge-laminar-configuration-state-directory
                   (default "/var/lib/laminar"))
  (jobs forge-laminar-configuration-jobs
        (default '()))
  (groups forge-laminar-configuration-groups
          (default '())))

(define-record-type* <forge-laminar-job>
  forge-laminar-job make-forge-laminar-job
  forge-laminar-job?
  this-forge-laminar-job
  (name forge-laminar-job-name)
  (run forge-laminar-job-run (thunked))
  (after forge-laminar-job-after
         (default #f))
  (trigger? forge-laminar-job-trigger?
            (default #t)))

(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-groups groups)
  "Return a file-like object describing @var{groups}, a list of
@code{<forge-laminar-groups>} objects."
  (plain-file "laminar-groups"
              (string-join (map (lambda (group)
                                  (string-append (forge-laminar-group-name group)
                                                 "="
                                                 (forge-laminar-group-regex group)))
                                groups)
                           "\n")))

(define (laminar-jobs jobs)
  "Return a file-like object describing a directory of @var{jobs}, a list
of @var{<forge-laminar-job>} objects."
  (file-union "laminar-jobs"
              (append-map (lambda (job)
                            (let ((name (forge-laminar-job-name job))
                                  (run (forge-laminar-job-run job))
                                  (after (forge-laminar-job-after job)))
                              (cons (let ((run-name (string-append name ".run")))
                                      (list run-name
                                            (program-file run-name run)))
                                    (if after
                                        (list (let ((after-name (string-append name ".after")))
                                                (list after-name
                                                      (program-file after-name after))))
                                        (list)))))
                          jobs)))

(define (forge-laminar-activation config)
  (let* ((state-directory (forge-laminar-configuration-state-directory config))
         (configuration-directory (string-append state-directory "/cfg"))
         (groups-configuration (string-append configuration-directory "/groups.conf"))
         (jobs-directory (string-append configuration-directory "/jobs")))
    #~(begin
        (use-modules (srfi srfi-26))

        ;; Ensure configuration directory exists.
        (mkdir-p #$configuration-directory)
        ;; Configure groups.
        (when (file-exists? #$groups-configuration)
          (delete-file #$groups-configuration))
        (symlink #$(laminar-groups (forge-laminar-configuration-groups config))
                 #$groups-configuration)
        ;; Create jobs directory and populate with job scripts.
        (mkdir-p #$(dirname jobs-directory))
        (when (file-exists? #$jobs-directory)
          (delete-file #$jobs-directory))
        (symlink #$(laminar-jobs (forge-laminar-configuration-jobs config))
                 #$jobs-directory)
        ;; Set permissions for laminar directory.
        (for-each (lambda (file)
                    (let ((user (getpw "laminar")))
                      (chown file (passwd:uid user) (passwd:gid user))))
                  (find-files #$state-directory
                              (lambda (file stat)
                                (memq (stat:type stat)
                                      '(regular directory)))
                              #:directories? #t)))))

(define forge-laminar-service-type
  (service-type
   (name 'forge-laminar)
   (description "Run forge-laminar.")
   (extensions (list (service-extension activation-service-type
                                        forge-laminar-activation)
                     ;; Extend the laminar service with a dummy value,
                     ;; thus requiring it.
                     (service-extension laminar-service-type
                                        (const #t))))
   (compose concatenate)
   (extend (lambda (config extended-values)
             (forge-laminar-configuration
              (inherit config)
              (jobs (append (forge-laminar-configuration-jobs config)
                            (filter forge-laminar-job? extended-values)))
              (groups (append (forge-laminar-configuration-groups config)
                              (filter forge-laminar-group? extended-values))))))
   (default-value (forge-laminar-configuration))))