dev: Implement development web server.

* tissue/web/dev.scm: New file.

1 files changed, 78 insertions, 0 deletions

diff --git a/tissue/web/dev.scm b/tissue/web/dev.scm
new file mode 100644
index 0000000..ba43930
--- /dev/null
+++ b/tissue/web/dev.scm
@@ -0,0 +1,78 @@
+;;; 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 web dev)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 filesystem)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web server)
+  #:use-module (web uri)
+  #:use-module (xapian xapian)
+  #:use-module (tissue utils)
+  #:use-module (tissue web server)
+  #:use-module (tissue web static)
+  #:export (start-dev-web-server))
+
+(define (handler request body xapian-index css files)
+  "Handle web @var{request} with @var{body} and return two values---the
+response headers and body. See @code{start-dev-web-server} for
+documentation of @var{xapian-index}, @var{css} and @var{files}."
+  (let ((path (uri-path (request-uri request))))
+    (log-request request)
+    (cond
+     ;; Search page
+     ((member path (list "/" "/search"))
+      (search-handler request body xapian-index css))
+     ;; Files
+     ((any (lambda (web-file)
+             (cond
+              ((find (cut string=?
+                          (string-append "/" (file-name web-file))
+                          <>)
+                     (try-paths path))
+               => (cut file <> (file-writer web-file)))
+              (else #f)))
+           files)
+      => (lambda (file)
+           (values `((content-type . ,(mime-type-for-extension
+                                       (file-name-extension (file-name file)))))
+                   (call-with-values open-bytevector-output-port
+                     (lambda (port get-bytevector)
+                       ((file-writer file) port)
+                       (get-bytevector))))))
+     ;; Not found
+     (else
+      (404-response request)))))
+
+(define (start-dev-web-server port xapian-index css files)
+  "Start development web server listening on
+@var{port}. @var{xapian-index} is the path to the Xapian index to
+search in. @var{css} is a URI to a stylesheet. @var{files} is a list
+of @code{<file>} objects describing files to serve."
+  (format (current-error-port)
+          "Tissue development web server listening at http://localhost:~a~%" port)
+  ;; Explicitly dereference the module and handler variable each time
+  ;; so as to support live hacking.
+  (run-server (cut (module-ref (resolve-module '(tissue web dev))
+                               'handler)
+                   <> <> xapian-index css files)
+              'http
+              (list #:port port)))