summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2022-03-16 15:40:33 +0530
committerArun Isaac2022-03-16 15:47:14 +0530
commit7ad1367b363d2173967010e533e6009f1d4ee492 (patch)
tree0e51d48c1c1a5b556d2a2fa766e0e03041cafd5d
parentb542b7e27bdb335bee812900d0c17a565a0d7dfb (diff)
downloadtissue-7ad1367b363d2173967010e533e6009f1d4ee492.tar.gz
tissue-7ad1367b363d2173967010e533e6009f1d4ee492.tar.lz
tissue-7ad1367b363d2173967010e533e6009f1d4ee492.zip
tissue: Support tagging using "key: value" pairs.
* tissue/issue.scm (<=n-words?, list-line->alist): New functions. (file-details): Support tagging using "key: value" pairs.
-rw-r--r--tissue/issue.scm82
1 files changed, 57 insertions, 25 deletions
diff --git a/tissue/issue.scm b/tissue/issue.scm
index 59e7ee9..95edf4e 100644
--- a/tissue/issue.scm
+++ b/tissue/issue.scm
@@ -85,6 +85,33 @@ strings, and return them as a list."
"Remove PREFIX from STR."
(substring str (string-length prefix)))
+(define (<=n-words? str n)
+ "Return #t if STR has N words or less. Else, return #f."
+ (<= (length (string-split str #\space))
+ n))
+
+(define (list-line->alist line)
+ "Split list LINE such as \"assigned: foo, keywords: fubar, bar\"
+into an association list of key-value pairs. Keys are symbols. Values
+are lists of strings. If LINE does not contain such key-value pairs,
+return #f."
+ (and (string-match "^\\* [a-zA-Z]+:" line)
+ (fold (lambda (element result)
+ (cond
+ ((string-match "^([a-zA-Z]+):[ ]*(.*)" element)
+ => (lambda (m)
+ (cons (list (string->symbol
+ (string-downcase (match:substring m 1)))
+ (match:substring m 2))
+ result)))
+ (else
+ (match result
+ (((key . values) tail ...)
+ (cons (cons key (cons element values))
+ tail))))))
+ '()
+ (comma-split (remove-prefix "* " line)))))
+
(define (file-details file)
"Return a hashtable of details extracted from gemini FILE."
(let ((result (make-eq-hashtable)))
@@ -95,26 +122,40 @@ strings, and return them as a list."
(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))))
+ ;; 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))))
+ ((let ((alist (list-line->alist line)))
+ (and alist
+ ;; Every value string is 2
+ ;; words or less.
+ (every (match-lambda
+ ((_ . values)
+ (every (cut <=n-words? <> 2)
+ values)))
+ alist)
+ alist))
+ => (lambda (alist)
+ ;; Insert values based on
+ ;; their keys.
+ (for-each (match-lambda
+ (((or 'assign 'assigned) . values)
+ (hashtable-append! result 'assigned values))
+ (((or 'keywords 'severity 'status 'priority 'tags 'type) . values)
+ (hashtable-append! result 'keywords values))
+ (_ #t))
+ alist)))
;; 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))
+ (every (cut <=n-words? <> 2)
(comma-split (remove-prefix "* " line)))
;; Does any comma-separated
;; element contain a potential
@@ -130,15 +171,6 @@ strings, and return them as a list."
(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)