diff mbox series

[bug#61645,v2,1/4] client: Add CLI client to search for issues.

Message ID 20230221003318.5334-1-arunisaac@systemreboot.net
State New
Headers show
Series [bug#61645,v2,1/4] client: Add CLI client to search for issues. | expand

Commit Message

Arun Isaac Feb. 21, 2023, 12:33 a.m. UTC
* mumi/client.scm: New file.
* scripts/mumi.in: Import (mumi client).
(show-mumi-usage): Document search subcommand.
(main): Add search subcommand.
* Makefile.am (SOURCES): Add mumi/client.scm.
---
 Makefile.am     |   1 +
 mumi/client.scm | 108 ++++++++++++++++++++++++++++++++++++++++++++++++
 scripts/mumi.in |   8 +++-
 3 files changed, 116 insertions(+), 1 deletion(-)
 create mode 100644 mumi/client.scm
diff mbox series

Patch

diff --git a/Makefile.am b/Makefile.am
index 8182fc3..a8c11a1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -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				\
diff --git a/mumi/client.scm b/mumi/client.scm
new file mode 100644
index 0000000..e4a0123
--- /dev/null
+++ b/mumi/client.scm
@@ -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")))
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 755dfb3..9b61729 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -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))