From a8023a99111233fec4b6050c6de3130097e84483 Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Wed, 29 Jun 2022 00:18:18 +0530
Subject: web: server: Add web server for search.

* tissue/web/server.scm: New file.
* tissue/document.scm (document-sxml-snippet): New public function.
(document->sxml): New generic method.
* tissue/issue.scm: Import (web uri).
(document->sxml): New generic method.
* bin/tissue: Import (system repl server) and (tissue web server).
(address->socket-address, tissue-run-web): New function.
(print-usage): List `tissue run-web' subcommand.
(main): Call tissue-run-web.
---
 tissue/document.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

(limited to 'tissue/document.scm')

diff --git a/tissue/document.scm b/tissue/document.scm
index 86fa548..2806f3b 100644
--- a/tissue/document.scm
+++ b/tissue/document.scm
@@ -41,6 +41,8 @@
             document-term-generator
             document-snippet
             print
+            document-sxml-snippet
+            document->sxml
             <file-document>
             file-document-path
             read-gemtext-document))
@@ -206,6 +208,42 @@ MSet object representing a list of search results."
       (newline)
       (newline))))
 
+(define (document-sxml-snippet document mset)
+  "Return snippet in SXML form for DOCUMENT. MSET is the xapian MSet
+object representing a list of search results."
+  ;; mset-snippet returns serialized HTML. So, we reverse it with
+  ;; html->sxml.
+  (match (html->sxml (mset-snippet mset
+                                   (document-text document)
+                                   #:length 200
+                                   #:highlight-start "<b>"
+                                   #:highlight-end "</b>"
+                                   #:stemmer (make-stem "en")))
+    (('*TOP* children ...)
+     (append-map (lambda (child)
+                   (cond
+                    ;; Add (br) if end of line.
+                    ((and (string? child)
+                          (string-suffix? "\n" child))
+                     (list (string-trim-right child #\newline)
+                           '(br)))
+                    ;; Else, return verbatim.
+                    (else
+                     (list child))))
+                 children))))
+
+(define-method (document->sxml (document <file-document>) mset)
+  "Render DOCUMENT to SXML. MSET is the xapian MSet object representing
+a list of search results."
+  `(li (@ (class "search-result"))
+       (a (@ (href ,(document-web-uri document)))
+          ,(document-title document))
+       ,@(let ((snippet (document-sxml-snippet document mset)))
+           (if snippet
+               (list `(span (@ (class "search-result-snippet"))
+                            ,@snippet))
+               (list)))))
+
 (define (read-gemtext-document file)
   "Reade gemtext document from FILE. Return a <file-document> object."
   (make <file-document>
-- 
cgit v1.2.3