From 4520035a18c6d96fc6de35cd9fcb489bdc6724ef Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Wed, 8 Mar 2023 15:36:56 +0000
Subject: client: Support checking in to a specific issue.

* mumi/client.scm: Import (srfi srfi-26).
(current-issue-file, current-issue-number): New functions.
(print-current-issue, set-current-issue!, clear-current-issue!): New
public functions.
* scripts/mumi.in (show-mumi-usage): Document current and new
subcommands.
(main): Add current and new subcommands.
---
 mumi/client.scm | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
 scripts/mumi.in | 20 ++++++++++++++++++++
 2 files changed, 67 insertions(+), 1 deletion(-)

diff --git a/mumi/client.scm b/mumi/client.scm
index e4a0123..ae3a0a9 100644
--- a/mumi/client.scm
+++ b/mumi/client.scm
@@ -18,13 +18,17 @@
 
 (define-module (mumi client)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
   #: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))
+  #:export (search
+            print-current-issue
+            set-current-issue!
+            clear-current-issue!))
 
 (define (git-top-level)
   "Return the top-level directory of the current git repository."
@@ -106,3 +110,45 @@
                                                 date
                                                 (submitter name address)))))
                     "issues")))
+
+(define (current-issue-file)
+  "Return path to current issue number file."
+  (string-append (client-config-directory) "/current-issue"))
+
+(define (current-issue-number)
+  "Return current issue number."
+  (let ((issue-file (current-issue-file)))
+    (and (file-exists? issue-file)
+         (call-with-input-file issue-file
+           read))))
+
+(define (print-current-issue)
+  "Print current issue."
+  (let ((issue-number (current-issue-number)))
+    (if issue-number
+        (list-issue
+         (assoc-ref
+          (graphql-http-get (graphql-endpoint)
+                            `(document
+                              (query (#(issue #:number ,issue-number)
+                                      number
+                                      title
+                                      open
+                                      date
+                                      (submitter name address)))))
+          "issue"))
+        (begin
+          (format (current-error-port) "No current issue!~%")
+          (exit #f)))))
+
+(define (set-current-issue! issue-number)
+  "Set current issue number."
+  ;; TODO: Write file atomically.
+  (call-with-output-file (current-issue-file)
+    (cut write issue-number <>)))
+
+(define (clear-current-issue!)
+  "Clear current issue."
+  (let ((issue-file (current-issue-file)))
+    (when (file-exists? issue-file)
+      (delete-file issue-file))))
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 9b61729..dfd082d 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -120,6 +120,12 @@
     `mumi search QUERY':
          search mumi for issues.
 
+    `mumi current [ISSUE-NUMBER]':
+         print or set current issue.
+
+    `mumi new':
+         clear current issue presumably to open a new one.
+
     `mumi web [--address=address] [--port=port] [--listen-repl[=port]] [--disable-mailer]':
          start the application web server.
 
@@ -138,6 +144,20 @@
 (match (cdr (program-arguments))
   (("search" . query-strings)
    (client:search (string-join query-strings)))
+  (("current")
+   (client:print-current-issue))
+  (("current" issue-number-string)
+   (let ((issue-number (string->number issue-number-string)))
+     (if issue-number
+         (client:set-current-issue! issue-number)
+         (begin
+           (format (current-error-port)
+                   "Invalid issue number `~a'~%"
+                   issue-number-string)
+           (exit #f))))
+   (client:print-current-issue))
+  (("new")
+   (client:clear-current-issue!))
   (("mailer" . rest)
    (let* ((opts (parse-options rest))
           (sender (assoc-ref opts 'sender))
-- 
cgit v1.2.3