diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | README | 3 | ||||
| -rw-r--r-- | TODO.org | 24 | ||||
| -rw-r--r-- | doc/haunt.texi | 44 | ||||
| -rw-r--r-- | example/haunt.scm | 2 | ||||
| -rw-r--r-- | example/pages/about.md | 10 | ||||
| -rw-r--r-- | haunt/builder/flat-pages.scm | 34 | ||||
| -rw-r--r-- | haunt/html.scm | 25 | ||||
| -rw-r--r-- | haunt/ui.scm | 2 | ||||
| -rw-r--r-- | haunt/ui/new.scm | 149 | ||||
| -rw-r--r-- | tests/html.scm | 27 |
11 files changed, 304 insertions, 18 deletions
diff --git a/Makefile.am b/Makefile.am index 1c08890..5ed9c87 100644 --- a/Makefile.am +++ b/Makefile.am @@ -66,6 +66,7 @@ SOURCES = \ haunt/watch/fallback.scm \ haunt/ui.scm \ haunt/ui/build.scm \ + haunt/ui/new.scm \ haunt/ui/publish.scm \ haunt/ui/serve.scm \ haunt/serve/mime-types.scm \ @@ -97,6 +98,7 @@ endif TESTS = \ tests/helper.scm \ + tests/html.scm \ tests/post.scm \ tests/utils.scm @@ -37,6 +37,9 @@ simple, functional, and extensible. Write a configuration file named =haunt.scm=. Add your posts to a directory named =posts=. Then run =haunt build=! +Alternatively, use the =haunt new= command to start a project from a +template quickly. + To view your creation, run =haunt serve= and browse to =localhost:8080=. For quicker development cycles, run =haunt serve --watch= to automatically rebuild the site when things change. @@ -1,4 +1,28 @@ * To-do list +** Throw a better error when a reader is not found +This is no good: + +#+BEGIN_SRC sh + $ haunt build + building pages in 'site'... + Backtrace: + 7 (primitive-load "/gnu/store/3c5n80ixbs198qk6dn42fiigph8s6fjs-haunt-0.3.0/bin/.haunt-real") + In haunt/ui.scm: + 136:6 6 (run-haunt-command _ . _) + In haunt/ui/build.scm: + 60:5 5 (haunt-build . _) + In haunt/site.scm: + 116:20 4 (build-site #<<site> title: "Spritely Institute" domain: "spritely.institute" scheme: https posts-directory: …>) + In ice-9/ftw.scm: + 505:39 3 (loop _ _ #(64768 11164290 16877 2 1000 998 0 4096 1727117337 1727117337 1727117337 4096 8 directory 493 # …) …) + In haunt/reader.scm: + 99:24 2 (leaf "posts/2022-08-17-blast-off-spritely-institutes-tech-tour.html" _ (#<<post> file-name: "posts/2022-0…> …)) + 85:32 1 (read-post #f "posts/2022-08-17-blast-off-spritely-institutes-tech-tour.html" _) + 80:3 0 (reader-read #f "posts/2022-08-17-blast-off-spritely-institutes-tech-tour.html") + + haunt/reader.scm:80:3: In procedure reader-read: + In procedure struct-vtable: Wrong type argument in position 1 (expecting struct): #f +#+END_SRC ** Output XHTML5? <cbaines> there's still code in the data service that was copied from Mumi <cbaines> e.g. sxml->html should live somewhere else and be shared [10:34] diff --git a/doc/haunt.texi b/doc/haunt.texi index 6be2fb5..0ac016f 100644 --- a/doc/haunt.texi +++ b/doc/haunt.texi @@ -299,6 +299,7 @@ programming interfaces. @menu * Invoking haunt build:: Build the website. * Invoking haunt serve:: Serve the website over HTTP. +* Invoking haunt new:: Generating a blog template. * Invoking haunt publish:: Publish the website. @end menu @@ -375,6 +376,25 @@ Automatically rebuild the site when source files change. @end table +@node Invoking haunt new +@section Invoking @command{haunt new} + +The @command{haunt new} command creates a starter template for a new website. + +Usage: + +@example +haunt new +@end example + +By default, haunt will create a directory called @file{blog}. To use a +different name for your new blog, simply provide the name at the +command line as follows: + +@example +haunt new my-blog +@end example + @node Invoking haunt publish @section Invoking @command{haunt publish} @@ -864,7 +884,9 @@ in some markup language to full web pages. Flat pages work great for the more informational parts of a website that don't require any fancy programming to generate, like an ``About me'' page. -@deffn {Procedure} flat-pages directory [#:template] [#:prefix] +@deffn {Procedure} flat-pages [directory "pages"] @@ + [#:template ugly-page-template] @@ + [#:prefix "/"] Return a procedure that parses the files in @var{directory} and returns a list of HTML pages, one for each file. The files are parsed @@ -886,6 +908,26 @@ of demonstrating Haunt's flat page functionality. I live here in this manual with my two cats: Bob and Carol. @end example +If the above text were saved to @file{about.md} in the flat pages +directory, the resulting HTML page would be @file{about.html}. + +For ``pretty'' URLS (@file{/about} rather than @file{/about.html}), +the special metadata item @code{index: true} can be specified in the +page header: + +@example +title: About me +index: true +--- + +# About me + +... +@end example + +With the @code{index} metadata flag, Haunt will generate +@file{about/index.html} rather than @file{about.html}. + The content of each flat page is inserted into a complete HTML document by the @var{template} procedure. This procedure takes three arguments: diff --git a/example/haunt.scm b/example/haunt.scm index 2527c89..bcb58fd 100644 --- a/example/haunt.scm +++ b/example/haunt.scm @@ -2,6 +2,7 @@ (haunt builder blog) (haunt builder atom) (haunt builder assets) + (haunt builder flat-pages) (haunt builder rss) (haunt publisher rsync) (haunt publisher sourcehut) @@ -21,6 +22,7 @@ (atom-feed) (atom-feeds-by-tag) (rss-feed) + (flat-pages) (static-directory "images")) #:publishers (list (rsync-publisher #:name 'rsync #:destination "/tmp/haunt-example") diff --git a/example/pages/about.md b/example/pages/about.md new file mode 100644 index 0000000..d841fa7 --- /dev/null +++ b/example/pages/about.md @@ -0,0 +1,10 @@ +title: About +index: true +--- +Scheme is a cool programming language. + +Guile is a cool Scheme implementation. + +Haunt is a cool static site generator written in Guile. + +Enough said. diff --git a/haunt/builder/flat-pages.scm b/haunt/builder/flat-pages.scm index 98913c0..85b3b53 100644 --- a/haunt/builder/flat-pages.scm +++ b/haunt/builder/flat-pages.scm @@ -1,5 +1,5 @@ ;;; Haunt --- Static site generator for GNU Guile -;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2015-2024 David Thompson <davet@gnu.org> ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org> ;;; ;;; This file is part of Haunt. @@ -35,9 +35,20 @@ #:use-module (srfi srfi-11) #:export (flat-pages)) -(define* (flat-pages directory #:key - template - prefix) +(define (ugly-page-template site title body) + `((doctype "html") + (head + (meta (@ (charset "utf-8"))) + (title ,(string-append title " — " (site-title site)))) + (body + (h1 ,(site-title site)) + ,body))) + +(define* (flat-pages #:optional + (directory "pages") + #:key + (template ugly-page-template) + (prefix "/")) "Return a procedure that parses the files in DIRECTORY and returns a list of HTML pages, one for each file. The files are parsed using the readers configured for the current site. The structure of DIRECTORY @@ -66,15 +77,18 @@ complete HTML page that presumably wraps the page body." (string-append "." (file-extension file-name)))) (map (lambda (file-name) (match (reader-find (site-readers site) file-name) + (#f (error "no reader available for page" file-name)) (reader (let-values (((metadata body) (reader-read reader file-name))) - (let* ((dir (substring (dirname file-name) + (let* ((title (or (assq-ref metadata 'title) "Untitled")) + (index? (equal? (assq-ref metadata 'index) "true")) + (dir (substring (dirname file-name) (string-length directory))) - (out (string-append (or prefix "/") dir + (out (string-append prefix dir (if (string-null? dir) "" "/") - (strip-extension file-name) ".html")) - (title (or (assq-ref metadata 'title) "Untitled"))) + (strip-extension file-name) + (if index? "/index" "") + ".html"))) (serialized-artifact out (template site title body) - sxml->html)))) - (#f (error "no reader available for page" file-name)))) + sxml->html)))))) src-files))) diff --git a/haunt/html.scm b/haunt/html.scm index 5891cd0..795c572 100644 --- a/haunt/html.scm +++ b/haunt/html.scm @@ -1,5 +1,6 @@ ;;; Haunt --- Static site generator for GNU Guile ;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; Copyright © 2024 Daniel Meißner <dan_m@posteo.de> ;;; ;;; This file is part of Haunt. ;;; @@ -53,6 +54,13 @@ "Return #t if TAG is a void element." (pair? (memq tag %void-elements))) +(define %raw-elements + '(script style)) + +(define (raw-element? tag) + "Return #t if TAG is a raw element." + (pair? (memq tag %raw-elements))) + (define %escape-chars (alist->hash-table '((#\" . "quot") @@ -96,12 +104,17 @@ list ATTRS and the child nodes in BODY." (display #\space port) (attribute->html attr value port))) attrs) - (if (and (null? body) (void-element? tag)) - (display " />" port) - (begin - (display #\> port) - (for-each (cut sxml->html <> port) body) - (format port "</~a>" tag)))) + (cond + ((and (null? body) (void-element? tag)) + (display " />" port)) + ((raw-element? tag) + (display #\> port) + (for-each (lambda (node) (display node port)) body) + (format port "</~a>" tag)) + (else + (display #\> port) + (for-each (cut sxml->html <> port) body) + (format port "</~a>" tag)))) (define (doctype->html doctype port) (format port "<!DOCTYPE ~a>" doctype)) diff --git a/haunt/ui.scm b/haunt/ui.scm index a0e98c7..d512cc2 100644 --- a/haunt/ui.scm +++ b/haunt/ui.scm @@ -57,7 +57,7 @@ haunt-main)) (define commands - '("build" "publish" "serve")) + '("build" "new" "publish" "serve")) (define program-name (make-parameter 'haunt)) diff --git a/haunt/ui/new.scm b/haunt/ui/new.scm new file mode 100644 index 0000000..7110e06 --- /dev/null +++ b/haunt/ui/new.scm @@ -0,0 +1,149 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2024 jgart <jgart@dismail.de> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt 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. +;;; +;;; Haunt 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 Haunt. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Haunt new sub-command. +;; +;;; Code: + +(define-module (haunt ui new) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 pretty-print) + #:use-module (haunt ui) + #:use-module (haunt utils) + #:export (haunt-new)) + +(define (show-help) + (format #t "Usage: haunt new [NAME] +Create a new Haunt project.~%") + (display " + -p, --project-dir project directory") + (display " + -t, --title project title") + (display " + -d, --domain project domain") + (display " + -a, --author project author") + (display " + -e, --email project email") + (show-common-options-help) + (newline) + (display " + -h, --help display this help and exit") + (display " + -V, --version display version information and exit") + (newline)) + +(define %options + (list (option '(#\h "help") #f #f + (lambda _ + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda _ + (show-version-and-exit "haunt new"))) + (option '(#\p "project-dir") #t #f + (lambda (opt name arg result) + (alist-cons 'project-dir arg result))) + (option '(#\t "title") #t #f + (lambda (opt name arg result) + (alist-cons 'title arg result))) + (option '(#\d "domain") #t #f + (lambda (opt name arg result) + (alist-cons 'domain arg result))) + (option '(#\a "author") #t #f + (lambda (opt name arg result) + (alist-cons 'author arg result))) + (option '(#\e "email") #t #f + (lambda (opt name arg result) + (alist-cons 'email arg result))))) + +(define %default-options + (append '((project-dir . "blog") + (title . "Built with Guile") + (domain . "example.com") + (author . "Eva Luator") + (email . "eva@example.com")) + %default-common-options)) + +(define (write-template project-dir build-file title domain author email) + (let ((path (string-append project-dir "/" build-file))) + (call-with-output-file path + (lambda (port) + (pretty-print + '(use-modules (haunt asset) + (haunt builder blog) + (haunt builder atom) + (haunt builder assets) + (haunt reader commonmark) + (haunt site)) + port) + (newline port) + (pretty-print + `(site #:title ,title + #:domain ,domain + #:default-metadata + '((author . ,author) + (email . ,email)) + #:readers (list commonmark-reader) + #:builders (list (blog) + (atom-feed) + (atom-feeds-by-tag) + (static-directory "images"))) + port))))) + +(define %first-post-file-name "hello.md") + +(define %first-post-contents + "title: First post! +date: 2018-03-13 18:00 +tags: hello +summary: hello! +--- + +Hello, world! +") + +(define (write-first-post project-dir) + (let* ((first-post-file %first-post-file-name) + (first-post-contents %first-post-contents) + (output-path + (string-append project-dir "/posts/" first-post-file))) + (call-with-output-file output-path + (lambda (port) + (display first-post-contents port))))) + +(define (build-template project-dir build-file title domain author email) + (mkdir-p (string-append project-dir "/images")) + (mkdir-p (string-append project-dir "/posts")) + (write-template project-dir build-file title domain author email) + (write-first-post project-dir) + (format #t "new blog was created in project directory ~a\n" project-dir)) + +(define (haunt-new . args) + (let* ((opts (simple-args-fold args %options %default-options)) + (project-dir (assq-ref opts 'project-dir)) + (build-file (assq-ref opts 'config)) + (title (assq-ref opts 'title)) + (domain (assq-ref opts 'domain)) + (author (assq-ref opts 'author)) + (email (assq-ref opts 'email))) + (build-template project-dir build-file title domain author email))) diff --git a/tests/html.scm b/tests/html.scm new file mode 100644 index 0000000..b475bf5 --- /dev/null +++ b/tests/html.scm @@ -0,0 +1,27 @@ +;;; Haunt --- Static site generator for GNU Guile +;;; Copyright © 2024 Daniel Meißner <dan_m@posteo.de> +;;; +;;; This file is part of Haunt. +;;; +;;; Haunt 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. +;;; +;;; Haunt 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 Haunt. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-html) + #:use-module (haunt html) + #:use-module (srfi srfi-64) + #:use-module (tests helper)) + +(with-tests "html" + (test-equal "content of raw elements are not escaped" + "<script>console.log(\"Hello, world!\");</script>" + (sxml->html-string '(script "console.log(\"Hello, world!\");")))) |