* Makefile.am: Add src/cuirass/gitlab.scm. * src/cuirass/gitlab.scm: Add <gitlab-event> and <gitlab-merge-request> record types. (gitlab-merge-request->specification): New variable. --- Makefile.am | 1 + src/cuirass/gitlab.scm | 95 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+) create mode 100644 src/cuirass/gitlab.scm
diff --git a/Makefile.am b/Makefile.am index c58bf58..4a066d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -52,6 +52,7 @@ dist_pkgmodule_DATA = \ src/cuirass/store.scm \ src/cuirass/base.scm \ src/cuirass/database.scm \ + src/cuirass/gitlab.scm \ src/cuirass/http.scm \ src/cuirass/logging.scm \ src/cuirass/mail.scm \ diff --git a/src/cuirass/gitlab.scm b/src/cuirass/gitlab.scm new file mode 100644 index 0000000..dab76b5 --- /dev/null +++ b/src/cuirass/gitlab.scm @@ -0,0 +1,95 @@ +;;;; gitlab.scm -- Gitlab JSON mappings +;;; Copyright © 2024 Romain Garbage <guix-de...@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"))))) -- 2.45.1
