gemtext in tissue issue tracker

* tags: important
* assigned: bruce
* status: closed

* [ ] buy groceries
* [x] fix the car

* closed

(define (read-gemtext-issue file)
  "Read issue from gemtext @var{file} and return an @code{<issue>}
object."
  (let* ((file-document (read-gemtext-document file))

(define-class <issue> (<file-document>)
  (assigned #:accessor issue-assigned #:init-keyword #:assigned)
  (keywords #:accessor issue-keywords #:init-keyword #:keywords)
  (open? #:accessor issue-open? #:init-keyword #:open?)
  (tasks #:accessor issue-tasks #:init-keyword #:tasks)
  (completed-tasks #:accessor issue-completed-tasks #:init-keyword #:completed-tasks))

    (make <issue>
      #:path file
      ;; Fallback to filename if title has no alphabetic characters.
      #:title (let ((title (hashtable-ref file-details 'title "")))
                (if (string-any char-set:letter title) title file))
      #:assigned (hashtable-ref file-details 'assigned '())
      ;; "closed" is a special keyword to indicate the open/closed
      ;; status of an issue.
      #:keywords (delete "closed" all-keywords)
      #:open? (not (member "closed" all-keywords))
      #:tasks (hashtable-ref file-details 'tasks 0)
      #:completed-tasks (hashtable-ref file-details 'completed-tasks 0)
      #:commits (file-document-commits file-document)
      #:snippet-source-text (document-snippet-source-text file-document))))

(define (file-details port)
  "Return a hashtable of details extracted from input PORT reading a
gemtext file."
  (let ((result (make-eq-hashtable))

    (port-transduce (tmap (lambda (line)
                            (cond
                             ;; Toggle preformatted state.
                             ((string=? "```" line)
                              (set! in-preformatted (not in-preformatted)))
                             ;; Ignore preformatted blocks.
                             (in-preformatted #t)
                             ;; Checkbox lists are tasks. If the
                             ;; checkbox has any character other
                             ;; than space in it, the task is
                             ;; completed.

                                   ;; Insert values based on
                                   ;; their keys.
                                   (for-each (match-lambda
                                               (((or 'assign 'assigned) . values)
                                                (hashtable-prepend! result 'assigned
                                                                    (map (cut resolve-alias <> (%aliases))
                                                                         values)))
                                               (((or 'keyword 'keywords 'severity 'status
                                                     'priority 'tag 'tags 'type)
                                                 . values)
                                                (hashtable-prepend! result 'keywords values))

						 (string-contains element keyword))
					       (list "request" "bug" "critical"
                                                     "enhancement" "progress"
                                                     "testing" "later" "documentation"
                                                     "help" "closed")))

(define-class <file-document> (<document>)
  (path #:accessor file-document-path #:init-keyword #:path)
  ;; List of <commit> objects, oldest first.
  (commits #:accessor file-document-commits #:init-keyword #:commits))

(define (commits-affecting-file file)
  "Return a list of commits affecting @var{file} in current repository."

(define (file-modification-table repository)
  "Return a hashtable mapping files to the list of commits in REPOSITORY
that modified them."