[PATCH Cuirass 2/4] gitlab: Add module for Gitlab JSON objects definition.

[Romain GARBAGE]

* 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-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")))))
-- 
2.45.1