Quick hack to list GitLab MRs

guile/list-gitlab-merge-requests.scm

@@ -0,0 +1,81 @@
+#!/usr/bin/guile \
+--no-auto-compile -e main -s
+!#
+
+(use-modules (ice-9 exceptions)
+             (ice-9 match)
+             (ice-9 textual-ports)
+             (json)
+             (srfi srfi-1)
+             (srfi srfi-26)
+             (srfi srfi-71)
+             (web client)
+             (web response)
+             (web uri))
+
+(define gitlab-token (string-trim-right (getenv "GITLAB_TOKEN")))
+(define base-url "https://gitlab.com/api/v4")
+
+(define (encode-query alist)
+  (fold (match-lambda*
+          (((k . v) s)
+           (if v
+               (string-append s
+                              (if (zero? (string-length s)) "" "&")
+                              (symbol->string k)
+                              "="
+                              (uri-encode v))
+               s)))
+        ""
+        alist))
+
+(define (json-response? res)
+  (eq? 'application/json (car (response-content-type res))))
+
+(define (text-response? res)
+  (string-prefix? "text/"
+                  (symbol->string (car (response-content-type res)))))
+
+(define (json-ok? res)
+  (and (= 200 (response-code res))
+       (json-response? res)))
+
+(define-exception-type &api-error &external-error
+  make-api-error
+  api-error?
+  (endpoint api-error-endpoint)
+  (status-code api-error-status-code)
+  (body api-error-body))
+
+(define-syntax check-api-response
+  (syntax-rules ()
+    ((check-api-response endpoint res body-port)
+     (check-api-response endpoint res body-port (<= 100 (response-code res) 399)))
+    ((check-api-response endpoint res body-port ok?)
+     (unless ok?
+       (let ((body (cond
+                    ((json-response? res) (json->scm body-port))
+                    ((text-response? res) (get-string-all body-port))
+                    (else "<binary response body>"))))
+         (close-port body-port)
+         (raise-exception (make-api-error endpoint (response-code res) body)))))))
+
+
+(define (list-merge-requests params)
+  (let ((res body-port (http-get (string-append base-url "/merge_requests?" (encode-query params))
+                                 #:headers `((private-token . ,gitlab-token))
+                                 #:streaming? #t)))
+    (check-api-response "list-merge-requests" res body-port json-ok?)
+    (let ((body (json->scm body-port)))
+      (close-port body-port)
+      (vector->list body))))
+
+(define (field-eq? field-name value)
+  (lambda (alist)
+    (equal? (assoc-ref alist field-name) value)))
+
+(define (main args)
+  (for-each (cut format #t "~a~%" <>)
+            (map (cut assoc-ref <> "web_url")
+                 (filter (field-eq? "title" "Build: add pip-audit to pipeline")
+                         (list-merge-requests '((state . "opened") (author_username . "ray33")))))))