aboutsummaryrefslogtreecommitdiffstats
path: root/modules
diff options
context:
space:
mode:
Diffstat (limited to 'modules')
-rw-r--r--modules/builders/replicant-blog-search.scm75
-rw-r--r--modules/builders/replicant-blog.scm214
-rw-r--r--modules/builders/wordpress-compatible-links.scm51
-rw-r--r--modules/readers/wordpress-markdown.scm59
4 files changed, 399 insertions, 0 deletions
diff --git a/modules/builders/replicant-blog-search.scm b/modules/builders/replicant-blog-search.scm
new file mode 100644
index 0000000..694e3b5
--- /dev/null
+++ b/modules/builders/replicant-blog-search.scm
@@ -0,0 +1,75 @@
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2023-2024 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;;
+;;; This file is based on haunt/builder/blog.scm,
+;;; haunt/reader/commonmark.scm and tests/post.scm and from Haunt
+;;; 2.6.0.
+;;;
+;;; This file 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 (modules builders replicant-blog-search)
+ #:use-module (commonmark)
+ #:use-module (haunt artifact)
+ #:use-module (haunt builder assets)
+ #:use-module (haunt html)
+ #:use-module (haunt page)
+ #:use-module (haunt post)
+ #:use-module (haunt site)
+ #:use-module (haunt utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-19)
+ #:use-module (modules builders replicant-blog)
+ #:export (replicant-blog-search-page))
+
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define (guix-package name)
+ `(a
+ (@ (href ,(string-append "https://packages.guix.gnu.org/packages/" name)))
+ ,name))
+
+(define replicant-blog-search-page-content
+ `((h1 (@ (id "title")) "Search")
+
+ (p "This blog has no built-in search functionality. Instead users are
+supposed to download the full blog source code and search inside
+it. This way they are fully in control of the search and in most cases
+it should not leak the search to a third party.")
+
+ (p "Here is an example that works under a terminal in GNU/Linux with git installed:")
+ (p (@ (class "command")) "git clone https://git.replicant.us/contrib/GNUtoo/infrastructure/haunt-blog")
+ (p "And then you can search in it. For instance if you want to search for
+FOSDEM in the blog articles, you can use the following commands:")
+ (p (@ (class "command")) "cd haunt-blog")
+ (p (@ (class "command")) "git grep -i fosdem -- posts")
+
+ (p (string-append
+ "It is also possible to download the source code with graphical "
+ "software such as "
+ ,(guix-package "gitg")
+ " and then search inside the files with file managers such as "
+ ,(guix-package "nautilus")
+ ". "
+ "If you want to search inside the files, be sure to select the "
+ "\"Full text\" search as by default these file managers usually only "
+ "search the file names only."))))
+
+(define (replicant-blog-search-page site posts)
+ (make-page
+ "search.html"
+ (replicant-layout site "Blog: Search" replicant-blog-search-page-content)
+ sxml->html))
diff --git a/modules/builders/replicant-blog.scm b/modules/builders/replicant-blog.scm
new file mode 100644
index 0000000..ac84bba
--- /dev/null
+++ b/modules/builders/replicant-blog.scm
@@ -0,0 +1,214 @@
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2023-2024 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;;
+;;; This file is based on haunt/builder/blog.scm,
+;;; haunt/reader/commonmark.scm and tests/post.scm and from Haunt
+;;; 2.6.0.
+;;;
+;;; This file 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 (modules builders replicant-blog)
+ #:use-module (commonmark)
+ #:use-module (haunt artifact)
+ #:use-module (haunt builder assets)
+ #:use-module (haunt html)
+ #:use-module (haunt post)
+ #:use-module (haunt site)
+ #:use-module (haunt utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (rnrs base)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-19)
+ #:export (theme-collection-template)
+ #:export (make-theme)
+ #:export (render-collection)
+ #:export (render-post)
+ #:export (replicant-blog-website)
+ #:export (replicant-default-post-template)
+ #:export (replicant-layout)
+ #:export (replicant-theme)
+ #:export (theme)
+ #:export (theme-layout)
+ #:export (theme-name)
+ #:export (theme-post-template)
+ #:export (theme?))
+
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define-record-type <theme>
+ (make-theme name layout post-template collection-template)
+ theme?
+ (name theme-name)
+ (layout theme-layout)
+ (post-template theme-post-template)
+ (collection-template theme-collection-template))
+
+(define (replicant-layout site title body)
+ `((doctype "html")
+ (head
+ (meta (@ (charset "utf-8")))
+ (link
+ (@ (rel "stylesheet")
+ (href "static/twentyeleven-style-20231107.css")))
+ (title ,(string-append title " - " (site-title site))))
+ (body
+ (header
+ (img (@ (id "banner")
+ (src "static/replicant_banner_white.png")
+ (alt "Replicant banner")))
+ (nav
+ (@ (id "access"))
+ (ul
+ (li (a (@ (href "https://www.replicant.us"))
+ "Home"))
+ (li (a (@ (href "/")
+ (id "blog-link")
+ )
+ "Blog"))
+ (li (a (@ (href "https://redmine.replicant.us/projects/replicant/wiki"))
+ "Wiki"))
+ (li (a (@ (href "https://redmine.replicant.us/projects/replicant/issues"))
+ "Tracker"))
+ (li (a (@ (href "https://redmine.replicant.us/projects/replicant/boards"))
+ "Forums"))
+ (li (a (@ (href "/search.html"))
+ "Blog: Search")))))
+ ,body)))
+
+(define (replicant-default-post-template post)
+ `((h1 (@ (id "title")) ,(post-ref post 'title))
+ ;; Metadata
+ (p (string-append
+ "Posted"
+ ,(if
+ (post-ref post 'authors)
+ (string-append " by " (post-ref post 'authors))
+ "")
+ ,(if
+ (post-ref post 'date)
+ (string-append
+ " on the "
+ (date->string (post-ref post 'date) "~d ~B ~Y at ~kh~M"))
+ "")
+ ,(if (post-ref post 'licenses)
+ (string-append
+ " under the "
+ (post-ref post 'licenses) " license(s)")
+ "")
+ "."))
+ (div (@ (id "post-content")) ,(post-sxml post))
+
+ ,(if
+ (and (post-ref post 'thread-link)
+ (post-ref post 'thread-name))
+ `(div
+ (h1 "Comments")
+ (p "You can view replies on the Replicant mailing list, in the "
+ (a (@ (href ,(post-ref post 'thread-link)))
+ ,(post-ref post 'thread-name)) " thread.")
+ (p "If you also want to comment on this blog post, you can simply
+reply to the "
+ (a (@ (href ,(post-ref post 'thread-link)))
+ ,(post-ref post 'thread-name)) " thread.")
+
+ (p "If for some reasons you can't reply to this thread or you don't
+know how to do it, simply write a mail to the mailing list instead.")
+
+ (p "It is easier for everybody if you subscribe to the mailing list
+to do that: if you don't your mail will probably still reach the mailing list
+but it will require a moderator to approve it so it can take time. See "
+ (a (@ (href "https://redmine.replicant.us/projects/replicant/wiki/CommunityAndContact#Mailing-list"))
+ "the CommunityAndContact page")
+ " on the Replicant wiki for how to subscribe"))
+ ;; Empty div to avoid #<unspecified> showing up on the page when we have
+ ;; no comments.
+ `(div))))
+
+
+(define (sort-posts-by-most-recent-first a b)
+ (time>?
+ (date->time-utc (post-ref a 'date))
+ (date->time-utc (post-ref b 'date))))
+
+(define (replicant-default-collection-template site title posts prefix)
+ (define (post-uri post)
+ (string-append (or prefix "") "/"
+ (site-post-slug site post) ".html"))
+
+ `((h3 ,title)
+ (ul
+ ,@(map (lambda (post)
+ `(li
+ (a (@ (href ,(post-uri post)))
+ ,(post-ref post 'title))))
+ (sort posts sort-posts-by-most-recent-first)))))
+
+(define* (theme #:key
+ (name "Replicant")
+ (layout replicant-layout)
+ (post-template replicant-default-post-template)
+ (collection-template replicant-default-collection-template))
+ (make-theme name layout post-template collection-template))
+
+(define (with-layout theme site title body)
+ ((theme-layout theme) site title body))
+
+(define (render-post theme site post)
+ (let ((title (post-ref post 'title))
+ (body ((theme-post-template theme) post)))
+ (with-layout theme site title body)))
+
+(define (render-collection theme site title posts prefix)
+ (let ((body ((theme-collection-template theme) site title posts prefix)))
+ (with-layout theme site title body)))
+
+(define (date->string* date)
+ "Convert DATE to human readable string."
+ (date->string date "~a ~d ~B ~Y"))
+
+(define replicant-theme
+ (theme #:name "Replicant"
+ #:layout replicant-layout
+ #:post-template replicant-default-post-template
+ #:collection-template replicant-default-collection-template))
+
+(define* (replicant-blog-website #:key (theme replicant-theme) prefix
+ (collections
+ `(("" "index.html" ,posts/reverse-chronological))))
+ "Return a procedure that transforms a list of posts into pages
+decorated by THEME, whose URLs start with PREFIX."
+ (define (make-file-name base-name)
+ (if prefix
+ (string-append prefix "/" base-name)
+ base-name))
+
+ (lambda (site posts)
+ (define (post->page post)
+ (let ((base-name (string-append (site-post-slug site post)
+ ".html")))
+ (serialized-artifact (make-file-name base-name)
+ (render-post theme site post)
+ sxml->html)))
+
+ (define collection->page
+ (match-lambda
+ ((title file-name filter)
+ (serialized-artifact (make-file-name file-name)
+ (render-collection theme site title (filter posts) prefix)
+ sxml->html))))
+
+ (append (map post->page posts)
+ (map collection->page collections))))
diff --git a/modules/builders/wordpress-compatible-links.scm b/modules/builders/wordpress-compatible-links.scm
new file mode 100644
index 0000000..19c8076
--- /dev/null
+++ b/modules/builders/wordpress-compatible-links.scm
@@ -0,0 +1,51 @@
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2023-2025 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;;
+;;; This file is based on haunt/builder/blog.scm,
+;;; haunt/reader/commonmark.scm and tests/post.scm and from Haunt
+;;; 2.6.0.
+;;;
+;;; This file 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 (modules builders wordpress-compatible-links)
+ #:use-module (haunt builder redirects)
+ #:use-module (ice-9 rdelim)
+ #:export (make-wordpress-compatible-links))
+
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define (parse-line line)
+ (define parts (string-split line #\/))
+ (define year (list-ref parts 3))
+ (define month (list-ref parts 4))
+ (define page (list-ref parts 5))
+ (define input
+ (string-append "/" year "/" month "/" page "/index.html"))
+ (define output
+ (string-append "../../../" page ".html"))
+ `((,input ,output)))
+
+(define (make-read-file results)
+ (define (read-file port)
+ (define line (read-line port))
+ (if (not (eof-object? line))
+ ((lambda _
+ (set! results (append results (parse-line line)))
+ (read-file port)))
+ results))
+ read-file)
+
+(define (make-wordpress-compatible-links path)
+ (redirects (call-with-input-file path (make-read-file (list)))))
diff --git a/modules/readers/wordpress-markdown.scm b/modules/readers/wordpress-markdown.scm
new file mode 100644
index 0000000..54d64ab
--- /dev/null
+++ b/modules/readers/wordpress-markdown.scm
@@ -0,0 +1,59 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
+;;;
+;;; 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:
+;;
+;; CommonMark post reader.
+;;
+;;; Code:
+
+(define-module (modules readers wordpress-markdown)
+ #:use-module (commonmark)
+ #:use-module (haunt post)
+ #:use-module (haunt reader)
+ #:use-module (haunt utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
+ #:export (wordpress-markdown-reader))
+
+(fluid-set! %default-port-encoding "UTF-8")
+
+(define (string->custom-date* str)
+ "Convert STR, a string in ISO 8601 format or the default format, into a
+SRFI-19 date object."
+ (or (catch 'misc-error
+ (lambda _ (string->date str "~Y-~m-~dT~H:~M:~S~z"))
+ (const #f))
+ (catch 'misc-error
+ (lambda _ (string->date str "~Y~m~d ~H:~M"))
+ (const #f))))
+
+(define (string->string* str) str)
+(register-metadata-parser! 'date string->custom-date*)
+(register-metadata-parser! 'authors string->string*)
+(register-metadata-parser! 'license string->string*)
+
+(define wordpress-markdown-reader
+ (make-reader (make-file-extension-matcher "md")
+ (lambda (file)
+ (call-with-input-file file
+ (lambda (port)
+ (values (read-metadata-headers port)
+ (commonmark->sxml port)))))))
generated by cgit v1.2.3 (git 2.25.1) at 2026-06-29 08:36:30 +0000