@@ -49,6 +49,7 @@ SOURCES = \
mumi/messages.scm \
mumi/jobs.scm \
mumi/send-email.scm \
+ mumi/client.scm \
mumi/config.scm \
mumi/debbugs.scm \
mumi/test-utils.scm \
new file mode 100644
@@ -0,0 +1,108 @@
+;;; mumi -- Mediocre, uh, mail interface
+;;; Copyright © 2023 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of mumi.
+;;;
+;;; mumi 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.
+;;;
+;;; mumi 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 mumi. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (mumi client)
+ #:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-43)
+ #:use-module (term ansi-color)
+ #:use-module (web uri)
+ #:use-module (kolam http)
+ #:use-module (mumi config)
+ #:use-module (mumi web view utils)
+ #:export (search))
+
+(define (git-top-level)
+ "Return the top-level directory of the current git repository."
+ (let loop ((curdir (getcwd)))
+ (cond
+ ((file-exists? (string-append curdir "/.git"))
+ curdir)
+ ((string=? curdir "/")
+ (error "No git top level found"))
+ (else
+ (loop (dirname curdir))))))
+
+(define (client-config-directory)
+ "Return client configuration directory."
+ (string-append (git-top-level) "/.mumi"))
+
+(define (client-config key)
+ "Return client configuration value corresponding to KEY."
+ (or (assq-ref (call-with-input-file (string-append (client-config-directory)
+ "/config")
+ read)
+ key)
+ (case key
+ ((mumi-scheme) 'https)
+ (else (format (current-error-port)
+ "Key '~a not configured for mumi client.~%"
+ key)))))
+
+(define (graphql-endpoint)
+ "Return GraphQL endpoint."
+ (uri->string
+ (build-uri (client-config 'mumi-scheme)
+ #:host (client-config 'mumi-host)
+ #:path "/graphql")))
+
+(define (iso8601->date str)
+ "Convert ISO-8601 date/time+zone string to date object."
+ (string->date str "~Y-~m-~dT~H:~M:~S~z"))
+
+(define (list-issue issue)
+ "List issue described by ISSUE association list."
+ (display (colorize-string
+ (string-append "#"
+ (number->string (assoc-ref issue "number")))
+ 'YELLOW))
+ (display " ")
+ (unless (assoc-ref issue "open")
+ (display (colorize-string "✓" 'BOLD 'GREEN))
+ (display " "))
+ (display (colorize-string
+ (assoc-ref issue "title")
+ 'MAGENTA 'UNDERLINE))
+ (newline)
+ (display (string-append
+ "opened "
+ (colorize-string (time->string
+ (iso8601->date (assoc-ref issue "date")))
+ 'CYAN)
+ " by "
+ (colorize-string
+ (let ((submitter (assoc-ref issue "submitter")))
+ (if (eq? (assoc-ref submitter "name") 'null)
+ (assoc-ref submitter "address")
+ (assoc-ref submitter "name")))
+ 'CYAN)))
+ (newline))
+
+(define (search query)
+ "Search for issues with QUERY and list results."
+ (vector-for-each (lambda (_ issue)
+ (list-issue issue))
+ (assoc-ref
+ (graphql-http-get (graphql-endpoint)
+ `(document
+ (query (#(issues #:search ,query)
+ number
+ title
+ open
+ date
+ (submitter name address)))))
+ "issues")))
@@ -4,7 +4,7 @@
!#
;;; mumi -- Mediocre, uh, mail interface
;;; Copyright © 2016, 2017, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2018, 2021 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2021, 2023 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of mumi.
;;;
@@ -26,6 +26,7 @@
(system repl server)
(ice-9 match)
(ice-9 format)
+ ((mumi client) #:prefix client:)
(mumi config)
((mumi debbugs)
#:select (extract-bug-numbers))
@@ -116,6 +117,9 @@
(define (show-mumi-usage)
(format (current-error-port)
"
+ `mumi search QUERY':
+ search mumi for issues.
+
`mumi web [--address=address] [--port=port] [--listen-repl[=port]] [--disable-mailer]':
start the application web server.
@@ -132,6 +136,8 @@
(exit 1))
(match (cdr (program-arguments))
+ (("search" . query-strings)
+ (client:search (string-join query-strings)))
(("mailer" . rest)
(let* ((opts (parse-options rest))
(sender (assoc-ref opts 'sender))