From ef47614b81052f2a2758ad26c194a44a8ce441c6 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sun, 26 Jun 2022 23:34:05 +0530 Subject: tissue: Generalize issue-files to indexed-documents. * tissue/tissue.scm ()[issue-files]: Delete field. [indexed-documents]: New field. * tissue/tissue.scm (tissue-configuration): Remove issue-files argument. Add indexed-documents argument. * bin/tissue: Import (tissue document) with doc: prefix. (print-document, alist->document, document->text, index-document): New functions. (tissue-search): Display search results for generalized documents using print-document, alist->document and document->text. (main): Index generalized documents using index-document. --- bin/tissue | 49 ++++++++++++++++++++++++++++++++++++++++++------- tissue/tissue.scm | 14 ++++++++------ 2 files changed, 50 insertions(+), 13 deletions(-) diff --git a/bin/tissue b/bin/tissue index 06da565..63b5682 100755 --- a/bin/tissue +++ b/bin/tissue @@ -38,6 +38,7 @@ exec guile --no-auto-compile -s "$0" "$@" (xapian wrap) (xapian xapian) (tissue conditions) + (prefix (tissue document) doc:) (tissue git) (tissue issue) (tissue tissue) @@ -92,6 +93,14 @@ to run tissue." (match (command-line) ((program _ ...) program))) +(define (print-document document) + "Print DOCUMENT, an or object." + ((cond + ((issue? document) print-issue) + ((doc:document? document) doc:print-document) + (else (raise (unknown-document-type-violation document)))) + document)) + (define (print-issue issue) "Print ISSUE." (let ((number-of-posts (length (issue-posts issue)))) @@ -165,6 +174,23 @@ to run tissue." (newline) (newline))) +(define (alist->document alist) + "Convert ALIST to an or object." + ((case (assq-ref alist 'type) + ((issue) alist->issue) + ((document) doc:alist->document) + (else (raise (unknown-document-type-violation alist)))) + alist)) + +(define (document->text document) + "Return the text of DOCUMENT, an or object." + (call-with-input-file + ((cond + ((issue? document) issue-file) + ((doc:document? document) doc:document-file) + (else (raise (unknown-document-type-violation document)))) + document) + get-string-all)) (define tissue-search (match-lambda* @@ -203,12 +229,11 @@ Search issues using SEARCH-QUERY. ("is" . "XS"))))) (format #t "total ~a~%" (mset-fold (lambda (item count) - (let ((issue (call-with-input-string (document-data (mset-item-document item)) - (compose alist->issue read)))) - (print-issue issue) + (let ((document (call-with-input-string (document-data (mset-item-document item)) + (compose alist->document read)))) + (print-document document) (let ((snippet (mset-snippet (MSetIterator-mset-get item) - (call-with-input-file (issue-file issue) - get-string-all) + (document->text document) #:length 200 #:highlight-start (color 'BOLD 'ON-RED) #:highlight-end (color 'RESET) @@ -349,6 +374,15 @@ top-level of the git repository." (negate (cut member <> (list "." ".."))))) (rmdir %xapian-index))) +(define (index-document db document) + "Index DOCUMENT, an or object, in writable xapian +DB." + ((cond + ((issue? document) index-issue) + ((doc:document? document) doc:index-document) + (else (raise (unknown-document-type-violation document)))) + db document)) + (define main (match-lambda* ((_ (or "-h" "--help")) @@ -382,8 +416,9 @@ top-level of the git repository." (delete-xapian-index) (call-with-writable-database %xapian-index (lambda (db) - (for-each (cut index-issue db <>) - (issues)) + (for-each (lambda (indexed-document) + (index-document db ((indexed-document-reader indexed-document)))) + (tissue-configuration-indexed-documents (load-config))) (WritableDatabase-set-metadata db "commit" current-head)))))) ;; Handle sub-command. (apply (match command diff --git a/tissue/tissue.scm b/tissue/tissue.scm index decd630..3bc6e41 100644 --- a/tissue/tissue.scm +++ b/tissue/tissue.scm @@ -25,18 +25,19 @@ tissue-configuration? tissue-configuration-project tissue-configuration-aliases - tissue-configuration-issue-files + tissue-configuration-indexed-documents tissue-configuration-web-css tissue-configuration-web-tags-path tissue-configuration-web-files gemtext-files-in-directory)) (define-record-type - (make-tissue-configuration project aliases issue-files web-css web-tags-path web-files) + (make-tissue-configuration project aliases indexed-documents + web-css web-tags-path web-files) tissue-configuration? (project tissue-configuration-project) (aliases tissue-configuration-aliases) - (issue-files tissue-configuration-issue-files) + (indexed-documents tissue-configuration-indexed-documents) (web-css tissue-configuration-web-css) (web-tags-path tissue-configuration-web-tags-path) (web-files delayed-tissue-configuration-web-files)) @@ -64,7 +65,7 @@ which directory they are in." #:web-files)) #'(args ...)))) #`(apply (lambda* (#:key project (aliases '()) - (issue-files (gemtext-files-in-directory)) + (indexed-documents '()) web-css (web-tags-path "/tags") (web-files '())) "PROJECT is the name of the project. It is used in the title of the generated web pages, among other places. @@ -73,7 +74,8 @@ ALIASES is a list of aliases used to refer to authors in the repository. Each element is in turn a list of aliases an author goes by, the first of which is the canonical name of that author. -ISSUE-FILES is a list of files that pertain to issues. +INDEXED-DOCUMENTS is a list of objects +representing documents to index. WEB-CSS is the path to a CSS stylesheet. It is relative to the document root and must begin with a /. If it is #f, no stylesheet is @@ -84,7 +86,7 @@ per-tag issue listings are put. It must begin with a /. WEB-FILES is a list of objects representing files to be written to the web output." - (make-tissue-configuration project aliases issue-files web-css web-tags-path web-files)) + (make-tissue-configuration project aliases indexed-documents web-css web-tags-path web-files)) (list #,@(append before (syntax-case after () ((web-files-key web-files rest ...) -- cgit v1.2.3