;;;; gitlab.scm -- Gitlab JSON mappings
;;; Copyright © 2024 Romain Garbage <guix-devel@rgarbage.fr>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass 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.
;;;
;;; Cuirass 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 Cuirass.  If not, see <http://www.gnu.org/licenses/>.

(define-module (cuirass gitlab)
  #:use-module (cuirass specification)
  #:use-module (json)
  #:use-module (guix channels)
  #:use-module (ice-9 match)
  #:export (gitlab-event
            gitlab-event-type
            gitlab-event-value
            json->gitlab-event

            gitlab-merge-request
            gitlab-merge-request-action
            gitlab-merge-request-project-name
            json->gitlab-merge-request
            gitlab-merge-request->specification))

(define-json-mapping <gitlab-source>
  make-gitlab-source
  gitlab-source?
  json->gitlab-source
  (repo-url gitlab-source-repo-url "git_http_url")
  (name     gitlab-source-name "name"
            string->symbol))

(define-json-mapping <gitlab-merge-request>
  make-gitlab-merge-request
  gitlab-merge-request?
  json->gitlab-merge-request
  (action          gitlab-merge-request-action "action")
  (source-branch   gitlab-merge-request-source-branch "source_branch")
  (source          gitlab-merge-request-source "source"
                   json->gitlab-source))

(define-json-mapping <gitlab-event>
  make-gitlab-event
  gitlab-event?
  json->gitlab-event
  (type  gitlab-event-type "event_type"
         (lambda (v)
           (string->symbol
             (string-map (lambda (c)
                           (if (char=? c #\_)
                               #\-
                               c))
                         v))))
  (value gitlab-event-value "object_attributes"
         (lambda (v)
           ;; FIXME: properly handle cases using field TYPE defined above.
           ;; This would need to use something like Guix's define-record-type*.
           (cond
            ((assoc-ref v "merge_status")
             (json->gitlab-merge-request v))
            (#t #f)))))

(define (gitlab-merge-request->specification merge-request)
  "Returns a SPECIFICATION built out of a GITLAB-MERGE-REQUEST."
  (let* ((source-name (gitlab-source-name
                       (gitlab-merge-request-source merge-request)))
         (source-branch (gitlab-merge-request-source-branch merge-request))
         (source-url (gitlab-source-repo-url
                      (gitlab-merge-request-source merge-request)))
         (spec-name (symbol-append 'gitlab-merge-requests-
                                   source-name
                                   '-
                                   (string->symbol source-branch))))
    (specification
     (name spec-name)
     (build `(channels ,source-name))
     (channels
      (cons* (channel
              (name source-name)
              (url source-url)
              (branch source-branch))
             %default-channels))
     (priority 1)
     (period 0)
     (systems (list "x86_64-linux")))))