tissue: Reorganize code into scheme modules.

* bin/tissue: Do not import (rnrs hashtables) and (srfi
srfi-9). Import (tissue issue) and (tissue utils).
(<issue>, issues, hashtable-append!, comma-split, remove-prefix,
file-details): Move to tissue/issue.scm.
(call-with-input-pipe, get-line-dos-or-unix): Move to
tissue/utils.scm.
* tissue/issue.scm, tissue/utils.scm: New files.

3 files changed, 261 insertions, 193 deletions

diff --git a/bin/tissue b/bin/tissue
index f2e87e1..4e3c747 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -19,10 +19,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with tissue.  If not, see <https://www.gnu.org/licenses/>.
 
-(import (rnrs hashtables)
-        (rnrs io ports)
+(import (rnrs io ports)
         (srfi srfi-1)
-        (srfi srfi-9)
         (srfi srfi-26)
         (srfi srfi-37)
         (srfi srfi-171)
@@ -30,201 +28,14 @@
         (ice-9 ftw)
         (ice-9 match)
         (ice-9 popen)
-        (ice-9 regex))
+        (ice-9 regex)
+        (tissue issue)
+        (tissue utils))
 
 (define (invoke program . args)
   (unless (zero? (apply system* program args))
     (error "Invocation of program failed" (cons program args))))
 
