#!/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-equal? 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-equal? "title" "Build: add pip-audit to pipeline")
                         (list-merge-requests '((state . "opened") (author_username . "ray33")))))))