blob: 2b910cbdaecea64fbabe95ba70d944938ee5248a (
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
;;; 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 static)
#:use-module (rnrs exceptions)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-28)
#:use-module (srfi srfi-171)
#:use-module (ice-9 filesystem)
#:use-module (skribilo engine)
#:use-module (skribilo evaluator)
#:use-module (skribilo reader)
#:use-module (web uri)
#:use-module (git)
#:use-module (tissue git)
#:use-module (tissue issue)
#:use-module (tissue utils)
#:export (file
file?
file-name
file-writer
replace-extension
copier
html-engine
gemtext-reader
gemtext-exporter
skribe-exporter
build-website))
(define-record-type <file>
(file name writer)
file?
(name file-name)
(writer file-writer))
(define (replace-extension file new-extension)
"Return a new filename where the extension of FILE is replaced with
NEW-EXTENSION."
(string-append (substring file 0 (1+ (string-index-right file #\.)))
new-extension))
(define (exporter file proc)
"Return a writer function that exports @var{file} using
@var{proc}. @var{proc} is passed two arguments---the input port to
read from and the output port to write to."
(lambda (out)
(call-with-input-file file
(cut proc <> out))))
(define (copier file)
"Return a writer function that copies @var{file}."
(exporter file
(lambda (in out)
(port-transduce (tmap (cut put-bytevector out <>))
(const #t)
get-bytevector-some
in))))
(define (engine-custom-set engine key value)
"Set custom @var{key} of @var{engine} to @var{value}. This is a purely
functional setter that operates on a copy of @var{engine}. It does not
mutate @var{engine}."
(let ((clone (copy-engine (engine-ident engine) engine)))
(engine-custom-set! clone key value)
clone))
(define* (html-engine #:key css)
"Return a new HTML engine.
@var{css} is the URI to a CSS stylesheet. If it is @code{#f}, no
stylesheet is included in the generated web pages."
(if css
(engine-custom-set (find-engine 'html)
'css
(list css))
(find-engine 'html)))
(define (gemtext-reader)
"Return a skribilo reader for gemtext."
((reader:make (lookup-reader 'gemtext))
;; Relax the gemtext standard by joining adjacent lines.
#:join-lines? #t))
(define* (gemtext-exporter file #:key (reader (gemtext-reader))
(engine (html-engine)))
"Return a writer function that reads gemtext @var{file} using
@var{reader} and exports it using @var{engine}."
(skribe-exporter file
#:reader reader
#:engine engine))
(define* (skribe-exporter file #:key (reader (make-reader 'skribe))
(engine (html-engine)))
"Return a writer function that reads skribe @var{file} using
@var{reader} and exports it using @var{engine}."
(exporter file
(lambda (in out)
(with-output-to-port out
(cut evaluate-document
(evaluate-ast-from-port in #:reader reader)
engine)))))
(define* (build-website output-directory files
#:key (log-port (current-error-port)))
"Export git repository to OUTPUT-DIRECTORY as a website. The current
directory must be the top level of the repository being exported.
FILES is a list of <file> objects representing files to be written to
the web output.
Log to LOG-PORT. When LOG-PORT is #f, do not log."
;; Create output directory.
(make-directories output-directory)
;; Move into a temporary clone of the git repository, and write each
;; of the <file> objects.
(for-each (lambda (file)
(let ((output-file
(string-append output-directory "/" (file-name file))))
(when log-port
(display (file-name file) log-port)
(newline log-port))
(make-directories (dirname output-file))
(call-with-output-file output-file
(cut (file-writer file) <>))))
files))
|