-(define (call-with-input-pipe proc program . args)
-  "Execute PROGRAM ARGS ... in a subprocess with a pipe to it. Call
-PROC with an input port to that pipe. Close the pipe once PROC exits,
-even if it exits non-locally. Return the value returned by PROC."
-  (let ((port #f))
-    (dynamic-wind (lambda () (set! port (apply open-pipe* OPEN_READ program args)))
-                  (cut proc port)
-                  (lambda ()
-                    (let ((return-value (status:exit-val (close-pipe port))))
-                      (unless (and return-value
-                                   (zero? return-value))
-                        (error "Invocation of program failed" (cons program args))))))))
-
-(define-record-type <issue>
-  (issue file title creator created-date created-relative-date
-         last-updater last-updated-date last-updated-relative-date
-         assigned keywords open tasks completed-tasks posts)
-  issue?
-  (file issue-file)
-  (title issue-title)
-  (creator issue-creator)
-  (created-date issue-created-date)
-  (created-relative-date issue-created-relative-date)
-  (last-updater issue-last-updater)
-  (last-updated-date issue-last-updated-date)
-  (last-updated-relative-date issue-last-updated-relative-date)
-  (assigned issue-assigned)
-  (keywords issue-keywords)
-  (open issue-open)
-  (tasks issue-tasks)
-  (completed-tasks issue-completed-tasks)
-  (posts issue-posts))
-
-(define (issues)
-  "Return a list of all issues, sorted oldest first."
-  ;; Get all gemini files except README.gmi and hidden files. Text
-  ;; editors tend to create hidden files while editing, and we want to
-  ;; avoid them.
-  (sort (call-with-input-pipe
-         (lambda (port)
-           (port-transduce
-            (tfilter-map (lambda (file)
-                           (and (string-suffix? ".gmi" file)
-                                (not (string=? (basename file) "README.gmi"))
-                                (not (string-prefix? "." (basename file)))
-                                (let* ((file-details (file-details file))
-                                       (all-keywords (hashtable-ref file-details 'keywords '())))
-                                  (issue file
-                                         ;; Fallback to filename if title has no alphabetic
-                                         ;; characters.
-                                         (let ((title (hashtable-ref file-details 'title "")))
-                                           (if (string-any char-set:letter title) title file))
-                                         (hashtable-ref file-details 'creator #f)
-                                         (hashtable-ref file-details 'created-date #f)
-                                         (hashtable-ref file-details 'created-relative-date #f)
-                                         (hashtable-ref file-details 'last-updater #f)
-                                         (hashtable-ref file-details 'last-updated-date #f)
-                                         (hashtable-ref file-details 'last-updated-relative-date #f)
-                                         (hashtable-ref file-details 'assigned '())
-                                         ;; "closed" is a special keyword to indicate
-                                         ;; the open/closed status of an issue.
-                                         (delete "closed" all-keywords)
-                                         (not (member "closed" all-keywords))
-                                         (hashtable-ref file-details 'tasks 0)
-                                         (hashtable-ref file-details 'completed-tasks 0)
-                                         (hashtable-ref file-details 'posts #f))))))
-            rcons get-line port))
-         "git" "ls-files")
-   (lambda (issue1 issue2)
-     (< (issue-created-date issue1)
-        (issue-created-date issue2)))))
-
-(define (hashtable-append! hashtable key new-values)
-  "Append NEW-VALUES to the list of values KEY is associated to in
-HASHTABLE. If KEY is not associated to any value in HASHTABLE, assume
-it is associated to the empty list."
-  (hashtable-update!
-   hashtable key (cut append <> new-values) '()))
-
-(define (comma-split str)
-  "Split string at commas, trim whitespace from both ends of the split
-strings, and return them as a list."
-  (map (cut string-trim-both <>)
-       (string-split str #\,)))
-
-(define (remove-prefix prefix str)
-  "Remove PREFIX from STR."
-  (substring str (string-length prefix)))
-
-(define (get-line-dos-or-unix port)
-  "Read line from PORT. This differs from `get-line' in (rnrs io
-ports) in that it also supports DOS line endings."
-  (let ((line (get-line port)))
-    (if (eof-object? line)
-        line
-        (string-trim-right line #\return))))
-
-(define (file-details file)
-  "Return a hashtable of details extracted from gemini FILE."
-  (let ((result (make-eq-hashtable)))
-    (call-with-input-file file
-      (lambda (port)
-        (port-transduce (tmap (lambda (line)
-                                (cond
-                                 ;; Lists with the assigned: prefix
-                                 ;; specify assignees.
-                                 ((string-prefix? "* assigned:" line)
-                                  (hashtable-append! result 'assigned
-                                                     (comma-split
-                                                      (remove-prefix "* assigned:" line))))
-                                 ;; Lists with the keywords: prefix
-                                 ;; specify keywords.
-                                 ((string-prefix? "* keywords:" line)
-                                  (hashtable-append! result 'keywords
-                                                     (comma-split
-                                                      (remove-prefix "* keywords:" line))))
-                                 ;; A more fuzzy heuristic to find keywords
-                                 ((and (string-prefix? "* " line)
-                                       ;; Is every comma-separated
-                                       ;; element two words utmost?
-                                       (every (lambda (element)
-                                                (<= (length
-                                                     (string-split element #\space))
-                                                    2))
-                                              (comma-split (remove-prefix "* " line)))
-                                       ;; Does any comma-separated
-                                       ;; element contain a potential
-                                       ;; keyword?
-                                       (any (lambda (element)
-                                              (any (lambda (keyword)
-                                                     (string-contains element keyword))
-                                                   (list "request" "bug" "critical"
-                                                         "enhancement" "progress"
-                                                         "testing" "later" "documentation"
-                                                         "help" "closed")))
-                                            (comma-split (remove-prefix "* " line))))
-                                  (hashtable-append! result 'keywords
-                                                     (comma-split
-                                                      (remove-prefix "* " line))))
-                                 ;; Checkbox lists are tasks. If the
-                                 ;; checkbox has any character other
-                                 ;; than space in it, the task is
-                                 ;; completed.
-                                 ((string-match "\\* \\[(.)\\]" line)
-                                  => (lambda (m)
-                                       (hashtable-update! result 'tasks 1+ 0)
-                                       (unless (string=? (match:substring m 1) " ")
-                                         (hashtable-update! result 'completed-tasks 1+ 0))))
-                                 ;; The first level one heading is the
-                                 ;; title.
-                                 ((string-prefix? "# " line)
-                                  (unless (hashtable-contains? result 'title)
-                                    (hashtable-set! result 'title
-                                                    (remove-prefix "# " line)))))))
-                        (const #t)
-                        get-line-dos-or-unix
-                        port)))
-    (call-with-input-pipe
-     (lambda (port)
-       (hashtable-set!
-        result 'posts
-        (port-transduce
-         (compose (tenumerate)
-                  (tmap (match-lambda
-                          ((index . line)
-                           (let ((alist (call-with-input-string line read)))
-                             (when (zero? index)
-                               (hashtable-set! result 'last-updater
-                                               (assq-ref alist 'author))
-                               (hashtable-set! result 'last-updated-date
-                                               (assq-ref alist 'author-date))
-                               (hashtable-set! result 'last-updated-relative-date
-                                               (assq-ref alist 'author-relative-date)))
-                             (hashtable-set! result 'creator
-                                             (assq-ref alist 'author))
-                             (hashtable-set! result 'created-date
-                                             (assq-ref alist 'author-date))
-                             (hashtable-set! result 'created-relative-date
-                                             (assq-ref alist 'author-relative-date)))))))
-         rcount get-line port)))
-     "git" "log"
-     (string-append "--format=format:("
-                    "(author . \"%an\")"
-                    "(author-date . %at)"
-                    "(author-relative-date . \"%ar\")"
-                    ")")
-     "--" file)
-    result))
-
 (define (git-updated-files transducer start-commit end-commit)
   "Use TRANSDUCER to transduce over the list of files updated between
 START-COMMIT and END-COMMIT."
diff --git a/tissue/issue.scm b/tissue/issue.scm
new file mode 100644
index 0000000..b5813cd
--- /dev/null
+++ b/tissue/issue.scm
@@ -0,0 +1,212 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue 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.
+;;;
+;;; tissue 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 tissue.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue issue)
+  #:use-module (rnrs hashtables)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-171)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (tissue utils)
+  #:export (issue
+            issue-file
+            issue-title
+            issue-creator
+            issue-created-date
+            issue-created-relative-date
+            issue-last-updater
+            issue-last-updated-date
+            issue-last-updated-relative-date
+            issue-assigned
+            issue-keywords
+            issue-open
+            issue-tasks
+            issue-completed-tasks
+            issue-posts
+            issues))
+
+(define-record-type <issue>
+  (issue file title creator created-date created-relative-date
+         last-updater last-updated-date last-updated-relative-date
+         assigned keywords open tasks completed-tasks posts)
+  issue?
+  (file issue-file)
+  (title issue-title)
+  (creator issue-creator)
+  (created-date issue-created-date)
+  (created-relative-date issue-created-relative-date)
+  (last-updater issue-last-updater)
+  (last-updated-date issue-last-updated-date)
+  (last-updated-relative-date issue-last-updated-relative-date)
+  (assigned issue-assigned)
+  (keywords issue-keywords)
+  (open issue-open)
+  (tasks issue-tasks)
+  (completed-tasks issue-completed-tasks)
+  (posts issue-posts))
+
+(define (hashtable-append! hashtable key new-values)
+  "Append NEW-VALUES to the list of values KEY is associated to in
+HASHTABLE. If KEY is not associated to any value in HASHTABLE, assume
+it is associated to the empty list."
+  (hashtable-update!
+   hashtable key (cut append <> new-values) '()))
+
+(define (comma-split str)
+  "Split string at commas, trim whitespace from both ends of the split
+strings, and return them as a list."
+  (map (cut string-trim-both <>)
+       (string-split str #\,)))
+
+(define (remove-prefix prefix str)
+  "Remove PREFIX from STR."
+  (substring str (string-length prefix)))
+
+(define (file-details file)
+  "Return a hashtable of details extracted from gemini FILE."
+  (let ((result (make-eq-hashtable)))
+    (call-with-input-file file
+      (lambda (port)
+        (port-transduce (tmap (lambda (line)
+                                (cond
+                                 ;; Lists with the assigned: prefix
+                                 ;; specify assignees.
+                                 ((string-prefix? "* assigned:" line)
+                                  (hashtable-append! result 'assigned
+                                                     (comma-split
+                                                      (remove-prefix "* assigned:" line))))
+                                 ;; Lists with the keywords: prefix
+                                 ;; specify keywords.
+                                 ((string-prefix? "* keywords:" line)
+                                  (hashtable-append! result 'keywords
+                                                     (comma-split
+                                                      (remove-prefix "* keywords:" line))))
+                                 ;; A more fuzzy heuristic to find keywords
+                                 ((and (string-prefix? "* " line)
+                                       ;; Is every comma-separated
+                                       ;; element two words utmost?
+                                       (every (lambda (element)
+                                                (<= (length
+                                                     (string-split element #\space))
+                                                    2))
+                                              (comma-split (remove-prefix "* " line)))
+                                       ;; Does any comma-separated
+                                       ;; element contain a potential
+                                       ;; keyword?
+                                       (any (lambda (element)
+                                              (any (lambda (keyword)
+                                                     (string-contains element keyword))
+                                                   (list "request" "bug" "critical"
+                                                         "enhancement" "progress"
+                                                         "testing" "later" "documentation"
+                                                         "help" "closed")))
+                                            (comma-split (remove-prefix "* " line))))
+                                  (hashtable-append! result 'keywords
+                                                     (comma-split
+                                                      (remove-prefix "* " line))))
+                                 ;; Checkbox lists are tasks. If the
+                                 ;; checkbox has any character other
+                                 ;; than space in it, the task is
+                                 ;; completed.
+                                 ((string-match "\\* \\[(.)\\]" line)
+                                  => (lambda (m)
+                                       (hashtable-update! result 'tasks 1+ 0)
+                                       (unless (string=? (match:substring m 1) " ")
+                                         (hashtable-update! result 'completed-tasks 1+ 0))))
+                                 ;; The first level one heading is the
+                                 ;; title.
+                                 ((string-prefix? "# " line)
+                                  (unless (hashtable-contains? result 'title)
+                                    (hashtable-set! result 'title
+                                                    (remove-prefix "# " line)))))))
+                        (const #t)
+                        get-line-dos-or-unix
+                        port)))
+    (call-with-input-pipe
+     (lambda (port)
+       (hashtable-set!
+        result 'posts
+        (port-transduce
+         (compose (tenumerate)
+                  (tmap (match-lambda
+                          ((index . line)
+                           (let ((alist (call-with-input-string line read)))
+                             (when (zero? index)
+                               (hashtable-set! result 'last-updater
+                                               (assq-ref alist 'author))
+                               (hashtable-set! result 'last-updated-date
+                                               (assq-ref alist 'author-date))
+                               (hashtable-set! result 'last-updated-relative-date
+                                               (assq-ref alist 'author-relative-date)))
+                             (hashtable-set! result 'creator
+                                             (assq-ref alist 'author))
+                             (hashtable-set! result 'created-date
+                                             (assq-ref alist 'author-date))
+                             (hashtable-set! result 'created-relative-date
+                                             (assq-ref alist 'author-relative-date)))))))
+         rcount get-line port)))
+     "git" "log"
+     (string-append "--format=format:("
+                    "(author . \"%an\")"
+                    "(author-date . %at)"
+                    "(author-relative-date . \"%ar\")"
+                    ")")
+     "--" file)
+    result))
+
+(define (issues)
+  "Return a list of all issues, sorted oldest first."
+  ;; Get all gemini files except README.gmi and hidden files. Text
+  ;; editors tend to create hidden files while editing, and we want to
+  ;; avoid them.
+  (sort (call-with-input-pipe
+         (lambda (port)
+           (port-transduce
+            (tfilter-map (lambda (file)
+                           (and (string-suffix? ".gmi" file)
+                                (not (string=? (basename file) "README.gmi"))
+                                (not (string-prefix? "." (basename file)))
+                                (let* ((file-details (file-details file))
+                                       (all-keywords (hashtable-ref file-details 'keywords '())))
+                                  (issue file
+                                         ;; Fallback to filename if title has no alphabetic
+                                         ;; characters.
+                                         (let ((title (hashtable-ref file-details 'title "")))
+                                           (if (string-any char-set:letter title) title file))
+                                         (hashtable-ref file-details 'creator #f)
+                                         (hashtable-ref file-details 'created-date #f)
+                                         (hashtable-ref file-details 'created-relative-date #f)
+                                         (hashtable-ref file-details 'last-updater #f)
+                                         (hashtable-ref file-details 'last-updated-date #f)
+                                         (hashtable-ref file-details 'last-updated-relative-date #f)
+                                         (hashtable-ref file-details 'assigned '())
+                                         ;; "closed" is a special keyword to indicate
+                                         ;; the open/closed status of an issue.
+                                         (delete "closed" all-keywords)
+                                         (not (member "closed" all-keywords))
+                                         (hashtable-ref file-details 'tasks 0)
+                                         (hashtable-ref file-details 'completed-tasks 0)
+                                         (hashtable-ref file-details 'posts #f))))))
+            rcons get-line port))
+         "git" "ls-files")
+        (lambda (issue1 issue2)
+          (< (issue-created-date issue1)
+             (issue-created-date issue2)))))
diff --git a/tissue/utils.scm b/tissue/utils.scm
new file mode 100644
index 0000000..5fce26d
--- /dev/null
+++ b/tissue/utils.scm
@@ -0,0 +1,45 @@
+;;; tissue --- Text based issue tracker
+;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;;
+;;; This file is part of tissue.
+;;;
+;;; tissue 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.
+;;;
+;;; tissue 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 tissue.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (tissue utils)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 popen)
+  #:export (call-with-input-pipe
+            get-line-dos-or-unix))
+
+(define (call-with-input-pipe proc program . args)
+  "Execute PROGRAM ARGS ... in a subprocess with a pipe to it. Call
+PROC with an input port to that pipe. Close the pipe once PROC exits,
+even if it exits non-locally. Return the value returned by PROC."
+  (let ((port #f))
+    (dynamic-wind (lambda () (set! port (apply open-pipe* OPEN_READ program args)))
+                  (cut proc port)
+                  (lambda ()
+                    (let ((return-value (status:exit-val (close-pipe port))))
+                      (unless (and return-value
+                                   (zero? return-value))
+                        (error "Invocation of program failed" (cons program args))))))))
+
+(define (get-line-dos-or-unix port)
+  "Read line from PORT. This differs from `get-line' in (rnrs io
+ports) in that it also supports DOS line endings."
+  (let ((line (get-line port)))
+    (if (eof-object? line)
+        line
+        (string-trim-right line #\return))))