diff options
45 files changed, 1902 insertions, 807 deletions
diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..ecfaf0e --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,20 @@ +;;; Directory Local Variables +;;; For more information see (info "(emacs) Directory Variables") + +((nil + (indent-tabs-mode)) + (makefile-gmake-mode + (indent-tabs-mode t)) + (scheme-mode + (eval . (put 'call-with-current-directory 'scheme-indent-function 1)) + (eval . (put 'call-with-temporary-checkout 'scheme-indent-function 1)) + (eval . (put 'function-documentation 'scheme-indent-function 2)) + (eval . (put 'docstring-function-documentation 'scheme-indent-function 2)) + (eval . (put 'with-ellipsis 'scheme-indent-function 1)) + (eval . (put 'with-variable 'scheme-indent-function 2)) + (eval . (put 'with-variables 'scheme-indent-function 1)) + (eval . (font-lock-add-keywords 'scheme-mode + (list (cons (rx "(" (group "define-lazy")) + (list 1 'font-lock-keyword-face)) + (cons (rx "(define-lazy (" (group (one-or-more (not space)))) + (list 1 'font-lock-function-name-face))))))) diff --git a/.guix-authorizations b/.guix-authorizations new file mode 100644 index 0000000..a8ef8be --- /dev/null +++ b/.guix-authorizations @@ -0,0 +1,4 @@ +(authorizations + (version 0) + (("7F73 0343 F2F0 9F3C 77BF 79D3 2E25 EE8B 6180 2BB3" + (name "arunisaac")))) diff --git a/.guix-channel b/.guix-channel new file mode 100644 index 0000000..35e181f --- /dev/null +++ b/.guix-channel @@ -0,0 +1,3 @@ +(channel + (version 0) + (directory ".guix")) diff --git a/.guix/tissue-package.scm b/.guix/tissue-package.scm new file mode 100644 index 0000000..23590bf --- /dev/null +++ b/.guix/tissue-package.scm @@ -0,0 +1,70 @@ +;;; 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-package) + #:use-module ((gnu packages fonts) #:select (font-ibm-plex)) + #:use-module ((gnu packages guile) #:select (guile-git) #:prefix guix:) + #:use-module ((gnu packages version-control) #:select (libgit2-1.3) #:prefix guix:) + #:use-module ((gnu packages web) #:select (tissue) #:prefix guix:) + #:use-module (guix gexp) + #:use-module (guix git-download) + #:use-module (guix packages) + #:use-module (guix utils)) + +;; Run this version of libgit2 for guile-git until guile-git is +;; updated upstream and https://github.com/libgit2/libgit2/issues/6536 +;; is fixed. +(define libgit2 + (package + (inherit guix:libgit2-1.3) + (name "libgit2") + (arguments + (substitute-keyword-arguments (package-arguments guix:libgit2-1.3) + ((#:phases phases #~%standard-phases) + #~(modify-phases #$phases + ;; Disable ownership validation until + ;; https://github.com/libgit2/libgit2/issues/6536 is fixed. + (add-after 'unpack 'disable-ownership-validation + (lambda _ + (substitute* "src/repository.c" + (("git_repository__validate_ownership = true") + "git_repository__validate_ownership = false")))))))))) + +(define guile-git + (package + (inherit guix:guile-git) + (inputs + (modify-inputs (package-inputs guix:guile-git) + (replace "libgit2" libgit2))))) + +(define-public tissue + (package + (inherit guix:tissue) + (source (local-file ".." + "tissue-checkout" + #:recursive? #t + #:select? (or (git-predicate (dirname (current-source-directory))) + (const #t)))) + (inputs + (modify-inputs (package-inputs guix:tissue) + (replace "guile-git" guile-git))) + (native-inputs + (modify-inputs (package-native-inputs guix:tissue) + (prepend font-ibm-plex))))) + +tissue @@ -1,5 +1,6 @@ # tissue --- Text based issue tracker -# Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +# Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +# Copyright © 2023 Morgan Smith <Morgan.J.Smith@outlook.com> # # This file is part of tissue. # @@ -17,44 +18,75 @@ # along with tissue. If not, see <https://www.gnu.org/licenses/>. project = tissue +version = $(subst v,,$(shell git describe --abbrev=0)) # FIXME: Do not hardcode the effective version. guile_effective_version = 3.0 +GIT ?= git +GPG ?= gpg GUILD ?= guild GUILE ?= guile +LZIP ?= lzip +SKRIBILO ?= skribilo prefix ?= /usr/local exec_prefix ?= $(prefix) bindir ?= $(exec_prefix)/bin libdir ?= $(exec_prefix)/lib datarootdir ?= $(prefix)/share +infodir ?= $(datarootdir)/info top_level_module_dir = $(project) -sources = $(wildcard $(top_level_module_dir)/*.scm) $(wildcard $(top_level_module_dir)/web/*.scm) +sources = $(wildcard $(top_level_module_dir)/*.scm) \ + $(wildcard $(top_level_module_dir)/web/*.scm) \ + $(wildcard $(top_level_module_dir)/web/themes/*.scm) objects = $(sources:.scm=.go) scripts = $(wildcard bin/*) -tests = $(wildcard tests/*) +tests = $(wildcard tests/*.scm tests/web/*.scm) +documentation = doc/tissue.skb +info = $(documentation:.skb=.info) +distribute_files = $(sources) $(scripts) $(tests) \ + $(documentation) doc/skribilo.scm \ + COPYING guix.scm Makefile scmdir = $(datarootdir)/guile/site/$(guile_effective_version) godir = $(libdir)/guile/$(guile_effective_version)/site-ccache -.PHONY: all check install clean +.PHONY: all check install clean dist -all: $(objects) +all: $(objects) $(info) + +%.info: %.skb doc/skribilo.scm + GUILE_AUTO_COMPILE=0 $(SKRIBILO) --eval='(add-to-load-path ".")' --target=info --output=$@ $< %.go: %.scm GUILE_AUTO_COMPILE=0 $(GUILD) compile -L . -o $@ $< check: for test in $(tests); do \ - ./pre-inst-env $(GUILE) $$test; \ + $(GUILE) --no-auto-compile -L . $$test; \ done +dist_archive = $(project)-$(version).tar.lz + +dist: $(dist_archive) $(dist_archive).asc + +$(dist_archive): .git/refs/heads/main + $(GIT) archive --prefix $(basename $(basename $@))/ --format=tar main $(distribute_files) \ + | $(LZIP) --force --output $@ + +%.asc: % + $(GPG) --detach-sign --armor $< + install: install -D $(scripts) --target-directory $(bindir) - mkdir -p $(scmdir) $(godir) - cp --parents -vr $(sources) $(scmdir) - cp --parents -vr $(objects) $(godir) + for source in $(sources); do \ + install -D $$source $(scmdir)/$$source; \ + done + for object in $(objects); do \ + install -D $$object $(godir)/$$object; \ + done + install -D $(info) --target-directory $(infodir) clean: - rm -f $(objects) + rm -f $(objects) $(info) @@ -1,9 +1,11 @@ #!/usr/bin/env sh -exec guile --no-auto-compile -s "$0" "$@" +# -*- mode: scheme; -*- +exec guile --no-auto-compile -e main -s "$0" "$@" !# ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2023 Morgan Smith <Morgan.J.Smith@outlook.com> ;;; ;;; This file is part of tissue. ;;; @@ -47,6 +49,7 @@ exec guile --no-auto-compile -s "$0" "$@" (tissue search) (tissue tissue) (tissue utils) + (tissue web dev) (tissue web server) (tissue web static)) @@ -95,8 +98,7 @@ Search issues using SEARCH-QUERY. (lambda (port) (search-map (cut print <> <> port) db (string-join args))) (or (getenv "PAGER") - "less") - "--raw")))))) + "less"))))))) (define tissue-show (match-lambda* @@ -107,7 +109,7 @@ Show the text of FILE. " (command-line-program))) ((file) - (call-with-file-in-git (current-git-repository) file + (call-with-input-file file (lambda (port) (port-transduce (compose @@ -149,10 +151,9 @@ Show the text of FILE. get-line-dos-or-unix port)))))) -(define* (load-config) +(define (load-config) "Load configuration and return <tissue-configuration> object." - (call-with-file-in-git (current-git-repository) "tissue.scm" - (compose eval-string get-string-all))) + (load (canonicalize-path "tissue.scm"))) (define tissue-repl (match-lambda* @@ -277,44 +278,21 @@ Serve repositories specified in CONFIG-FILE over HTTP. (parameterize ((%current-git-repository (repository-open repository-directory))) (cons name - `((css . ,(tissue-configuration-web-css (load-config))) + `((project . ,(call-with-temporary-checkout repository-directory + (lambda (temporary-checkout) + (call-with-current-directory temporary-checkout + load-config)))) (repository-directory . ,repository-directory) (website-directory . ,(string-append state-directory "/" name "/website")) (xapian-directory . ,(string-append state-directory "/" name "/xapian")) ,@parameters)))))) (assq-ref args 'hosts))))))) -(define tissue-web-build - (match-lambda* - (("--help") - (format #t "Usage: ~a web-build WEBSITE-DIRECTORY -Build website of current repository. -" - (command-line-program))) - ((website-directory) - (let ((config (load-config))) - (guard (c (else (format (current-error-port) - "Building website failed.~%") - (raise c))) - (call-with-temporary-directory - (lambda (temporary-output-directory) - (build-website (git-top-level) - temporary-output-directory - (tissue-configuration-web-css config) - (tissue-configuration-web-files config)) - (delete-file-recursively website-directory) - (rename-file temporary-output-directory - website-directory) - (chmod website-directory #o755)) - (dirname website-directory)))) - (format (current-error-port) - "Built website.~%")))) - (define tissue-web-dev (match-lambda* (("--help") - (format #t "Usage: ~a web-dev WEBSITE-DIRECTORY -Serve built website and issues of current repository. + (format #t "Usage: ~a web-dev +Serve website and issues of current repository. --port=PORT run web server listening on PORT (default: 8080) --listen-repl=P run REPL server listening on port or path P @@ -330,21 +308,12 @@ Serve built website and issues of current repository. (string->number arg) result)))) invalid-option - (lambda (arg result) - (acons 'website-directory arg result)) + unrecognized-argument '((port . 8080))))) - (unless (assq-ref args 'website-directory) - (raise (condition (make-user-error-condition) - (make-message-condition "Argument WEBSITE-DIRECTORY is required.")))) (when (assq-ref args 'listen-repl) (start-repl (assq-ref args 'listen-repl))) - (start-web-server (make-socket-address - AF_INET (inet-pton AF_INET "127.0.0.1") (assq-ref args 'port)) - `(("localhost" - (css . ,(tissue-configuration-web-css (load-config))) - (repository-directory . ,(repository-directory (current-git-repository))) - (website-directory . ,(assq-ref args 'website-directory)) - (xapian-directory . ,%xapian-index)))))))) + (start-dev-web-server (assq-ref args 'port) + %xapian-index load-config))))) (define (print-usage) (format #t "Usage: ~a COMMAND [OPTIONS] [ARGS] @@ -356,8 +325,7 @@ COMMAND must be one of the sub-commands listed below: repl run a Guile script in a tissue environment Develop: - web-build build website of current repository - web-dev serve built website and issues of current repository + web-dev serve website and issues of current repository Deploy: web serve one or more repositories over HTTP @@ -370,7 +338,7 @@ To get usage information for one of these sub-commands, run (command-line-program) (command-line-program))) -(define (index db-path) +(define (index db-path indexed-documents) "Index current repository into xapian database at DB-PATH." (guard (c (else (delete-file-recursively db-path) (format (current-error-port) @@ -383,7 +351,7 @@ To get usage information for one of these sub-commands, run (replace-document! db (document-id-term document) (TermGenerator-get-document (document-term-generator document)))) - (tissue-configuration-indexed-documents (load-config))) + indexed-documents) (WritableDatabase-set-metadata db "commit" (oid->string (reference-name->oid (current-git-repository) "HEAD"))))))) @@ -436,36 +404,47 @@ HOSTNAME." (format (current-error-port) "Cloned upstream repository.~%") repository))))) - (let ((config (load-config))) - (parameterize ((%aliases (tissue-configuration-aliases config)) - (%project-name (tissue-configuration-project config))) - ;; Index. - (let ((xapian-directory "xapian")) - (index xapian-directory) - (format (current-error-port) - "Indexed latest changes.~%")) - ;; Build website. - (let ((website-directory "website")) - (guard (c (else (format (current-error-port) - "Building website failed.~%") - (raise c))) - (call-with-temporary-directory - (lambda (temporary-output-directory) - (build-website (git-top-level) - temporary-output-directory - (tissue-configuration-web-css config) - (tissue-configuration-web-files config)) - (delete-file-recursively website-directory) - (rename-file temporary-output-directory - website-directory) - (chmod website-directory #o755)))) - (format (current-error-port) - "Built website.~%"))))))))))) + (call-with-temporary-checkout (git-top-level) + (lambda (temporary-repository-clone) + (let ((config (call-with-current-directory temporary-repository-clone + load-config))) + (parameterize ((%aliases (tissue-configuration-aliases config))) + ;; Add the top level of the git repository to the + ;; load path since there may be user-written + ;; modules in the repository. + (add-to-load-path temporary-repository-clone) + ;; Index. + (unless (file-exists? "xapian") + (mkdir "xapian")) + (let ((xapian-directory (canonicalize-path "xapian"))) + (call-with-current-directory temporary-repository-clone + (cut index + xapian-directory + (tissue-configuration-indexed-documents config))) + (format (current-error-port) + "Indexed latest changes.~%")) + ;; Build website. + (let ((website-directory "website")) + (guard (c (else (format (current-error-port) + "Building website failed.~%") + (raise c))) + (call-with-temporary-directory + (lambda (temporary-output-directory) + (call-with-current-directory temporary-repository-clone + (cut build-website + temporary-output-directory + (tissue-configuration-web-files config))) + (delete-file-recursively website-directory) + (rename-file temporary-output-directory + website-directory))) + (chmod website-directory #o755) + (format (current-error-port) + "Built website.~%")))))))))))))) (define tissue-pull (match-lambda* (("--help") - (format #t "Usage: ~a pull [HOST] + (format #t "Usage: ~a pull [OPTIONS] HOST Pull latest from upstream repositories. -C, --config=CONFIG-FILE read configuration parameters from CONFIG-FILE @@ -490,18 +469,27 @@ Pull latest from upstream repositories. "State directory ~a does not exist.~%" state-directory) (exit #f)) - ;; Pull state for specific host, or for all hosts when none - ;; are specified on the command-line. - (for-each (match-lambda - ((hostname . parameters) - (when (or (not (assq-ref args 'host)) - (string=? hostname (assq-ref args 'host))) - (pull state-directory - hostname - (assq-ref parameters 'upstream-repository))))) - (assq-ref args 'hosts))))))) - -(define (main . args) + ;; Pull state for specificied host. + ;; It is not a good idea to pull for all configured hosts + ;; when no host is specified on the command line. Since + ;; pulling requires executing code in each repository, + ;; pulling for multiple hosts in a single process can cause + ;; interaction of code across hosts. + (let ((hostname (assq-ref args 'host))) + (cond + ((assoc-ref (assq-ref args 'hosts) + hostname) + => (lambda (parameters) + (pull state-directory + hostname + (assq-ref parameters 'upstream-repository)))) + (else + (format (current-error-port) + "Host ~a not found in configuration file." + hostname) + (exit #f))))))))) + +(define (main args) (guard (c ((condition-git-error c) => (lambda (git-error) (display (git-error-message git-error) (current-error-port)) @@ -512,6 +500,17 @@ Pull latest from upstream repositories. (display (condition-message c) (current-error-port)) (newline (current-error-port)) (exit #f))) + ;; Unless LESS is already configured, pass command-line options to + ;; less by setting LESS. This idea is inspired by + ;; git. https://git-scm.com/docs/git-config#git-config-corepager + (unless (getenv "LESS") + (setenv "LESS" "FRX")) + ;; Add the top level of the git repository to the load path since + ;; there may be user-written modules in the repository. + (match args + ((_ (or "repl" "web-dev") _ ...) + (add-to-load-path (git-top-level))) + (_ #t)) (match args ((_ (or "-h" "--help")) (print-usage)) @@ -534,13 +533,13 @@ Pull latest from upstream repositories. (string=? (call-with-database %xapian-index (cut Database-get-metadata <> "commit")) current-head)) - (index %xapian-index))) + (index %xapian-index + (tissue-configuration-indexed-documents config)))) ;; Handle sub-command. (apply (match command ("search" tissue-search) ("show" tissue-show) ("repl" tissue-repl) - ("web-build" tissue-web-build) ("web-dev" tissue-web-dev) (invalid-command (format (current-error-port) "Invalid command `~a'~%~%" @@ -549,7 +548,5 @@ Pull latest from upstream repositories. (exit #f))) args)))))) ;; tissue is an alias for `tissue search' - ((_) - (main "tissue" "search"))))) - -(apply main (command-line)) + ((tissue) + (main (list tissue "search")))))) diff --git a/doc/skribilo.scm b/doc/skribilo.scm new file mode 100644 index 0000000..23a1829 --- /dev/null +++ b/doc/skribilo.scm @@ -0,0 +1,109 @@ +;;; 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 (doc skribilo) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-171) + #:use-module (ice-9 match) + #:use-module (texinfo) + #:use-module (skribilo package base) + #:export (file + docstring-function-documentation + function-documentation)) + +;; Aliases +(define file samp) + +(define-record-type <function> + (function name arguments docstring) + function? + (name function-name) + (arguments function-arguments) + (docstring function-docstring)) + +(define (find-function-definition file name) + "Return a @code{<function>} object describing a function named +@var{name} in @var{file}." + (call-with-input-file file + (cut port-transduce + (tmap identity) + (rany (match-lambda + (((or 'define 'define* 'define-lazy) + ((? (cut eq? name <>)) arguments ...) + docstring + body ...) + (function name arguments docstring)) + (_ #f))) + read + <>))) + +(define (stexi->skribe stexi) + "Convert @var{stexi}, a stexinfo tree, to a skribe tree." + (match stexi + (('*fragment* children ...) + (map stexi->skribe children)) + (('para children ...) + (cons 'paragraph children)))) + +(define (quoted-write object port) + "Write @var{object} to @var{port} printing quoted expressions using +the quote character." + (match object + (('quote child) + (display "'" port) + (quoted-write child port)) + ((parent children ...) + (display "(" port) + (quoted-write parent port) + (unless (null? children) + (display " " port)) + (for-each (cut quoted-write <> port) + children) + (display ")" port)) + (_ (write object port)))) + +(define (docstring-function-documentation file name) + "Document function of @var{name} from @var{file} using its docstring." + (let ((function (or (find-function-definition file name) + (error "Function not found in file:" name file)))) + (item #:key (code (list "(" + (bold (symbol->string name)) + (unless (null? (function-arguments function)) + " ") + (string-join (map (lambda (element) + (call-with-output-string + (cut quoted-write element <>))) + (function-arguments function))) + ")")) + (map (cut eval <> (current-module)) + (stexi->skribe + (texi-fragment->stexi + (function-docstring function))))))) + +(define (function-documentation name arguments . documentation) + "Document function of @var{name} with @var{arguments} and +@var{documentation}." + (apply item + #:key (code (list "(" + (bold (symbol->string name)) + " " + arguments + ")")) + documentation)) diff --git a/doc/tissue.skb b/doc/tissue.skb new file mode 100644 index 0000000..61ca112 --- /dev/null +++ b/doc/tissue.skb @@ -0,0 +1,234 @@ +;;; 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/>. + +(use-modules (doc skribilo)) + +(document :title [tissue] + (toc) + (chapter :title [Introduction] + :ident "chapter-introduction" + (p [tissue is an issue tracker and project information management +system built on plain text files and git. It is specifically intended +for small free software projects. It features a static site generator +to build a project website and a powerful search interface to search +through project issues and documentation. The search interface is +built on the ,(ref :url "https://xapian.org/" :text "Xapian search +engine library"), and is available both as a command-line program and +as a web server.]) + (section :title "Why tissue?" + (subsection :title "tissue is not discussion-oriented" + (p [tissue moves away from the discussion-oriented style of popular +issue trackers such as the GitHub issue tracker. It separates the +discussion of an issue from the documentation of it. You discuss +somewhere else (say, on a mailing list, on IRC, or even +face-to-face), and then distill the discussion into a coherent issue +report that reads cleanly from top to bottom. Too often, the problem +with discussion-oriented issue trackers like GitHub is that new +readers of the issue have to follow the whole discussion from start to +finish and put it all together in their head to understand what's +going on. This is tiring, and sometimes people simply give up on +reading issues that have long discussions. It's much better to have a clear +succinct actionable issue report. This way, the issue tracker is a list of +clear actionable items rather than a mess of unreproducible issues.])) + (subsection :title "tissue allows and encourages rewriting of issues" + (p [Discussion-oriented issue trackers force an append-only +style where updates to the issue are only possible as newly appended +messages to the discussion. tissue, on the other hand, allows and +encourages rewriting of issues to keep the overall issue easily +readable to a newcomer.])))) + (chapter :title [Tutorial] + :ident "chapter-tutorial" + (p [In this tutorial, we will learn how to create issues for an +existing project, and how to publish those issues on the web.]) + (section :title [Creating issues] + (p [We start with a git repository for our project.]) + (prog :line #f [~/my-project$]) + (p [The repository presumably has project source code committed +in it. We now create a directory ,(file "issues") and populate it with +a few issues.]) + (prog :line #f [~/my-project$ mkdir issues]) + (p [Each issue is a ,(ref :url +"https://gemini.circumlunar.space/docs/cheatsheet.gmi" :text +"gemtext") file. Let's write our first issue ,(file +"issues/crash-on-invalid-query.gmi") and commit it.]) + (prog :line #f [# Search engine crashes on invalid query + +* tags: bug +* assigned: Arun Isaac + +When a syntatically invalid search query is entered into the search +engine, the search engine process crashes. Further queries all return +a 500 Internal Server Error.]) + (prog :line #f [~/my-project$ git add issues/crash-on-invalid-query.gmi +~/my-project$ git commit -m "Add first issue"]) + (p [Let's add a second issue ,(file +"issues/add-emacs-interface.gmi") and commit it.]) + (prog :line #f [# Add Emacs interface + +* tags: feature-request + +Add Emacs interface to search for issues.]) + (prog :line #f [~/my-project$ git add issues/add-emacs-interface.gmi +~/my-project$ git commit -m "Add second issue"]) + (p [Now that we have a couple of issues, let's tell tissue about +them. We do this using a configuration file ,(file "tissue.scm").]) + (prog :line #f [(tissue-configuration + #:indexed-documents (map read-gemtext-issue + (gemtext-files-in-directory "issues")))]) + (prog :line #f [~/my-project$ git add tissue.scm +~/my-project$ git commit -m "Add tissue configuration"]) + (p [This tells tissue to index all files in the ,(file "issues") +directory as issues. The ,(code "gemtext-files-in-directory") function +returns a list of filenames (strings) in the ,(file "issues") +directory. The ,(code "read-gemtext-issue") function reads each file +and returns an ,(code "<issue>") object. Now, we may list all issues +on the command line using tissue.]) + (prog :line #f [~/my-project$ tissue +Add Emacs interface feature-request +ISSUE issues/add-emacs-interface.gmi +opened 70 minutes ago by Arun Isaac +Search engine crashes on invalid query (assigned: Arun Isaac) +ISSUE issues/crash-on-invalid-query.gmi +opened 71 minutes ago by Arun Isaac]) + (p [We could also search through and shortlist. The search +interface is a powerful full text search engine powered by the +excellent ,(ref :url "https://xapian.org/" :text "Xapian") library.]) + (prog :line #f [~/my-project$ tissue search assigned:arun +Search engine crashes on invalid query (assigned: Arun Isaac) +ISSUE issues/crash-on-invalid-query.gmi +opened 76 minutes ago by Arun Isaac + +~/my-project$ tissue search emacs +Add Emacs interface feature-request +ISSUE issues/add-emacs-interface.gmi +opened 87 minutes ago by Arun Isaac +Add Emacs interface +* tags: feature-request +Add Emacs interface to search for... + +~/my-project$ tissue search tag:bug +Search engine crashes on invalid query bug (assigned: Arun Isaac) +ISSUE issues/crash-on-invalid-query.gmi +opened 88 minutes ago by Arun Isaac])) + (section :title [Publishing issues on the web] + (p [Now, let's try to get our issue tracker on the web. tissue +does not treat issue files specially. You will notice that it only +speaks of ,(emph "indexed documents") and not specifically about +issues. We need to explicitly tell it to create web pages for each +issue file and to associate each issue to its respective web page. We +do this with the following ,(file "tissue.scm") configuration.]) + (prog :line #f [(tissue-configuration + #:indexed-documents (map (lambda (filename) + (slot-set (read-gemtext-issue filename) + 'web-uri + (string-append "/" (string-remove-suffix ".gmi" filename)))) + (gemtext-files-in-directory "issues")) + #:web-files (map (lambda (filename) + (file (replace-extension filename "html") + (gemtext-exporter filename))) + (gemtext-files-in-directory "issues")))]) + (prog :line #f [~/my-project$ git add tissue.scm +~/my-project$ git commit -m "Add web configuration"]) + (p [The ,(code "#:indexed-documents") keyword argument is the +same as earlier, but in addition, we set the ,(code "'web-uri") slot +of the ,(code "<issue>") object to the HTTP URI at which the issue may +be found.]) + (p [In order to actually put web pages for each issue at the +aforementioned HTTP URIs, we need the ,(code "#:web-files") keyword +argument. The ,(code "#:web-files") keyword argument takes a list of +,(code "<file>") objects that describe files on the website. Each file +object constitutes a file path and something we call a ,(emph "writer +function"). A writer function is a one-argument function that accepts +a port and writes the contents of a file to it. Here, we use the +,(code "gemtext-exporter") function provided by tissue to create a +writer function for each issue file.]) + (p [Now, to see this in a web interface, run]) + (prog :line #f [~/my-project$ tissue web-dev +Tissue development web server listening at http://localhost:8080]) + (p [Visiting ,(ref :url "http://localhost:8080/") on your +browser should get you the web search interface.])) + ;; TODO + (section :title [Production deployment] + (p [TODO]))) + (chapter :title [Gemtext markup for issues] + :ident "chapter-gemtext-markup" + (p [Issues must be written in ,(ref +:url "https://gemini.circumlunar.space/docs/gemtext.gmi" +:text "gemtext markup") with added extra notation to specify issue +metadata.]) + (p [Tag issues.] + (prog :line #f + [* tags: enhancement, good first issue])) + (p [Close issues. Use either of] + (prog :line #f + [* closed]) + (prog :line #f + [* status: closed])) + (p [Assign issues to one or more people.] + (prog :line #f + [* assigned: mekalai]) + (prog :line #f + [* assigned: muthu, mekalai])) + (p [Create task lists with regular gemtext lists starting with +,(code "[ ]"). Tasks may be marked as completed by putting an +,(code "x") within the brackets, like so: ,(code "[x]")] + (prog :line #f + [* \[x\] Do this. +* \[ \] Then, do this. +* \[ \] Finally, do this.]))) + (chapter :title [Reference] + :ident "chapter-reference" + (section :title [Object and record constructors] + :ident "section-constructors" + (description + (docstring-function-documentation "tissue/tissue.scm" 'tissue-configuration) + (function-documentation 'file [filename writer] + [Construct a ,(code [<file>]) object that represents an +output file to be created.] + (description + (item :key (var [filename]) + [the name of the file to create as a string]) + (item :key (var [writer]) + [a one-argument function that takes a port as an +argument and writes data destined for ,(var [filename]) into that +port]))))) + (section :title [Reader functions] + :ident "section-reader-functions" + (p [These functions produce ,(code [<document>]) objects (or +objects of classes inheriting from ,(code [<document>])) by reading +files or other data sources.]) + (description + (docstring-function-documentation "tissue/issue.scm" 'read-gemtext-issue) + (docstring-function-documentation "tissue/file-document.scm" 'read-gemtext-document) + (docstring-function-documentation "tissue/commit.scm" 'commits-in-current-repository))) + (section :title [Writer functions] + :ident "section-writer-functions" + [These functions write output files and are meant to be +specified in a ,(code [<file>]) object.] + (description + (docstring-function-documentation "tissue/web/static.scm" 'copier) + (docstring-function-documentation "tissue/web/static.scm" 'gemtext-exporter) + (docstring-function-documentation "tissue/web/static.scm" 'skribe-exporter))) + (section :title [Utility functions] + :ident "section-utility-functions" + [These miscellaneous functions are useful when writing tissue +configuration files.] + (description + (docstring-function-documentation "tissue/tissue.scm" 'gemtext-files-in-directory) + (docstring-function-documentation "tissue/git.scm" 'git-tracked-files) + (docstring-function-documentation "tissue/document.scm" 'slot-set))))) @@ -1,65 +1 @@ -;;; 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/>. - -(use-modules (guix build-system gnu) - (guix gexp) - (guix git-download) - ((guix licenses) #:prefix license:) - (guix packages)) - -(define %source-dir (dirname (current-filename))) - -(define tissue - (package - (name "tissue") - (version "0.1.0") - (source (local-file %source-dir - #:recursive? #t - #:select? (git-predicate %source-dir))) - (build-system gnu-build-system) - (arguments - (list #:make-flags #~(list (string-append "prefix=" #$output)) - #:modules `(((guix build guile-build-system) - #:select (target-guile-effective-version)) - ,@%gnu-build-system-modules) - #:phases - (with-imported-modules '((guix build guile-build-system)) - #~(modify-phases %standard-phases - (replace 'patch-source-shebangs - (lambda* (#:key inputs #:allow-other-keys) - (substitute* "bin/tissue" - (("^exec guile") - (string-append "exec " (search-input-file inputs "/bin/guile")))))) - (delete 'configure) - (add-after 'install 'wrap - (lambda* (#:key inputs outputs #:allow-other-keys) - (let ((out (assoc-ref outputs "out")) - (effective-version (target-guile-effective-version))) - (wrap-program (string-append out "/bin/tissue") - `("GUILE_LOAD_PATH" prefix - (,(string-append out "/share/guile/site/" effective-version) - ,(getenv "GUILE_LOAD_PATH"))) - `("GUILE_LOAD_COMPILED_PATH" prefix - (,(string-append out "/lib/guile/" effective-version "/site-ccache") - ,(getenv "GUILE_LOAD_COMPILED_PATH"))))))))))) - (home-page "https://tissue.systemreboot.net") - (synopsis "Text based issue tracker") - (description "tissue is a text based issue tracker.") - (license license:gpl3+))) - -tissue +.guix/tissue-package.scm
\ No newline at end of file diff --git a/issues/allow-checkboxes-without-a-space.gmi b/issues/allow-checkboxes-without-a-space.gmi new file mode 100644 index 0000000..20d016f --- /dev/null +++ b/issues/allow-checkboxes-without-a-space.gmi @@ -0,0 +1,14 @@ +# Allow checkboxes without a space + +* tags: bug + +Checkboxes without a space in them are not detected correctly by our issue gemtext parser. They should be. + +In the example below, the first checklist item is not detected correctly. +``` +* [] Checkbox without a space +* [ ] Checkbox with a space +* [x] Completed checkbox +``` + +* closed diff --git a/issues/corrupted-double-linked-list.gmi b/issues/corrupted-double-linked-list.gmi new file mode 100644 index 0000000..e916e5e --- /dev/null +++ b/issues/corrupted-double-linked-list.gmi @@ -0,0 +1,25 @@ +# corrupted double-linked list + +* tags: bug + +Once the tissue web server has run long enough, it crashes with one of the following error messages. This could be a memory allocation bug in guile-xapian. This crash is observed both in the production and development web servers. + +``` +malloc(): unsorted double linked list corrupted +Aborted +``` + +``` +corrupted double-linked list +Aborted +``` + +## Steps to reproduce + +The easiest way to reproduce this is to run either the production or development web server and stress test it with siege. +=> https://www.joedog.org/siege-home/ + +If the web server is listening on port 8080, run siege as follows. The web server usually crashes in less than a minute. +``` +$ siege http://localhost:8080/search +``` diff --git a/issues/handle-unicode-characters-correctly-in-C-locale.gmi b/issues/handle-unicode-characters-correctly-in-C-locale.gmi new file mode 100644 index 0000000..c11c752 --- /dev/null +++ b/issues/handle-unicode-characters-correctly-in-C-locale.gmi @@ -0,0 +1,5 @@ +# Handle unicode characters correctly in C locale + +* tags: bug + +On the home page of the tissue website, a unicode em dash character is displayed incorrectly as ���. This happens because the website is built by the CI in a C locale, and tissue fails to correctly handle unicode characters in a C locale. This is however not a skribilo bug. skribilo handles unicode characters correctly regardless of the locale. This bug likely arises when tissue copies the output of skribilo and writes it to a file. diff --git a/issues/ignore-preformatted-blocks-in-gemtext-parser.gmi b/issues/ignore-preformatted-blocks-in-gemtext-parser.gmi new file mode 100644 index 0000000..ce05091 --- /dev/null +++ b/issues/ignore-preformatted-blocks-in-gemtext-parser.gmi @@ -0,0 +1,8 @@ +# Ignore preformatted blocks in gemtext issue parser + +* tags: bug + +Our gemtext parser does not ignore preformatted blocks. Case in point is the parser wrongly identifying the issue allow-checkboxes-without-a-space.gmi as having a task list. +=> allow-checkboxes-without-a-space + +* closed diff --git a/issues/incompatibility-between-state-and-web-server.gmi b/issues/incompatibility-between-state-and-web-server.gmi new file mode 100644 index 0000000..2b991bf --- /dev/null +++ b/issues/incompatibility-between-state-and-web-server.gmi @@ -0,0 +1,11 @@ +# Incompatibility between state and web server + +* tags: bug, enhancement + +During upgrades, the new version of the tissue web server may be incompatible with the tissue state (specifically the xapian index—the document data, the slots used, etc.) built by an older version of tissue pull. At present, this will cause tissue to crash. + +At the very least, tissue should produce an error message or warning so that the user can manually run a tissue pull and rebuild the state. This error message should probably appear when the tissue web server is started so that the user can take action before visitors go to a web page and find it crashed. + +More ideally, it would be nice to transparently and automatically rebuild the state without the user having to know anything. But, this may be much harder to do and add more complexity. We need to decide if this additional complexity is worth it. + +To implement either of these solutions, tissue must record some kind of version number in the xapian index so that it can know what version of tissue was used to build a specific index. diff --git a/issues/mirror-on-github.gmi b/issues/mirror-on-github.gmi new file mode 100644 index 0000000..db39c38 --- /dev/null +++ b/issues/mirror-on-github.gmi @@ -0,0 +1,5 @@ +# Mirror on GitHub + +* tags: infrastructure + +Mirror project repository on GitHub for wider visibility. We will not use the GitHub issue tracker or any of its other proprietary features. We will merely use it for hosting our git repository. diff --git a/issues/provide-app-bundle.gmi b/issues/provide-app-bundle.gmi new file mode 100644 index 0000000..512ae44 --- /dev/null +++ b/issues/provide-app-bundle.gmi @@ -0,0 +1,9 @@ +# Provide app bundle + +* tags: infrastructure + +tissue uses several guile libraries, and the state of guile packaging is bad everywhere outside Guix. Potential new non-Guix users of tissue are not going to install Guix just to try out tissue. In order to ease adoption for such users, we must provide “app bundles” like those generated by guix pack. + +Ideally, these app bundles should be provided for every released version of tissue and the latest development version from the git repository. Careful consideration should be given to the version of Guix used to generate each of these app bundles so that these app bundles can be generated reproducibly. + +But, more pragmatically, it may be sufficient to only offer an app bundle for the latest released version since that is what new users will be most interested in. diff --git a/issues/put-up-fosdem-2023-video-on-website.gmi b/issues/put-up-fosdem-2023-video-on-website.gmi new file mode 100644 index 0000000..c0b04cd --- /dev/null +++ b/issues/put-up-fosdem-2023-video-on-website.gmi @@ -0,0 +1,7 @@ +# Put up FOSDEM 2023 video on website + +* tags: website + +Put up the recording of the FOSDEM 2023 tissue talk on the website. The video can serve as good advertising. + +=> https://fosdem.org/2023/schedule/event/tissue/ diff --git a/issues/resolve-aliases-when-searching-for-people.gmi b/issues/resolve-aliases-when-searching-for-people.gmi new file mode 100644 index 0000000..d303f83 --- /dev/null +++ b/issues/resolve-aliases-when-searching-for-people.gmi @@ -0,0 +1,7 @@ +# Resolve aliases when searching for people + +* tags: bug + +We only index canonical names of people using the known aliases. Hence, when searching for people's names, we must also resolve the names in the query before running the search. + +This is best done by using a custom xapian field processor for the relevant search prefixes such as creator:, lastupdater: and assigned:. diff --git a/issues/set-up-public-inbox.gmi b/issues/set-up-public-inbox.gmi new file mode 100644 index 0000000..dd957e5 --- /dev/null +++ b/issues/set-up-public-inbox.gmi @@ -0,0 +1,5 @@ +# Set up public inbox + +* tags: infrastructure + +Set up a public inbox and mailing address for people to discuss tissue. At present, the only way is to reach out to Arun's personal email address, and that's not good for a free software project. Free software projects need a public discussion forum. diff --git a/issues/skribilo-fragment-snippets-need-code-from-repo.gmi b/issues/skribilo-fragment-snippets-need-code-from-repo.gmi new file mode 100644 index 0000000..74109ed --- /dev/null +++ b/issues/skribilo-fragment-snippets-need-code-from-repo.gmi @@ -0,0 +1,19 @@ +# Search snippets for skribilo fragments need code from repo + +* tags: bug + +Skribilo documents are really programs. So, when generating search snippets for skribilo fragments, code from the repo may need to be executed. This is problematic since the web server process does not have the repository in its load path. + +The repository cannot simply be added to the load path since the web server process may be serving multiple repositories and we don't want them to interact. + +Also, evaluating an entire skribilo document on every search query may be costly. In fact, this expense of snippet generation applies equally well to other kinds of documents (issues, texinfo documents, etc.). + +Therefore, it might be worthwhile to inter snippet source texts into the xapian index itself—specifically in the document data field. This will of course increase the size of the xapian index considerably. But, storage is cheap, and there does not seem to be any more elegant way out. + +Until this issue is fixed, we have temporarily disabled snippets for skribilo fragments. + +## Resolution + +Search snippet source texts are now interred into the xapian index. + +* closed diff --git a/issues/tissue-does-not-clean-up-unix-socket-when-deployed-with-shepherd.gmi b/issues/tissue-does-not-clean-up-unix-socket-when-deployed-with-shepherd.gmi new file mode 100644 index 0000000..90092e6 --- /dev/null +++ b/issues/tissue-does-not-clean-up-unix-socket-when-deployed-with-shepherd.gmi @@ -0,0 +1,9 @@ +# tissue does not clean up Unix socket when deployed with shepherd + +* tags: bug + +When deployed with shepherd, and stopped using something like herd stop tissue, the tissue web server does not clean up its Unix socket. This means the next attempt to start tissue fails since the Unix socket file exists already. + +However, when tissue-web is run on the command-line and terminated with a Ctrl-C (SIGINT), it cleans up its Unix socket correctly. + +This issue is likely because tissue is not handling the SIGTERM signal correctly. diff --git a/pre-inst-env b/pre-inst-env index 27803eb..e41d149 100755 --- a/pre-inst-env +++ b/pre-inst-env @@ -1,4 +1,5 @@ #!/usr/bin/env sh +# -*- mode: scheme; -*- exec guile --no-auto-compile -s "$0" "$@" !# diff --git a/tests/git.scm b/tests/git.scm new file mode 100644 index 0000000..bf2d9eb --- /dev/null +++ b/tests/git.scm @@ -0,0 +1,60 @@ +;;; tissue --- Text based issue tracker +;;; Copyright © 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/>. + +(import (srfi srfi-26) + (srfi srfi-64) + (ice-9 match)) + +(define (with-variable variable value thunk) + "Set VARIABLE to VALUE, run THUNK and restore the old value of +VARIABLE. Return the value returned by THUNK." + (let ((old-value (variable-ref variable))) + (dynamic-wind + (cut variable-set! variable value) + thunk + (cut variable-set! variable old-value)))) + +(define (with-variables variable-bindings thunk) + "Set VARIABLE-BINDINGS, run THUNK and restore the old values of the +variables. Return the value returned by THUNK. VARIABLE-BINDINGS is a +list of pairs mapping variables to their values." + (match variable-bindings + (((variable . value) tail ...) + (with-variable variable value + (cut with-variables tail thunk))) + (() (thunk)))) + +(define-syntax-rule (var@@ module-name variable-name) + (module-variable (resolve-module 'module-name) + 'variable-name)) + +(test-begin "git") + +(test-equal "Infer changes by root commit" + '(("foo" . "foo") + ("bar" . "bar")) + (with-variables (list (cons (var@@ (git) commit-parents) + (const (list))) + (cons (var@@ (git) commit-tree) + (const #t)) + (cons (var@@ (git) tree-list) + (const (list "foo" "bar")))) + (cut (@@ (tissue git) commit-file-changes) + #f #f))) + +(test-end "git") diff --git a/tests/issue.scm b/tests/issue.scm index 22982db..97541a0 100644 --- a/tests/issue.scm +++ b/tests/issue.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -19,6 +19,7 @@ (import (rnrs hashtables) (srfi srfi-64) (srfi srfi-71) + (ice-9 match) (tissue issue)) (define hashtable-prepend! @@ -31,10 +32,20 @@ (@@ (tissue issue) file-details)) (define (hashtable->alist hashtable) + "Convert @var{hashtable} to association list with keys sorted as +strings." (let ((keys values (hashtable-entries hashtable))) - (map cons - (vector->list keys) - (vector->list values)))) + (sort (map cons + (vector->list keys) + (vector->list values)) + (match-lambda* + (((key1 . _) (key2 . _)) + (let ((maybe-symbol->string (lambda (x) + (if (symbol? x) + (symbol->string x) + x)))) + (string<? (maybe-symbol->string key1) + (maybe-symbol->string key2)))))))) (test-begin "issue") @@ -75,4 +86,23 @@ (call-with-input-string "* keywords: this is a long keyword" (compose hashtable->alist file-details))) +(test-equal "Parse checkboxes" + '((completed-tasks . 1) + (tasks . 2)) + (call-with-input-string "* [ ] foo +* [x] bar" + (compose hashtable->alist file-details))) + +(test-equal "Allow checkboxes without a space" + '((tasks . 1)) + (call-with-input-string "* [] foo" + (compose hashtable->alist file-details))) + +(test-equal "Ignore preformatted block" + '() + (call-with-input-string "``` +# foo +```" + (compose hashtable->alist file-details))) + (test-end "issue") diff --git a/tests/tissue.scm b/tests/tissue.scm index 6fb01fa..b2aa8e0 100644 --- a/tests/tissue.scm +++ b/tests/tissue.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -18,13 +18,6 @@ (import (srfi srfi-64)) -(define pairify - (@@ (tissue tissue) pairify)) - (test-begin "tissue") -(test-equal "pairify" - '((1 . 2) (3 . 4) (5 . 6)) - (pairify (list 1 2 3 4 5 6))) - (test-end "tissue") diff --git a/tests/web/server.scm b/tests/web/server.scm new file mode 100644 index 0000000..25537ab --- /dev/null +++ b/tests/web/server.scm @@ -0,0 +1,28 @@ +;;; tissue --- Text based issue tracker +;;; Copyright © 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/>. + +(import (srfi srfi-64) + (tissue web server)) + +(test-begin "web-server") + +(test-equal "MIME type of file without extension should be application/octet-stream" + '(application/octet-stream) + (mime-type-for-extension "")) + +(test-end "web-server") @@ -1,21 +1,47 @@ +(use-modules (tissue skribilo) + (tissue web themes default)) + +;; Add current directory to load path so that (doc skribilo) can be +;; found when indexing doc/tissue.skb. +(add-to-load-path (dirname (current-filename))) + +(define %css + "/style.css") + +(define %engine + (html-engine #:css %css)) + (tissue-configuration - #:project "tissue" #:indexed-documents (append (map (lambda (filename) (slot-set (read-gemtext-issue filename) 'web-uri (string-append "/" (string-remove-suffix ".gmi" filename)))) (gemtext-files-in-directory "issues")) + (map (lambda (identifier) + (slot-set (document-fragment "doc/tissue.skb" identifier) + 'web-uri + (string-append "/manual/dev/en/#" + identifier))) + (list "chapter-introduction" + "chapter-tutorial" + "chapter-gemtext-markup" + "section-constructors" + "section-reader-functions" + "section-writer-functions" + "section-utility-functions")) (map (lambda (commit) (slot-set commit 'web-uri (string-append "https://git.systemreboot.net/tissue/commit/?id=" (commit-hash commit)))) (commits-in-current-repository))) - #:web-css "/style.css" + #:web-search-renderer (default-theme #:css %css) #:web-files (cons* (file "index.html" - (skribe-exporter "website/index.skb")) + (skribe-exporter "website/index.skb" #:engine %engine)) (file "style.css" (copier "website/style.css")) + (file "manual/dev/en/index.html" + (skribe-exporter "doc/tissue.skb" #:engine %engine)) (append (map (lambda (font-file) (file (string-append "fonts/" font-file) (copier (string-append (getenv "GUIX_ENVIRONMENT") @@ -24,7 +50,12 @@ "IBMPlexSans-Bold-Latin1.woff2" "IBMPlexMono-Regular-Latin1.woff2" "IBMPlexMono-Bold-Latin1.woff2")) - (filter-map (lambda (filename) - (file (replace-extension filename "html") - (gemtext-exporter filename))) - (gemtext-files-in-directory "issues"))))) + (filter-map (lambda (release-file) + (and (string-prefix? "website/releases/" release-file) + (file (string-append "releases/" (basename release-file)) + (copier release-file)))) + (git-tracked-files (current-git-repository))) + (map (lambda (filename) + (file (replace-extension filename "html") + (gemtext-exporter filename #:engine %engine))) + (gemtext-files-in-directory "issues"))))) diff --git a/tissue/commit.scm b/tissue/commit.scm index 3dfd45f..b910695 100644 --- a/tissue/commit.scm +++ b/tissue/commit.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -39,7 +39,7 @@ (author-date #:getter doc:commit-author-date #:init-keyword #:author-date)) (define-method (document-id-term (commit <commit>)) - "Return the ID term for DOCUMENT." + "Return the ID term for COMMIT." (string-append "Qcommit." (commit-hash commit))) (define-method (document-boolean-terms (commit <commit>)) @@ -48,16 +48,9 @@ (string-append "A" (doc:commit-author commit)))) (define-method (document-recency-date (commit <commit>)) - "Return a date representing the recency of DOCUMENT" + "Return a date representing the recency of COMMIT." (doc:commit-author-date commit)) -(define-method (document-snippet-source-text (commit <commit>)) - "Return the source text for COMMIT from which to extract a search -result snippet." - (commit-body - (commit-lookup (current-git-repository) - (string->oid (commit-hash commit))))) - (define-method (document-text (commit <commit>)) "Return the full text of COMMIT." (commit-message @@ -90,26 +83,6 @@ search results." (newline port) (newline port)))) -(define-method (document->sxml (commit <commit>) mset) - "Render COMMIT, a <commit> object, to SXML. MSET is the xapian MSet -object representing a list of search results." - `(li (@ (class ,(string-append "search-result search-result-commit"))) - (a (@ (href ,(document-web-uri commit)) - (class "search-result-title")) - ,(document-title commit)) - (div (@ (class "search-result-metadata")) - (span (@ (class ,(string-append "document-type commit-document-type"))) - "commit") - ,(string-append - (format #f " authored ~a by ~a" - (human-date-string (doc:commit-author-date commit)) - (doc:commit-author commit)))) - ,@(let ((snippet (document-sxml-snippet commit mset))) - (if snippet - (list `(div (@ (class "search-result-snippet")) - ,@snippet)) - (list))))) - (define (repository-commits repository) "Return a list of <commit> objects representing commits in REPOSITORY." @@ -119,7 +92,14 @@ REPOSITORY." #:hash (oid->string (commit-id commit)) #:author (resolve-alias (signature-name (commit-author commit)) (%aliases)) - #:author-date (commit-author-date commit)) + #:author-date (commit-author-date commit) + ;; The snippet source text excludes the + ;; first paragraph (i.e., the summary line) + ;; of the commit. Hence, we use commit-body. + #:snippet-source-text + (commit-body + (commit-lookup (current-git-repository) + (commit-id commit)))) result)) (list) repository)) diff --git a/tissue/document.scm b/tissue/document.scm index 48d82cc..1e55e67 100644 --- a/tissue/document.scm +++ b/tissue/document.scm @@ -43,12 +43,12 @@ document-snippet-source-text document-snippet print - document-sxml-snippet - document->sxml)) + document-sxml-snippet)) (define (slot-set object slot-name value) - "Set SLOT-NAME in OBJECT to VALUE. This is a purely functional setter -that operates on a copy of OBJECT. It does not mutate OBJECT." + "Set @var{slot-name} in @var{object} to @var{value}. This is a purely +functional setter that operates on a copy of @var{object}. It does not +mutate @var{object}." (let ((clone (shallow-clone object))) (slot-set! clone slot-name value) clone)) @@ -87,7 +87,8 @@ that operates on a copy of OBJECT. It does not mutate OBJECT." (define (object->scm object) "Convert GOOPS OBJECT to a serializable object." (cond - ((or (string? object) + ((or (symbol? object) + (string? object) (number? object) (boolean? object)) object) @@ -107,7 +108,8 @@ that operates on a copy of OBJECT. It does not mutate OBJECT." (define (scm->object scm) "Convert serializable object SCM to a GOOPS object." (cond - ((or (string? scm) + ((or (symbol? scm) + (string? scm) (number? scm) (boolean? scm)) scm) @@ -131,13 +133,14 @@ that operates on a copy of OBJECT. It does not mutate OBJECT." (define-class <document> () (title #:accessor document-title #:init-keyword #:title) - (web-uri #:accessor document-web-uri #:init-keyword #:web-uri)) + (web-uri #:accessor document-web-uri #:init-keyword #:web-uri) + (snippet-source-text #:accessor document-snippet-source-text + #:init-keyword #:snippet-source-text)) (define-generic document-id-term) (define-generic document-text) (define-generic document-recency-date) (define-generic print) -(define-generic document->sxml) (define-method (document-type (document <document>)) (string-trim-both (symbol->string (class-name (class-of document))) @@ -172,21 +175,17 @@ and further text, increase-termpos! must be called before indexing." (index-text! term-generator (document-text document)) term-generator)) -(define-method (document-snippet-source-text (document <document>)) - "Return the source text for DOCUMENT from which to extract a search -result snippet." - ;; Remove blank lines from document text. - (string-join - (remove string-blank? - (string-split (document-text document) - #\newline)) - "\n")) - (define (document-html-snippet document mset) "Return snippet for DOCUMENT. MSET is the xapian MSet object representing a list of search results." (mset-snippet mset - (document-snippet-source-text document) + ;; Remove blank lines from text. + (string-join + (remove string-blank? + (string-split + (document-snippet-source-text document) + #\newline)) + "\n") #:length 200 #:highlight-start "<b>" #:highlight-end "</b>" diff --git a/tissue/file-document.scm b/tissue/file-document.scm index b910131..f389976 100644 --- a/tissue/file-document.scm +++ b/tissue/file-document.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -38,6 +38,7 @@ file-document-created-date file-document-last-updater file-document-last-updated-date + commits-affecting-file read-gemtext-document)) (define-class <file-document> (<document>) @@ -58,7 +59,7 @@ (compose doc:commit-author-date last file-document-commits)) (define-method (document-type (document <file-document>)) - (next-method)) + "document") (define-method (document-id-term (document <file-document>)) "Return the ID term for DOCUMENT." @@ -68,10 +69,14 @@ "Return a date representing the recency of DOCUMENT." (file-document-last-updated-date document)) +(define (file-text file) + "Return the contents of text @var{file}." + (call-with-input-file file + get-string-all)) + (define-method (document-text (document <file-document>)) "Return the full text of DOCUMENT." - (call-with-file-in-git (current-git-repository) (file-document-path document) - get-string-all)) + (file-text (file-document-path document))) (define-method (document-term-generator (document <file-document>)) "Return a term generator indexing DOCUMENT." @@ -116,40 +121,25 @@ MSet object representing a list of search results." (newline port) (newline port)))) -(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 search-result-document")) - (a (@ (href ,(document-web-uri document)) - (class "search-result-title")) - ,(document-title document)) - (div (@ (class "search-result-metadata")) - (span (@ (class ,(string-append "document-type file-document-type"))) - "document") - ,(string-append - (format #f " created ~a by ~a" - (human-date-string (file-document-created-date document)) - (file-document-creator document)) - (if (> (length (file-document-commits document)) - 1) - (format #f ", last updated ~a by ~a" - (human-date-string (file-document-last-updated-date document)) - (file-document-last-updater document)) - ""))) - ,@(let ((snippet (document-sxml-snippet document mset))) - (if snippet - (list `(div (@ (class "search-result-snippet")) - ,@snippet)) - (list))))) - (define file-modification-table-for-current-repository (memoize-thunk (cut file-modification-table (current-git-repository)))) +(define (commits-affecting-file file) + "Return a list of commits affecting @var{file} in current repository." + (map (lambda (commit) + (make <commit> + #:author (resolve-alias (signature-name (commit-author commit)) + (%aliases)) + #:author-date (commit-author-date commit))) + (hashtable-ref (file-modification-table-for-current-repository) + file #f))) + (define (read-gemtext-document file) - "Read gemtext document from FILE. Return a <file-document> object." + "Read gemtext document from @var{file} and return a +@code{<file-document>} object." (make <file-document> - #:title (or (call-with-file-in-git (current-git-repository) file + #:title (or (call-with-input-file file (lambda (port) (port-transduce (tfilter-map (lambda (line) ;; The first level one @@ -162,10 +152,5 @@ a list of search results." ;; Fallback to filename if document has no title. file) #:path file - #:commits (map (lambda (commit) - (make <commit> - #:author (resolve-alias (signature-name (commit-author commit)) - (%aliases)) - #:author-date (commit-author-date commit))) - (hashtable-ref (file-modification-table-for-current-repository) - file #f)))) + #:commits (commits-affecting-file file) + #:snippet-source-text (file-text file))) diff --git a/tissue/git.scm b/tissue/git.scm index 764fba2..70f0de9 100644 --- a/tissue/git.scm +++ b/tissue/git.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -45,9 +45,9 @@ commit-author-date git-tracked-file? git-tracked-files - call-with-file-in-git file-modification-table - clone-options)) + clone-options + call-with-temporary-checkout)) ;; We bind additional functions from libgit2 that are not already ;; bound in guile-git. TODO: Contribute them to guile-git. @@ -93,7 +93,11 @@ directory." (define (git-top-level) "Return the top-level directory of the current git repository." - (dirname (repository-directory (current-git-repository)))) + (let ((repository-directory + (repository-directory (current-git-repository)))) + (if (repository-bare? (current-git-repository)) + repository-directory + (dirname repository-directory)))) (define (head-tree repository) "Return tree of HEAD in REPOSITORY." @@ -122,35 +126,15 @@ directory." path))) (define* (git-tracked-files #:optional (repository (current-git-repository))) - "Return a list of all files and directories tracked in REPOSITORY. The -returned paths are relative to the top-level directory of REPOSITORY -and do not have a leading slash." + "Return a list of all files and directories tracked in +@var{repository}. The returned paths are relative to the top-level +directory of @var{repository} and do not have a leading slash." (tree-list (head-tree repository))) -(define (call-with-file-in-git repository path proc) - "Call PROC on an input port reading contents of PATH. PATH may refer -to a file on the filesystem or in REPOSITORY." - (let ((file-path (if (absolute-file-name? path) - ;; Treat absolute paths verbatim. - path - ;; Treat relative paths as relative to the - ;; top-level of the git repository. - (string-append (dirname (repository-directory repository)) - "/" path)))) - (if (file-exists? file-path) - ;; If file exists on the filesystem, read it. - (call-with-input-file file-path proc) - ;; Else, read the file from the repository. - (let* ((path-tree-entry (tree-entry-bypath (head-tree repository) - path)) - (path-object (tree-entry->object repository path-tree-entry)) - (blob (blob-lookup repository (object-id path-object)))) - (call-with-port (open-bytevector-input-port (blob-content blob)) - proc))))) - -(define (commit-deltas repository commit) - "Return the list of <diff-delta> objects created by COMMIT with -respect to its first parent in REPOSITORY." +(define (commit-file-changes repository commit) + "Return a list of pairs describing files modified by COMMIT with +respect to its first parent in REPOSITORY. Each pair maps the old +filename before COMMIT to the new filename after COMMIT." (match (commit-parents commit) ((parent _ ...) (let ((diff (diff-tree-to-tree repository @@ -158,7 +142,9 @@ respect to its first parent in REPOSITORY." (commit-tree commit)))) (diff-find-similar! diff) (diff-fold (lambda (delta progress result) - (cons delta result)) + (cons (cons (diff-file-path (diff-delta-old-file delta)) + (diff-file-path (diff-delta-new-file delta))) + result)) (lambda (delta binary result) result) (lambda (delta hunk result) @@ -167,7 +153,9 @@ respect to its first parent in REPOSITORY." result) (list) diff))) - (() (list)))) + (() (map (lambda (file) + (cons file file)) + (tree-list (commit-tree commit)))))) (define (file-modification-table repository) "Return a hashtable mapping files to the list of commits in REPOSITORY @@ -176,25 +164,21 @@ that modified them." (renames (make-hashtable string-hash string=?))) (fold-commits (lambda (commit _) - (map (lambda (delta) - ;; Map old filename to current filename if they are - ;; different. Note that this manner of following renames - ;; requires a linear git history and will not work with - ;; branch merges. - (unless (string=? (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta))) - (hashtable-set! renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta)))) - (hashtable-update! result - ;; If necessary, translate old - ;; filename to current filename. - (hashtable-ref renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-old-file delta))) - (cut cons commit <>) - (list))) - (commit-deltas repository commit))) + (map (match-lambda + ((old-file . new-file) + ;; Map old filename to current filename if they are + ;; different. Note that this manner of following renames + ;; requires a linear git history and will not work with + ;; branch merges. + (unless (string=? old-file new-file) + (hashtable-set! renames old-file new-file)) + (hashtable-update! result + ;; If necessary, translate old + ;; filename to current filename. + (hashtable-ref renames old-file old-file) + (cut cons commit <>) + (list)))) + (commit-file-changes repository commit))) #f repository) result)) @@ -206,3 +190,13 @@ that modified them." 'bare (if bare? 1 0)) clone-options)) + +(define (call-with-temporary-checkout repository proc) + "Call PROC with a temporary checkout of REPOSITORY, and delete the +checkout when PROC returns or exits non-locally." + (call-with-temporary-directory + (lambda (temporary-checkout) + (clone repository temporary-checkout) + (proc temporary-checkout)) + ;; The system-dependent temporary directory + (dirname (tmpnam)))) diff --git a/tissue/issue.scm b/tissue/issue.scm index 469b033..14bd75f 100644 --- a/tissue/issue.scm +++ b/tissue/issue.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; Copyright © 2022 Frederick Muriuki Muriithi <fredmanglis@gmail.com> ;;; ;;; This file is part of tissue. @@ -27,7 +27,6 @@ #:use-module (ice-9 regex) #:use-module (oop goops) #:use-module (term ansi-color) - #:use-module (git) #:use-module (web uri) #:use-module (xapian xapian) #:use-module (tissue document) @@ -48,8 +47,7 @@ print-issue print-issue-to-gemtext issues - read-gemtext-issue - index-issue)) + read-gemtext-issue)) (define-class <issue> (<file-document>) (assigned #:accessor issue-assigned #:init-keyword #:assigned) @@ -58,18 +56,26 @@ (tasks #:accessor issue-tasks #:init-keyword #:tasks) (completed-tasks #:accessor issue-completed-tasks #:init-keyword #:completed-tasks)) +(define-method (document-type (issue <issue>)) + "issue") + (define-method (document-boolean-terms (issue <issue>)) "Return the boolean terms in ISSUE." - (append (list (string-append "A" (file-document-creator issue)) - (string-append "XA" (file-document-last-updater issue)) - (string-append "XS" (if (issue-open? issue) + (append (list (string-append "XS" (if (issue-open? issue) "open" "closed"))) - (map (cut string-append "XI" <>) - (issue-assigned issue)) (map (cut string-append "K" <>) (issue-keywords issue)) (next-method))) +(define-method (document-term-generator (issue <issue>)) + "Return a term generator indexing ISSUE." + (let ((term-generator (next-method))) + (index-text! term-generator (file-document-creator issue) #:prefix "A") + (index-text! term-generator (file-document-last-updater issue) #:prefix "XA") + (for-each (cut index-text! term-generator <> #:prefix "XI") + (issue-assigned issue)) + term-generator)) + (define-method (print (issue <issue>) mset port) "Print ISSUE, an <issue> object, in search results." (let ((number-of-posts (length (file-document-commits issue)))) @@ -160,89 +166,6 @@ (newline) (newline))) -(define (sanitize-string str) - "Downcase STR and replace spaces with hyphens." - (string-map (lambda (c) - (case c - ((#\space) #\-) - (else c))) - (string-downcase str))) - -(define-method (document->sxml (issue <issue>) mset) - "Render ISSUE, an <issue> object, to SXML. MSET is the xapian MSet -object representing a list of search results." - `(li (@ (class ,(string-append "search-result search-result-issue " - (if (issue-open? issue) - "search-result-open-issue" - "search-result-closed-issue")))) - (a (@ (href ,(document-web-uri issue)) - (class "search-result-title")) - ,(document-title issue)) - (ul (@ (class "tags")) - ,@(map (lambda (tag) - (let ((words (string-split tag (char-set #\- #\space)))) - `(li (@ (class - ,(string-append "tag" - (string-append " tag-" (sanitize-string tag)) - (if (not (null? (lset-intersection - string=? words - (list "bug" "critical")))) - " tag-bug" - "") - (if (not (null? (lset-intersection - string=? words - (list "progress")))) - " tag-progress" - "") - (if (not (null? (lset-intersection - string=? words - (list "chore")))) - " tag-chore" - "") - (if (not (null? (lset-intersection - string=? words - (list "enhancement" "feature")))) - " tag-feature" - "")))) - (a (@ (href ,(string-append - "/search?query=" - (uri-encode - ;; Quote tag if it has spaces. - (string-append "tag:" - (if (string-any #\space tag) - (string-append "\"" tag "\"") - tag)))))) - ,tag)))) - (issue-keywords issue))) - (div (@ (class "search-result-metadata")) - (span (@ (class ,(string-append "document-type issue-document-type " - (if (issue-open? issue) - "open-issue-document-type" - "closed-issue-document-type")))) - ,(if (issue-open? issue) - "issue" - "✓ issue")) - ,(string-append - (format #f " opened ~a by ~a" - (human-date-string (file-document-created-date issue)) - (file-document-creator issue)) - (if (> (length (file-document-commits issue)) - 1) - (format #f ", last updated ~a by ~a" - (human-date-string (file-document-last-updated-date issue)) - (file-document-last-updater issue)) - "") - (if (zero? (issue-tasks issue)) - "" - (format #f "; ~a of ~a tasks done" - (issue-completed-tasks issue) - (issue-tasks issue))))) - ,@(let ((snippet (document-sxml-snippet issue mset))) - (if snippet - (list `(div (@ (class "search-result-snippet")) - ,@snippet)) - (list))))) - (define (hashtable-prepend! hashtable key new-values) "Prepend NEW-VALUES to the list of values KEY is associated to in HASHTABLE. Deduplicate the resulting list if necessary. If KEY is not @@ -291,17 +214,23 @@ return #f." (define (file-details port) "Return a hashtable of details extracted from input PORT reading a gemtext file." - (let ((result (make-eq-hashtable))) + (let ((result (make-eq-hashtable)) + (in-preformatted #f)) (port-transduce (tmap (lambda (line) (cond + ;; Toggle preformatted state. + ((string=? "```" line) + (set! in-preformatted (not in-preformatted))) + ;; Ignore preformatted blocks. + (in-preformatted #t) ;; Checkbox lists are tasks. If the ;; checkbox has any character other ;; than space in it, the task is ;; completed. - ((string-match "^\\* \\[(.)\\]" line) + ((string-match "^\\* \\[(.*)\\]" line) => (lambda (m) (hashtable-update! result 'tasks 1+ 0) - (unless (string=? (match:substring m 1) " ") + (unless (string-blank? (match:substring m 1)) (hashtable-update! result 'completed-tasks 1+ 0)))) ((list-line->alist line) => (lambda (alist) @@ -350,9 +279,10 @@ gemtext file." result)) (define (read-gemtext-issue file) - "Read issue from gemtext FILE. Return an <issue> object." + "Read issue from gemtext @var{file} and return an @code{<issue>} +object." (let* ((file-document (read-gemtext-document file)) - (file-details (call-with-file-in-git (current-git-repository) file + (file-details (call-with-input-file file file-details)) ;; Downcase keywords to make them ;; case-insensitive. @@ -370,4 +300,5 @@ gemtext file." #:open? (not (member "closed" all-keywords)) #:tasks (hashtable-ref file-details 'tasks 0) #:completed-tasks (hashtable-ref file-details 'completed-tasks 0) - #:commits (file-document-commits file-document)))) + #:commits (file-document-commits file-document) + #:snippet-source-text (document-snippet-source-text file-document)))) diff --git a/tissue/search.scm b/tissue/search.scm index bc60c19..b9feafc 100644 --- a/tissue/search.scm +++ b/tissue/search.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -49,13 +49,13 @@ mapping field names to prefixes." query-parser)) (define %prefixes - '(("title" . "S"))) + '(("title" . "S") + ("creator" . "A") + ("lastupdater" . "XA") + ("assigned" . "XI"))) (define %boolean-prefixes '(("type" . "XT") - ("creator" . "A") - ("lastupdater" . "XA") - ("assigned" . "XI") ("keyword" . "K") ("tag" . "K") ("is" . "XS"))) @@ -97,7 +97,7 @@ when PRED returns #f." query)) (define* (search-fold proc initial db search-query - #:key (offset 0) (maximum-items (database-document-count db))) + #:key (offset 0) (maximum-items 1000)) "Search xapian database DB using SEARCH-QUERY and fold over the results using PROC and INITIAL. @@ -110,20 +110,21 @@ first call. OFFSET specifies the number of items to ignore at the beginning of the result set. MAXIMUM-ITEMS specifies the maximum number of items to return." - (mset-fold (lambda (item result) - (proc (call-with-input-string (document-data (mset-item-document item)) - (compose scm->object read)) - (MSetIterator-mset-get item) - result)) - initial - (enquire-mset (let* ((query (parse-query search-query)) - (enquire (enquire db query))) - ;; Sort by recency date (slot 0) when - ;; query is strictly boolean. - (when (boolean-query? query) - (Enquire-set-sort-by-value enquire 0 #t)) - enquire) - #:maximum-items maximum-items))) + (let ((mset (enquire-mset (let* ((query (parse-query search-query)) + (enquire (enquire db query))) + ;; Sort by recency date (slot 0) when + ;; query is strictly boolean. + (when (boolean-query? query) + (Enquire-set-sort-by-value enquire 0 #t)) + enquire) + #:maximum-items maximum-items))) + (mset-fold (lambda (item result) + (proc (call-with-input-string (document-data (mset-item-document item)) + (compose scm->object read)) + mset + result)) + initial + mset))) (define* (search-map proc db search-query #:key (offset 0) (maximum-items (database-document-count db))) diff --git a/tissue/skribilo.scm b/tissue/skribilo.scm new file mode 100644 index 0000000..8a0a929 --- /dev/null +++ b/tissue/skribilo.scm @@ -0,0 +1,104 @@ +;;; tissue --- Text based issue tracker +;;; Copyright © 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 skribilo) + #:use-module (rnrs conditions) + #:use-module (rnrs exceptions) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (skribilo ast) + #:use-module (skribilo evaluator) + #:use-module (skribilo reader) + #:use-module (tissue document) + #:use-module (tissue file-document) + #:use-module (tissue utils) + #:export (<skribilo-fragment> + skribilo-fragment-filename + skribilo-fragment-identifier + document-fragment)) + +(define-class <skribilo-fragment> (<file-document>) + (identifier #:getter skribilo-fragment-identifier #:init-keyword #:identifier) + (reader-name #:getter skribilo-fragment-reader-name #:init-keyword #:reader-name)) + +(define (document-node file identifier reader-name) + "Return @code{<markup>} object describing node identified by +@var{identifier} in @var{file} read using reader named by +@var{reader-name}." + (find1-down (lambda (node) + (and (is-a? node <markup>) + (markup-ident node) + (string=? (markup-ident node) identifier))) + (call-with-input-file file + (cut evaluate-ast-from-port <> #:reader (make-reader reader-name))))) + +(define (fragment-text file identifier reader-name) + "Return the full text of skribilo fragment in @var{file} identified by +@var{identifier} using reader named by @var{reader-name}." + (call-with-output-string + (cut ast->text + (document-node file identifier reader-name) + <>))) + +(define* (document-fragment file identifier #:key (reader-name 'skribe)) + "Return a @code{<skribilo-fragment>} object describing node identified +by @var{identifier} in @var{file} read using reader named by +@var{reader-name}." + (make <skribilo-fragment> + #:title (ast->string + (markup-option (document-node file identifier reader-name) + #:title)) + #:path file + #:commits (commits-affecting-file file) + #:identifier identifier + #:reader-name reader-name + #:snippet-source-text (fragment-text file identifier reader-name))) + +(define-method (document-id-term (fragment <skribilo-fragment>)) + "Return the ID term for skribilo @var{fragment}." + (string-append "Qskribilofragment." + (file-document-path fragment) + "#" + (skribilo-fragment-identifier fragment))) + +(define (ast->text node port) + "Serialize AST @var{node} into text suitable for indexing. Write +output to @var{port}." + (cond + ((is-a? node <node>) + (for-each (match-lambda + ((_ . value) + (display (ast->string value) port))) + (node-options node)) + (newline port) + (ast->text (node-body node) port)) + ((string? node) + (display node port)) + ((number? node) + (display (number->string node) port)) + ((list? node) + (for-each (lambda (element) + (ast->text element port) port) + node)))) + +(define-method (document-text (fragment <skribilo-fragment>)) + "Return the full text of skribilo @var{fragment}." + (fragment-text (file-document-path fragment) + (skribilo-fragment-identifier fragment) + (skribilo-fragment-reader-name fragment))) diff --git a/tissue/tissue.scm b/tissue/tissue.scm index e7637b4..9180467 100644 --- a/tissue/tissue.scm +++ b/tissue/tissue.scm @@ -22,82 +22,96 @@ #: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-files) + (make-tissue-configuration aliases indexed-documents + web-search-renderer web-files) tissue-configuration? - (project tissue-configuration-project) - (aliases tissue-configuration-aliases) + (aliases delayed-tissue-configuration-aliases) (indexed-documents delayed-tissue-configuration-indexed-documents) - (web-css tissue-configuration-web-css) + (web-search-renderer delayed-tissue-configuration-web-search-renderer) (web-files delayed-tissue-configuration-web-files)) +(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-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 DIRECTORY tracked in the -current git repository. If DIRECTORY is #f, return the list of all -gemtext files tracked in the current git repository regardless of -which directory they are in." + "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 (pairify lst) - "Return a list of pairs of successive elements of LST. For example, - -(pairify (list 1 2 3 4 5 6)) -=> ((1 . 2) (3 . 4) (5 . 6))" - (match lst - (() '()) - ((first second tail ...) - (cons (cons first second) - (pairify tail))))) - -(define-syntax tissue-configuration +(define-syntax define-lazy (lambda (x) + "Define function that lazily evaluates all its arguments." (syntax-case x () - ((_ args ...) - #`((lambda* (#:key project (aliases '()) - (indexed-documents (delay '())) - web-css (web-files (delay '()))) - "PROJECT is the name of the project. It is used in the title of the -generated web pages, among other places. + ((_ (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 (aliases '()) (indexed-documents '()) + (web-search-renderer (default-theme)) + (web-files '())) + "Construct a <tissue-configuration> object. All arguments are +evaluated lazily. -ALIASES is a list of aliases used to refer to authors in the +@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. -INDEXED-DOCUMENTS is a list of <indexed-documents> objects -representing documents to index. +@var{indexed-documents} is a list of @code{<document>} objects (or +objects of classes inheriting from @code{<document>}) representing +documents to index. -WEB-CSS is the path to a CSS stylesheet. It is relative to the -document root and must begin with a /. If it is #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. -WEB-FILES is a list of <file> objects representing files to be written -to the web output." - (make-tissue-configuration project aliases - indexed-documents web-css web-files)) - #,@(append-map (match-lambda - ((key . value) - (if (memq (syntax->datum key) - (list #:indexed-documents #:web-files)) - #`(#,key (delay #,value)) - #`(#,key #,value)))) - (pairify #'(args ...)))))))) +@var{web-files} is a list of @code{<file>} objects representing files to be +written to the web output." + (make-tissue-configuration aliases indexed-documents + web-search-renderer web-files)) diff --git a/tissue/utils.scm b/tissue/utils.scm index 59c0b0a..14cc243 100644 --- a/tissue/utils.scm +++ b/tissue/utils.scm @@ -21,7 +21,9 @@ #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (ice-9 filesystem) + #:use-module (ice-9 match) #:use-module (ice-9 popen) + #:use-module (web uri) #:export (string-blank? string-contains? string-remove-prefix @@ -31,7 +33,9 @@ call-with-temporary-directory call-with-output-pipe get-line-dos-or-unix - memoize-thunk)) + memoize-thunk + query-parameters + query-string)) (define (string-blank? str) "Return #t if STR contains only whitespace. Else, return #f." @@ -120,3 +124,25 @@ ports) in that it also supports DOS line endings." (unless result (set! result (thunk))) result))) + +(define (query-parameters query) + "Return an association list of query parameters in web QUERY string." + (if query + (map (lambda (parameter) + (match (string-split parameter #\=) + ((key value) + (cons (uri-decode key) + (uri-decode value))))) + (string-split query #\&)) + '())) + +(define (query-string parameters) + "Return a query string for association list of PARAMETERS." + (string-join + (map (match-lambda + ((key . value) + (string-append (uri-encode key) + "=" + (uri-encode value)))) + parameters) + "&")) diff --git a/tissue/web/dev.scm b/tissue/web/dev.scm new file mode 100644 index 0000000..5ca7d16 --- /dev/null +++ b/tissue/web/dev.scm @@ -0,0 +1,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))) diff --git a/tissue/web/server.scm b/tissue/web/server.scm index fa26aa5..e8ee9eb 100644 --- a/tissue/web/server.scm +++ b/tissue/web/server.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -25,6 +25,7 @@ #:use-module (srfi srfi-171) #:use-module (ice-9 filesystem) #:use-module (ice-9 match) + #:use-module (oop goops) #:use-module (htmlprag) #:use-module (sxml simple) #:use-module ((system repl server) #:select (make-unix-domain-server-socket)) @@ -38,182 +39,24 @@ (case symbol ((parse-query) 'xapian:parse-query) (else symbol)))) - #:use-module (tissue document) #:use-module (tissue git) #:use-module (tissue search) + #:use-module (tissue tissue) #:use-module (tissue utils) - #:export (start-web-server)) - -(define %css - " -body { - max-width: 1000px; - margin: 0 auto; -} - -form { text-align: center; } -.search-filter { - background-color: gray; - color: white; - padding: 0 0.2em; -} - -.search-results-statistics { - list-style: none; - padding: 0; -} -.search-results-statistics li { - display: inline; - margin: 0.5em; -} -.search-results-statistics a { color: blue; } -.current-search-type { font-weight: bold; } - -.search-results { padding: 0; } -.search-result { - list-style-type: none; - padding: 0.5em; -} -.search-result a { text-decoration: none; } -.document-type { - font-variant: small-caps; - font-weight: bold; -} -.search-result-metadata { - color: dimgray; - font-size: smaller; -} -.search-result-snippet { font-size: smaller; } - -.tags { - list-style-type: none; - padding: 0; - display: inline; -} -.tag { display: inline; } -.tag a { - padding: 0 0.2em; - color: white; - background-color: blue; - margin: auto 0.25em; - font-size: smaller; -} -.tag-bug a { background-color: red; } -.tag-feature a { background-color: green; } -.tag-progress a, .tag-unassigned a { - background-color: orange; - color: black; -} -.tag-chore a { - background-color: khaki; - color: black; -}") - -(define* (make-search-page results query css - #:key - page-uri-path page-uri-parameters - matches - matched-open-issues matched-closed-issues - matched-documents matched-commits - current-search-type) - "Return SXML for a page with search RESULTS produced for QUERY. - -CSS is a URI to a stylesheet. PAGE-URI-PATH is the path part of the -URI to the page. PAGE-URI-PARAMETERS is an association list of -parameters in the query string of the URI of the page. - -MATCHES is the number of matches. MATCHED-OPEN-ISSUES, -MATCHED-CLOSED-ISSUES, MATCHED-DOCUMENTS and MATCHED-COMMITS are -respectively the number of open issues, closed issues, documents and -commits matching the current query. CURRENT-SEARCH-TYPE is the type of -document search results are being showed for." - `(html - (head - (title "Tissue search") - (style ,%css) - ,@(if css - (list `(link (@ (href "/style.css") - (rel "stylesheet") - (type "text/css")))) - (list))) - (body - (form (@ (action "/search") (method "GET")) - (input (@ (type "text") - (name "query") - (value ,query) - (placeholder "Enter search query"))) - (input (@ (type "hidden") - (name "type") - (value ,(symbol->string current-search-type)))) - (input (@ (type "submit") (value "Search")))) - (details (@ (class "search-hint")) - (summary "Hint") - (p "Refine your search with filters " - ,@(append-map (lambda (filter) - (list `(span (@ (class "search-filter")) - ,filter) - ", ")) - (list "type:issue" - "type:document" - "is:open" - "is:closed" - "title:git" - "creator:mani" - "lastupdater:vel" - "assigned:muthu" - "tag:feature-request")) - "etc. Optionally, combine search terms with boolean -operators " - (span (@ (class "search-filter")) - "AND") - " and " - (span (@ (class "search-filter")) - "OR") - ". See " (a (@ (href "https://xapian.org/docs/queryparser.html")) - "Xapian::QueryParser Syntax") - " for detailed documentation.")) - ,(let ((search-result-statistic - (lambda (search-type format-string matches) - `(li (a (@ (href ,(string-append - page-uri-path - "?" - (query-string - (acons "type" (symbol->string search-type) - (alist-delete "type" page-uri-parameters))))) - ,@(if (eq? search-type current-search-type) - '((class "current-search-type")) - '())) - ,(format #f format-string matches)))))) - `(ul (@ (class "search-results-statistics")) - ,(search-result-statistic 'all "~a All" matches) - ,(search-result-statistic 'open-issue "~a open issues" matched-open-issues) - ,(search-result-statistic 'closed-issue "~a closed issues" matched-closed-issues) - ,(search-result-statistic 'document "~a documents" matched-documents) - ,(search-result-statistic 'commit "~a commits" matched-commits))) - (ul (@ (class "search-results")) - ,@results)))) - -(define (query-parameters query) - "Return an association list of query parameters in web QUERY string." - (if query - (map (lambda (parameter) - (match (string-split parameter #\=) - ((key value) - (cons (uri-decode key) - (uri-decode value))))) - (string-split query #\&)) - '())) - -(define (query-string parameters) - "Return a query string for association list of PARAMETERS." - (string-join - (map (match-lambda - ((key . value) - (string-append (uri-encode key) - "=" - (uri-encode value)))) - parameters) - "&")) + #:use-module (tissue web themes) + #:export (log-request + mime-type-for-extension + try-paths + 404-response + search-handler + start-web-server)) + +(define (log-request request) + "Log @var{request} to standard output." + (display (request-method request)) + (display " ") + (display (uri->string (request-uri request))) + (newline)) (define %mime-types '(("gif" image/gif) @@ -227,6 +70,20 @@ operators " ("svg" image/svg+xml) ("txt" text/plain))) +(define (mime-type-for-extension extension) + "Return the mime type for @var{extension}." + (or (assoc-ref %mime-types (if (string-null? extension) + extension + (string-remove-prefix "." extension))) + '(application/octet-stream))) + +(define (404-response request) + "Return a response and body for a 404 error corresponding to +@var{request}." + (values (build-response #:code 404) + (string-append "Resource not found: " + (uri->string (request-uri request))))) + (define (matches db query filter) "Return the number of matches in DB for QUERY filtering with FILTER query. QUERY and FILTER are Xapian Query objects." @@ -236,85 +93,78 @@ query. QUERY and FILTER are Xapian Query objects." db (new-Query (Query-OP-FILTER) query filter)) #:maximum-items (database-document-count db)))) +(define (search-handler request body xapian-index project) + (let* ((parameters (query-parameters (uri-query (request-uri request)))) + (search-query (or (assoc-ref parameters "query") + "")) + (search-type (match (assoc-ref parameters "type") + ((or "open-issue" "closed-issue" "commit" "document") + (string->symbol (assoc-ref parameters "type"))) + (_ 'all))) + (filter-alist `((open-issue . ,(parse-query "type:issue AND is:open")) + (closed-issue . ,(parse-query "type:issue AND is:closed")) + (commit . ,(parse-query "type:commit")) + (document . ,(parse-query "type:document"))))) + (values '((content-type . (text/html))) + (sxml->html + (call-with-database xapian-index + (lambda (db) + ((tissue-configuration-web-search-renderer project) + (let ((query (parse-query search-query))) + (make <search-page> + #:uri (request-uri request) + #:query search-query + #:type search-type + #:mset (enquire-mset + (let* ((query (new-Query (Query-OP-FILTER) + query + (or (assq-ref filter-alist search-type) + (Query-MatchAll)))) + (enquire (enquire db query))) + ;; Sort by recency date (slot 0) when + ;; query is strictly boolean. + (when (boolean-query? query) + (Enquire-set-sort-by-value enquire 0 #t)) + enquire) + #:offset 0 + #:maximum-items 1000) + #:matches (matches db query (Query-MatchAll)) + #:matched-open-issues (matches db query (assq-ref filter-alist 'open-issue)) + #:matched-closed-issues (matches db query (assq-ref filter-alist 'closed-issue)) + #:matched-documents (matches db query (assq-ref filter-alist 'document)) + #:matched-commits (matches db query (assq-ref filter-alist 'commit))))))))))) + +(define (try-paths path) + "Return a list of candidate paths to look for @var{path}." + (if (string-suffix? "/" path) + ;; Try path/index.html. + (list (string-append path "index.html")) + ;; Try path and path.html. + (list path + (string-append path ".html")))) + (define (handler request body hosts) "Handle web REQUEST with BODY and return two values---the response headers and the body. See `start-web-server' for documentation of HOSTS." (let* ((path (uri-path (request-uri request))) - (parameters (query-parameters (uri-query (request-uri request)))) (hostname (match (assq-ref (request-headers request) 'host) ((hostname . _) hostname))) (host-parameters (or (assoc-ref hosts hostname) (raise (condition (make-message-condition "Unknown host") - (make-irritants-condition hostname)))))) - (format #t "~a ~a\n" - (request-method request) - path) + (make-irritants-condition hostname))))) + (repository-directory (assq-ref host-parameters 'repository-directory))) + (log-request request) (parameterize ((%current-git-repository - (repository-open - (assq-ref host-parameters 'repository-directory)))) + (repository-open repository-directory))) (cond - ;; Search page - ((member path (list "/" "/search")) - (let* ((search-query (or (assoc-ref parameters "query") - "")) - (search-type (match (assoc-ref parameters "type") - ((or "open-issue" "closed-issue" "commit" "document") - (string->symbol (assoc-ref parameters "type"))) - (_ 'all))) - (filter-alist `((open-issue . ,(parse-query "type:issue AND is:open")) - (closed-issue . ,(parse-query "type:issue AND is:closed")) - (commit . ,(parse-query "type:commit")) - (document . ,(parse-query "type:document"))))) - (values '((content-type . (text/html))) - (sxml->html - (call-with-database (assq-ref host-parameters 'xapian-directory) - (lambda (db) - (let* ((query (parse-query search-query)) - (mset (enquire-mset - (let* ((query (new-Query (Query-OP-FILTER) - query - (or (assq-ref filter-alist search-type) - (Query-MatchAll)))) - (enquire (enquire db query))) - ;; Sort by recency date (slot - ;; 0) when query is strictly - ;; boolean. - (when (boolean-query? query) - (Enquire-set-sort-by-value enquire 0 #t)) - enquire) - #:offset 0 - #:maximum-items (database-document-count db)))) - (make-search-page - (reverse - (mset-fold (lambda (item result) - (cons (document->sxml - (call-with-input-string (document-data (mset-item-document item)) - (compose scm->object read)) - mset) - result)) - '() - mset)) - search-query - (assq-ref host-parameters 'css) - #:page-uri-path path - #:page-uri-parameters parameters - #:matches (matches db query (Query-MatchAll)) - #:matched-open-issues (matches db query (assq-ref filter-alist 'open-issue)) - #:matched-closed-issues (matches db query (assq-ref filter-alist 'closed-issue)) - #:matched-documents (matches db query (assq-ref filter-alist 'document)) - #:matched-commits (matches db query (assq-ref filter-alist 'commit)) - #:current-search-type search-type)))))))) ;; Static files ((let ((file-path (find file-exists? - ;; Try path and path.html. - (list (string-append (assq-ref host-parameters 'website-directory) - "/" path) - (string-append (assq-ref host-parameters 'website-directory) - "/" path ".html"))))) + (map (cut string-append (assq-ref host-parameters 'website-directory) <>) + (try-paths path))))) (and file-path ;; Check that the file really is within the document ;; root. @@ -322,16 +172,20 @@ See `start-web-server' for documentation of HOSTS." (canonicalize-path file-path)) (canonicalize-path file-path))) => (lambda (file-path) - (values `((content-type . ,(or (assoc-ref %mime-types (string-remove-prefix - "." (file-name-extension file-path))) - '(application/octet-stream)))) + (values `((content-type . ,(mime-type-for-extension + (file-name-extension file-path)))) (call-with-input-file file-path get-bytevector-all)))) + ;; 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 + (assq-ref host-parameters 'xapian-directory) + (assq-ref host-parameters 'project))) ;; Not found (else - (values (build-response #:code 404) - (string-append "Resource not found: " - (uri->string (request-uri request))))))))) + (404-response request)))))) (define (start-web-server socket-address hosts) "Start web server listening on SOCKET-ADDRESS. @@ -356,24 +210,33 @@ list containing parameters for that host." ;; Unix socket ((= (sockaddr:fam socket-address) AF_UNIX) (sockaddr:path socket-address)))) - (run-server (lambda (request body) - ;; Explicitly dereference the module and handler - ;; variable each time so as to support live hacking. - ((module-ref (resolve-module '(tissue web server)) - 'handler) - request body hosts)) - 'http - (cond - ;; IPv4 or IPv6 address - ((or (= (sockaddr:fam socket-address) AF_INET) - (= (sockaddr:fam socket-address) AF_INET6)) - (list #:family (sockaddr:fam socket-address) - #:addr (sockaddr:addr socket-address) - #:port (sockaddr:port socket-address))) - ;; Unix socket - ((= (sockaddr:fam socket-address) AF_UNIX) - (let ((socket (make-unix-domain-server-socket - #:path (sockaddr:path socket-address)))) - ;; Grant read-write permissions to all users. - (chmod (sockaddr:path socket-address) #o666) - (list #:socket socket)))))) + (let ((unix-socket #f)) + (dynamic-wind + (lambda () + (when (= (sockaddr:fam socket-address) AF_UNIX) + (set! socket (make-unix-domain-server-socket + #:path (sockaddr:path socket-address))) + ;; Grant read-write permissions to all users. + (chmod (sockaddr:path socket-address) #o666))) + (cut run-server + (lambda (request body) + ;; Explicitly dereference the module and handler + ;; variable each time so as to support live hacking. + ((module-ref (resolve-module '(tissue web server)) + 'handler) + request body hosts)) + 'http + (cond + ;; IPv4 or IPv6 address + ((or (= (sockaddr:fam socket-address) AF_INET) + (= (sockaddr:fam socket-address) AF_INET6)) + (list #:family (sockaddr:fam socket-address) + #:addr (sockaddr:addr socket-address) + #:port (sockaddr:port socket-address))) + ;; Unix socket + ((= (sockaddr:fam socket-address) AF_UNIX) + (list #:socket socket)))) + (lambda () + ;; Clean up socket file if Unix socket. + (when (= (sockaddr:fam socket-address) AF_UNIX) + (delete-file (sockaddr:path socket-address))))))) diff --git a/tissue/web/static.scm b/tissue/web/static.scm index 69a9d90..2b910cb 100644 --- a/tissue/web/static.scm +++ b/tissue/web/static.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -30,24 +30,22 @@ #: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 (%project-name - file + #:export (file file? file-name file-writer replace-extension copier + html-engine gemtext-reader gemtext-exporter skribe-exporter build-website)) -(define %project-name - (make-parameter #f)) - (define-record-type <file> (file name writer) file? @@ -61,15 +59,15 @@ NEW-EXTENSION." new-extension)) (define (exporter file proc) - "Return a writer function that exports FILE using PROC. PROC is -passed two arguments---the input port to read from and the output port -to write to." + "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-file-in-git (current-git-repository) file + (call-with-input-file file (cut proc <> out)))) (define (copier file) - "Return a writer function that copies FILE." + "Return a writer function that copies @var{file}." (exporter file (lambda (in out) (port-transduce (tmap (cut put-bytevector out <>)) @@ -77,56 +75,63 @@ to write to." 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 #:optional (reader (gemtext-reader))) - "Return a writer function that exports FILE, a gemtext file." - (exporter file - (lambda (in out) - (with-output-to-port out - (cut evaluate-document - (evaluate-ast-from-port in #:reader reader) - (find-engine 'html)))))) +(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 #:optional (reader (make-reader 'skribe))) - "Return a writer function that exports FILE, a skribe file." +(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) - (find-engine 'html)))))) + engine))))) -(define (with-current-directory directory thunk) - "Change current directory to DIRECTORY, execute THUNK and restore -original current directory." - (let ((previous-current-directory (getcwd))) - (dynamic-wind (const #t) - thunk - (cut chdir previous-current-directory)))) - -(define* (build-website repository-top-level output-directory css files +(define* (build-website output-directory files #:key (log-port (current-error-port))) - "Export git repository with REPOSITORY-TOP-LEVEL to OUTPUT-DIRECTORY -as a website. - -CSS is the path to a CSS stylesheet. If it is #f, no stylesheet is -included in the generated web pages. + "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." - ;; Set CSS. - (when css - (engine-custom-set! (find-engine 'html) 'css css)) ;; Create output directory. (make-directories output-directory) - ;; Write each of the <file> objects. + ;; 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)))) @@ -135,7 +140,5 @@ Log to LOG-PORT. When LOG-PORT is #f, do not log." (newline log-port)) (make-directories (dirname output-file)) (call-with-output-file output-file - (lambda (port) - (with-current-directory repository-top-level - (cut (file-writer file) port)))))) + (cut (file-writer file) <>)))) files)) diff --git a/tissue/web/themes.scm b/tissue/web/themes.scm new file mode 100644 index 0000000..648d4d5 --- /dev/null +++ b/tissue/web/themes.scm @@ -0,0 +1,42 @@ +;;; 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 themes) + #:use-module (srfi srfi-26) + #:use-module (oop goops) + #:export (<search-page> + search-page-uri + search-page-query + search-page-type + search-page-mset + search-page-matches + search-page-matched-open-issues + search-page-matched-closed-issues + search-page-matched-documents + search-page-matched-commits)) + +(define-class <search-page> () + (uri #:getter search-page-uri #:init-keyword #:uri) + (query #:getter search-page-query #:init-keyword #:query) + (type #:getter search-page-type #:init-keyword #:type) + (mset #:getter search-page-mset #:init-keyword #:mset) + (matches #:getter search-page-matches #:init-keyword #:matches) + (matched-open-issues #:getter search-page-matched-open-issues #:init-keyword #:matched-open-issues) + (matched-closed-issues #:getter search-page-matched-closed-issues #:init-keyword #:matched-closed-issues) + (matched-documents #:getter search-page-matched-documents #:init-keyword #:matched-documents) + (matched-commits #:getter search-page-matched-commits #:init-keyword #:matched-commits)) diff --git a/tissue/web/themes/default.scm b/tissue/web/themes/default.scm new file mode 100644 index 0000000..10732ee --- /dev/null +++ b/tissue/web/themes/default.scm @@ -0,0 +1,340 @@ +;;; 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 themes default) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (web uri) + #:use-module (xapian xapian) + #:use-module (tissue commit) + #:use-module (tissue document) + #:use-module (tissue file-document) + #:use-module (tissue issue) + #:use-module (tissue utils) + #:use-module (tissue web themes) + #:export (default-theme + <search-page-head> + <search-page-header> + <search-page-form> + <search-page-result> + <search-page-footer>)) + +(define-class <search-page-head> ()) +(define-class <search-page-header> ()) +(define-class <search-page-form> ()) +(define-class <search-page-result> ()) +(define-class <search-page-footer> ()) + +(define %css + " +body { + max-width: 1000px; + margin: 0 auto; +} + +form { text-align: center; } +.search-filter { + background-color: gray; + color: white; + padding: 0 0.2em; +} + +.search-results-statistics { + list-style: none; + padding: 0; +} +.search-results-statistics li { + display: inline; + margin: 0.5em; +} +.search-results-statistics a { color: blue; } +.current-search-type { font-weight: bold; } + +.search-results { padding: 0; } +.search-result { + list-style-type: none; + padding: 0.5em; +} +.search-result a { text-decoration: none; } +.document-type { + font-variant: small-caps; + font-weight: bold; +} +.search-result-metadata { + color: dimgray; + font-size: smaller; +} +.search-result-snippet { font-size: smaller; } + +.tags { + list-style-type: none; + padding: 0; + display: inline; +} +.tag { display: inline; } +.tag a { + padding: 0 0.2em; + color: white; + background-color: blue; + margin: auto 0.25em; + font-size: smaller; +} +.tag-bug a { background-color: red; } +.tag-feature a { background-color: green; } +.tag-progress a, .tag-unassigned a { + background-color: orange; + color: black; +} +.tag-chore a { + background-color: khaki; + color: black; +}") + +(define* (default-theme #:key (title "tissue issue tracker") css) + "Return a generic function that renders a page using the default +theme. + +@var{title} is the title to use in the head of the HTML. @var{css} is +a URI to a CSS stylesheet to link to. If it is @code{#f}, no +stylesheet is linked to." + (add-method! render-sxml + (make <method> + #:specializers (list <search-page-head> <search-page>) + #:procedure (make-head-renderer title css))) + render-sxml) + +(define-method (render-sxml (page <search-page>)) + "Return SXML for @var{page}, a @code{<search-page>}." + `(html + ,(render-sxml (make <search-page-head>) page) + (body + ,(render-sxml (make <search-page-header>) page) + ,(render-sxml (make <search-page-form>) page) + ,(render-sxml (make <search-page-result>) page) + ,(render-sxml (make <search-page-footer>) page)))) + +(define (make-head-renderer title css) + (lambda (_ page) + `(head + (title ,title) + (style ,%css) + ,@(if css + (list `(link (@ (href ,css) + (rel "stylesheet") + (type "text/css")))) + (list))))) + +(define-method (render-sxml (header <search-page-header>) (page <search-page>)) + `(div)) + +(define-method (render-sxml (form <search-page-form>) (page <search-page>)) + `(div + (form (@ (action "/search") (method "GET")) + (input (@ (type "text") + (name "query") + (value ,(search-page-query page)) + (placeholder "Enter search query"))) + (input (@ (type "hidden") + (name "type") + (value ,(symbol->string (search-page-type page))))) + (input (@ (type "submit") (value "Search")))) + (details (@ (class "search-hint")) + (summary "Hint") + (p "Refine your search with filters " + ,@(append-map (lambda (filter) + (list `(span (@ (class "search-filter")) + ,filter) + ", ")) + (list "type:issue" + "type:document" + "is:open" + "is:closed" + "title:git" + "creator:mani" + "lastupdater:vel" + "assigned:muthu" + "tag:feature-request")) + "etc. Optionally, combine search terms with boolean operators " + (span (@ (class "search-filter")) + "AND") + " and " + (span (@ (class "search-filter")) + "OR") + ". See " (a (@ (href "https://xapian.org/docs/queryparser.html")) + "Xapian::QueryParser Syntax") + " for detailed documentation.")))) + +(define-method (render-sxml (result <search-page-result>) (page <search-page>)) + (define (search-result-statistic search-type format-string matches) + `(li (a (@ (href ,(string-append + (uri-path (search-page-uri page)) + "?" + (query-string + (acons "type" (symbol->string search-type) + (alist-delete "type" + (query-parameters + (uri-query (search-page-uri page)))))))) + ,@(if (eq? search-type (search-page-type page)) + '((class "current-search-type")) + '())) + ,(format #f format-string matches)))) + + `(div + (ul (@ (class "search-results-statistics")) + ,(search-result-statistic 'all "~a All" (search-page-matches page)) + ,(search-result-statistic 'open-issue "~a open issues" (search-page-matched-open-issues page)) + ,(search-result-statistic 'closed-issue "~a closed issues" (search-page-matched-closed-issues page)) + ,(search-result-statistic 'document "~a documents" (search-page-matched-documents page)) + ,(search-result-statistic 'commit "~a commits" (search-page-matched-commits page))) + (ul (@ (class "search-results")) + ,@(reverse + (mset-fold (lambda (item result) + (cons (render-sxml + (call-with-input-string (document-data (mset-item-document item)) + (compose scm->object read)) + page) + result)) + '() + (search-page-mset page)))))) + +(define-method (render-sxml (document <file-document>) (page <search-page>)) + `(li (@ (class "search-result search-result-document")) + (a (@ (href ,(document-web-uri document)) + (class "search-result-title")) + ,(document-title document)) + (div (@ (class "search-result-metadata")) + (span (@ (class ,(string-append "document-type file-document-type"))) + "document") + ,(string-append + (format #f " created ~a by ~a" + (human-date-string (file-document-created-date document)) + (file-document-creator document)) + (if (> (length (file-document-commits document)) + 1) + (format #f ", last updated ~a by ~a" + (human-date-string (file-document-last-updated-date document)) + (file-document-last-updater document)) + ""))) + ,@(let ((snippet (document-sxml-snippet document (search-page-mset page)))) + (if snippet + (list `(div (@ (class "search-result-snippet")) + ,@snippet)) + (list))))) + +(define (sanitize-string str) + "Downcase STR and replace spaces with hyphens." + (string-map (lambda (c) + (case c + ((#\space) #\-) + (else c))) + (string-downcase str))) + +(define-method (render-sxml (issue <issue>) (page <search-page>)) + `(li (@ (class ,(string-append "search-result search-result-issue " + (if (issue-open? issue) + "search-result-open-issue" + "search-result-closed-issue")))) + (a (@ (href ,(document-web-uri issue)) + (class "search-result-title")) + ,(document-title issue)) + (ul (@ (class "tags")) + ,@(map (lambda (tag) + (let ((words (string-split tag (char-set #\- #\space)))) + `(li (@ (class + ,(string-append "tag" + (string-append " tag-" (sanitize-string tag)) + (if (not (null? (lset-intersection + string=? words + (list "bug" "critical")))) + " tag-bug" + "") + (if (not (null? (lset-intersection + string=? words + (list "progress")))) + " tag-progress" + "") + (if (not (null? (lset-intersection + string=? words + (list "chore")))) + " tag-chore" + "") + (if (not (null? (lset-intersection + string=? words + (list "enhancement" "feature")))) + " tag-feature" + "")))) + (a (@ (href ,(string-append + "/search?query=" + (uri-encode + ;; Quote tag if it has spaces. + (string-append "tag:" + (if (string-any #\space tag) + (string-append "\"" tag "\"") + tag)))))) + ,tag)))) + (issue-keywords issue))) + (div (@ (class "search-result-metadata")) + (span (@ (class ,(string-append "document-type issue-document-type " + (if (issue-open? issue) + "open-issue-document-type" + "closed-issue-document-type")))) + ,(if (issue-open? issue) + "issue" + "✓ issue")) + ,(string-append + (format #f " opened ~a by ~a" + (human-date-string (file-document-created-date issue)) + (file-document-creator issue)) + (if (> (length (file-document-commits issue)) + 1) + (format #f ", last updated ~a by ~a" + (human-date-string (file-document-last-updated-date issue)) + (file-document-last-updater issue)) + "") + (if (zero? (issue-tasks issue)) + "" + (format #f "; ~a of ~a tasks done" + (issue-completed-tasks issue) + (issue-tasks issue))))) + ,@(let ((snippet (document-sxml-snippet issue (search-page-mset page)))) + (if snippet + (list `(div (@ (class "search-result-snippet")) + ,@snippet)) + (list))))) + +(define-method (render-sxml (commit <commit>) (page <search-page>)) + `(li (@ (class ,(string-append "search-result search-result-commit"))) + (a (@ (href ,(document-web-uri commit)) + (class "search-result-title")) + ,(document-title commit)) + (div (@ (class "search-result-metadata")) + (span (@ (class ,(string-append "document-type commit-document-type"))) + "commit") + ,(string-append + (format #f " authored ~a by ~a" + (human-date-string (doc:commit-author-date commit)) + (doc:commit-author commit)))) + ,@(let ((snippet (document-sxml-snippet commit (search-page-mset page)))) + (if snippet + (list `(div (@ (class "search-result-snippet")) + ,@snippet)) + (list))))) + +(define-method (render-sxml (footer <search-page-footer>) (page <search-page>)) + `(div)) diff --git a/website/index.skb b/website/index.skb index 5f9546a..309b6ac 100644 --- a/website/index.skb +++ b/website/index.skb @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -25,6 +25,52 @@ through project issues and documentation. The search interface is built on the ,(ref :url "https://xapian.org/" :text "Xapian search engine library"), and is available both as a command-line program and as a web server.]) + (section :title "Feature highlights" :number #f + (itemize + (item [separation of discussion of issues from the documentation +of issues]) + (item [issues are gemtext files (one per issue) committed into +the project repository]) + (item [static site generator to build a project website]) + (item [powerful full text search engine powered by Xapian]) + (item [search through issues, documentation and even commit +messages]) + (item [all state is contained within the repository—nothing extra +to backup]) + (item [easy to host and does not require running large database +servers]))) + (section :title "Download" :number #f + (p [Download release tarballs.]) + ;; TODO: Auto-generate this list from git tags. + (itemize + (item [2023-01-27 ,(ref :url "/releases/tissue-0.1.0.tar.lz" +:text "tissue-0.1.0.tar.lz") ,(ref :url +"/releases/tissue-0.1.0.tar.lz.asc" :text +"tissue-0.1.0.tar.lz.asc")])) + (p [Download ,(ref :url +"https://systemreboot.net/about/arunisaac.pub" :text "public signing +key").]) + (p [Browse the tissue ,(ref :url +"https://git.systemreboot.net/tissue/" :text "git repository").])) + (section :title "Documentation" :number #f + (p [The ,(ref :url "/manual/dev/en/" :text "tissue manual") is +available online.]) + (p [We eat our own dog food too! Search through issues, +documentation and more using our own ,(ref :url "/search" :text +"self-hosted tissue instance").])) + (section :title "Contributors" :number #f + (p [Thanks to these wonderful people!]) + (description + (item :key "Frederick Muriuki Muriithi" + [code, ideas]) + (item :key "jgart" + [ideas]) + (item :key "Morgan Smith" + [bug reports, code]) + (item :key "Munyoki Kilyungi" + [ideas]) + (item :key "Pjotr Prins" + [code, ideas]))) (section :title "License" :number #f (p [tissue is free software released under the terms of the ,(ref :url "https://www.gnu.org/licenses/gpl.html" :text "GNU General Public diff --git a/website/releases/tissue-0.1.0.tar.lz b/website/releases/tissue-0.1.0.tar.lz Binary files differnew file mode 100644 index 0000000..6c0c7f4 --- /dev/null +++ b/website/releases/tissue-0.1.0.tar.lz diff --git a/website/releases/tissue-0.1.0.tar.lz.asc b/website/releases/tissue-0.1.0.tar.lz.asc new file mode 100644 index 0000000..367b6b9 --- /dev/null +++ b/website/releases/tissue-0.1.0.tar.lz.asc @@ -0,0 +1,11 @@ +-----BEGIN PGP SIGNATURE----- + +iQEzBAABCAAdFiEEf3MDQ/Lwnzx3v3nTLiXui2GAK7MFAmPTKpoACgkQLiXui2GA +K7NngAgAre8lAa/TXFXKciTpyXTXulPoj5mEy+I/W0Ta938+BYwdJ7+eYzBDsnM/ +lLkG70sm7McaQ0XNBs2o+XM6QNQscuPsHFek21n7ZPmogzDdOU7sds5tJdmMteSs +ewxs/cihZKOhQlnHUbc9lnCn2qeCyspcXhYuScfu4Dvp0zy46kWkDlnAI8D8lD7d +WXSsPDs3ebVZIIYkAT6LbWfV2kDMqBHRxyEV8IYKkF4fcXpNyYQmHyDE6kmwy9NY +gd+2GGA0bzOlqxgP85SmuAYbQm4IPewj3sufZLDH1dfMaD2I+ZB7BkQXi8I/2XMP +6f/EEsTptV3FU3j6DGWxGIK4Uv4VJw== +=kCvr +-----END PGP SIGNATURE----- diff --git a/website/style.css b/website/style.css index 907de70..be88f34 100644 --- a/website/style.css +++ b/website/style.css @@ -42,5 +42,3 @@ pre { background-color: #f0f0f0; padding: 1em; } - -h1, h3 { font-variant: small-caps; } |