summaryrefslogtreecommitdiff
path: root/tissue/tissue.scm
blob: fed9fe3a1baa396bf23a6beb690eb2699785f386 (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
;;; 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 tissue)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-71)
  #:use-module (ice-9 match)
  #:use-module (tissue git)
  #:use-module (tissue web themes default)
  #:export (tissue-configuration
            tissue-configuration?
            tissue-configuration-project
            tissue-configuration-aliases
            tissue-configuration-indexed-documents
            tissue-configuration-web-css
            tissue-configuration-web-search-renderer
            tissue-configuration-web-files
            gemtext-files-in-directory))

(define-record-type <tissue-configuration>
  (make-tissue-configuration project aliases indexed-documents
                             web-css web-search-renderer web-files)
  tissue-configuration?
  (project delayed-tissue-configuration-project)
  (aliases delayed-tissue-configuration-aliases)
  (indexed-documents delayed-tissue-configuration-indexed-documents)
  (web-css delayed-tissue-configuration-web-css)
  (web-search-renderer delayed-tissue-configuration-web-search-renderer)
  (web-files delayed-tissue-configuration-web-files))

(define tissue-configuration-project
  (compose force delayed-tissue-configuration-project))

(define tissue-configuration-aliases
  (compose force delayed-tissue-configuration-aliases))

(define tissue-configuration-indexed-documents
  (compose force delayed-tissue-configuration-indexed-documents))

(define tissue-configuration-web-css
  (compose force delayed-tissue-configuration-web-css))

(define tissue-configuration-web-search-renderer
  (compose force delayed-tissue-configuration-web-search-renderer))

(define tissue-configuration-web-files
  (compose force delayed-tissue-configuration-web-files))

(define* (gemtext-files-in-directory #:optional directory)
  "Return a list of all gemtext files in @var{directory} tracked in the
current git repository. The returned paths are relative to the
top-level directory of the current repository and do not have a
leading slash.

If @var{directory} is unspecified, return the list of all gemtext
files tracked in the current git repository regardless of which
directory they are in."
  (filter (lambda (filename)
            (and (or (not directory)
                     (string-prefix? directory filename))
                 (string-suffix? ".gmi" filename)))
          (git-tracked-files (current-git-repository))))

(define-syntax define-lazy
  (lambda (x)
    "Define function that lazily evaluates all its arguments."
    (syntax-case x ()
      ((_ (name formal-args ...) body ...)
       (with-syntax ((delayed-formal-args
                      (map (lambda (formal-arg)
                             (syntax-case formal-arg ()
                               ((name default-value)
                                #'(name (delay default-value)))
                               (x #'x)))
                           #'(formal-args ...))))
         #`(define-syntax name
             (lambda (x)
               (with-ellipsis :::
                 (syntax-case x ()
                   ((_ args :::)
                    #`((lambda* delayed-formal-args
                         body ...)
                       #,@(map (lambda (arg)
                                 (if (keyword? (syntax->datum arg))
                                     arg
                                     #`(delay #,arg)))
                               #'(args :::)))))))))))))

(define-lazy (tissue-configuration #:key project (aliases '()) (indexed-documents '())
                                   web-css
                                   (web-search-renderer (default-theme))
                                   (web-files '()))
  "Construct a <tissue-configuration> object. All arguments are
evaluated lazily.

@var{project} is the name of the project. It is used in the title of
the generated web pages, among other places.

@var{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.

@var{indexed-documents} is a list of @code{<document>} objects (or
objects of classes inheriting from @code{<document>}) representing
documents to index.

@var{web-css} is the path to a CSS stylesheet. It is relative to the
document root and must begin with a @code{\"/\"}. If it is @code{#f},
no stylesheet is used in the generated web pages.

@var{web-search-renderer} is a function that accepts two arguments---a
@code{<search-page>} object describing the search page and a
@code{<tissue-configuration>} object describing the project. It must
return the rendered SXML.

@var{web-files} is a list of @code{<file>} objects representing files to be
written to the web output."
   (make-tissue-configuration project aliases indexed-documents
                              web-css web-search-renderer web-files))