summaryrefslogtreecommitdiff
path: root/tissue/web/dev.scm
blob: 5ca7d16abe1002a09ed11b77534f21bef9f5ab01 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
;;; tissue --- Text based issue tracker
;;; Copyright © 2022, 2023 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 tissue)
  #: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 project-thunk)
  "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} and @var{project-thunk}."
  ;; The project configuration could have changed between requests and
  ;; we want to read the latest configuration on each request. So, we
  ;; require a thunk that loads the project configuration, rather than
  ;; the project configuration itself.
  (let ((project (project-thunk))
        (path (uri-path (request-uri request))))
    (log-request request)
    (cond
     ;; 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)))
           (tissue-configuration-web-files project))
      => (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))))))
     ;; Search page. We look for the search page only after files
     ;; because we want to let files shadow the search page if
     ;; necessary.
     ((member path (list "/" "/search"))
      (search-handler request body xapian-index project))
     ;; Not found
     (else
      (404-response request)))))

(define (start-dev-web-server port xapian-index project-thunk)
  "Start development web server listening on
@var{port}. @var{xapian-index} is the path to the Xapian index to
search in. @var{project} is a thunk that returns a
@code{<tissue-configuration>} object describing the project."
  (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 project-thunk)
              'http
              (list #:port port)))