1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
| | ;;; 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")
("git" "send-email" "--to=12345@example.com" "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")
("git" "send-email" "--to=12345@example.com" "bar.patch")
("git" "send-email" "--to=12345@example.com" "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-end "client")
|