;;; mumi -- Mediocre, uh, mail interface
;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program 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
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(use-modules (srfi srfi-26)
             (srfi srfi-64)
             (ice-9 match))

(define (with-variable variable value thunk)
  "Set VARIABLE to VALUE, run THUNK and restore the old value of
VARIABLE. Return the value returned by THUNK."
  (let ((old-value (variable-ref variable)))
    (dynamic-wind
      (cut variable-set! variable value)
      thunk
      (cut variable-set! variable old-value))))

(define (with-variables variable-bindings thunk)
  "Set VARIABLE-BINDINGS, run THUNK and restore the old values of the
variables. Return the value returned by THUNK. VARIABLE-BINDINGS is a
list of pairs mapping variables to their values."
  (match variable-bindings
    (((variable . value) tail ...)
     (with-variable variable value
       (cut with-variables tail thunk)))
    (() (thunk))))

(define-syntax-rule (var@@ module-name variable-name)
  (module-variable (resolve-module 'module-name)
                   'variable-name))

(define (trace-calls function-variable thunk)
  "Run THUNK and return a list of argument lists FUNCTION-VARIABLE is
called with."
  (let ((args-list (list)))
    (with-variable function-variable (lambda args
                                       (set! args-list
                                             (cons args args-list)))
      thunk)
    (reverse args-list)))

(define client-config-stub
  (cons (var@@ (mumi client) client-config)
        (lambda (key)
          (case key
            ((debbugs-host) "example.com")
            ((patch-email-address) "foo@patches.com")
            (else (error "Key unimplemented in stub" key))))))

(test-begin "client")

(test-equal "send patches to new issue"
  '(("git" "send-email" "--to=foo@patches.com" "foo.patch")
    ("git" "send-email" "--to=12345@example.com" "bar.patch" "foobar.patch"))
  (map (match-lambda
         ((command _) command))
       (trace-calls (var@@ (mumi client) call-with-input-pipe)
         (lambda ()
           (with-variables (list (cons (var@@ (mumi client) issue-number-of-message)
                                       (const 12345))
                                 client-config-stub)
             (cut (@@ (mumi client) send-email)
                  (list "foo.patch" "bar.patch" "foobar.patch")))))))

(test-equal "send patches to existing issue"
  '(("git" "send-email" "--to=12345@example.com" "foo.patch" "bar.patch" "foobar.patch"))
  (map (match-lambda
         ((command _) command))
       (trace-calls (var@@ (mumi client) call-with-input-pipe)
         (lambda ()
           (with-variables (list (cons (var@@ (mumi client) current-issue-number)
                                       (const 12345))
                                 client-config-stub)
             (cut (@@ (mumi client) send-email)
                  (list "foo.patch" "bar.patch" "foobar.patch")))))))

(test-equal "send single patch to new issue"
  '(("git" "send-email" "--to=foo@patches.com" "foo.patch"))
  (map (match-lambda
         ((command _) command))
       (trace-calls (var@@ (mumi client) call-with-input-pipe)
         (lambda ()
           (with-variables (list (cons (var@@ (mumi client) issue-number-of-message)
                                       (lambda _
                                         (error "Do not poll server for issue number")))
                                 client-config-stub)
             (cut (@@ (mumi client) send-email)
                  (list "foo.patch")))))))

(test-equal "send single patch to existing issue"
  '(("git" "send-email" "--to=12345@example.com" "foo.patch"))
  (map (match-lambda
         ((command _) command))
       (trace-calls (var@@ (mumi client) call-with-input-pipe)
         (lambda ()
           (with-variables (list (cons (var@@ (mumi client) current-issue-number)
                                       (const 12345))
                                 (cons (var@@ (mumi client) issue-number-of-message)
                                       (lambda _
                                         (error "Do not poll server for issue number")))
                                 client-config-stub)
             (cut (@@ (mumi client) send-email)
                  (list "foo.patch")))))))

(test-end "client")