diff options
Diffstat (limited to 'jakob/builder')
| -rw-r--r-- | jakob/builder/cookbook.scm | 208 |
1 files changed, 166 insertions, 42 deletions
diff --git a/jakob/builder/cookbook.scm b/jakob/builder/cookbook.scm index 7a916ca..a0be836 100644 --- a/jakob/builder/cookbook.scm +++ b/jakob/builder/cookbook.scm @@ -1,4 +1,4 @@ -;;; Copyright © 2019 - 2024 Jakob L. Kreuze <zerodaysfordays@sdf.org> +;;; Copyright © 2019 - 2025 Jakob L. Kreuze <zerodaysfordays@sdf.org> ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -14,54 +14,178 @@ ;;; along with this program. If not, see ;;; <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; TODO -;; -;;; Code: - (define-module (jakob builder cookbook) #:use-module (haunt artifact) #:use-module (haunt html) - #:use-module (haunt post) #:use-module (haunt reader) #:use-module (haunt site) #:use-module (haunt utils) #:use-module (ice-9 ftw) #:use-module (ice-9 match) + #:use-module (jakob theme) + #:use-module (jakob utils features) + #:use-module (jakob utils org-mode) + #:use-module (jakob utils sxml) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (srfi srfi-11) - #:export (flat-pages)) + #:use-module (srfi srfi-26) + #:export (cookbook)) + +;;; Commentary: +;;; +;;; A builder for a cookbook, based on Haunt's default 'blog' builder. +;;; +;;; Code: + +(define-record-type <cookbook-page> + (make-cookbook-page path metadata body) + cookbook-page? + (path cookbook-page-path) + (metadata cookbook-page-metadata) + (body cookbook-page-body)) + + +;;; +;;; Rendering. +;;; + +(define (tags-to-spans tags) + (define (tag->class tag) + (string-map (lambda (c) (if (char=? c #\:) #\- c)) tag)) + (define (make-class tag) + (format #f "cookbook-tag cookbook-tag-~a" (tag->class tag))) + (map (lambda (tag) `(span (@ (class ,(make-class tag))))) tags)) + +(define (recipe->page site recipe) + (match recipe + (($ <cookbook-page> path metadata body) + (let* ((title (or (assq-ref metadata 'title) "Untitled")) + (content `((h1 ,title) + (p ,(tags-to-spans (assq-ref metadata 'tags))) + ,@body + (p ,(hyperlink "/cookbook/" "Back to Cookbook")))) + (content (theme #:title title #:content content))) + (serialized-artifact path content sxml->html))))) + +(define render-recipe-entry + (match-lambda + (($ <cookbook-page> path metadata) + (let ((title (or (assq-ref metadata 'title) "Untitled")) + (thumb (assq-ref metadata 'cookbook_thumbnail))) + `(div (@ (class "cookbook-entry")) + (div (img (@ (src ,(if thumb + (format #f "/cookbook/recipes/~a" thumb) + "/cookbook/recipes/default-thumb.jpg"))))) + (div (a (@ (href ,(format #f "/~a" path))) (h3 ,title)) + (p ,(tags-to-spans (assq-ref metadata 'tags))))))))) + + +;;; +;;; Builder. +;;; + +(define cookbook-directory "cookbook") + +(define (output-path file-name) + (define (ensure-trailing-path-delimiter component) + (cond ((string-null? component) component) + ((string-suffix? "/" component) component) + (else (string-append component "/")))) + (define (strip-extension file-name) + (basename file-name + (string-append "." (file-extension file-name)))) + (let* ((dir (substring (dirname file-name) (string-length cookbook-directory))) + (dir (string-delete #\/ dir))) + (string-append (ensure-trailing-path-delimiter cookbook-directory) + (ensure-trailing-path-delimiter dir) + (strip-extension file-name) ".html"))) + +(define (find-image-entries site directory) + "ftw wrapper for images in a gallery" + (define (enter? file-name stat memo) #t) + (define (noop file-name stat memo) memo) + (define (keep? file-name) + (not (string-suffix? "thumb.jpg" file-name))) + (define (leaf file-name stat memo) + (if (keep? file-name) (cons file-name memo) memo)) + (define (err file-name stat errno memo) + (error "flat page directory scanning failed" file-name errno)) + (file-system-fold enter? leaf noop noop noop err '() directory)) + +(define (find-pages site directory) + "ftw wrapper for org documents containing recipes" + (define (enter? file-name stat memo) #t) + (define (noop file-name stat memo) memo) + (define keep? (site-file-filter site)) + (define (leaf file-name stat memo) + (if (keep? file-name) (cons file-name memo) memo)) + (define (err file-name stat errno memo) + (error "flat page directory scanning failed" file-name errno)) + (file-system-fold enter? leaf noop noop noop err '() directory)) + +(define (page-tagged-with? recipe tag) + (match recipe + (($ <cookbook-page> path metadata) + (find (cut equal? <> tag) (assq-ref metadata 'tags))))) + +(define (make-index src-pages images) + (define-values (_ front-matter) + (read-org-mode-file "cookbook/index.org")) + (define content + `((h1 "Diary of a Gourmand") + ,@front-matter + (h2 "Recipes") + (div (@ (class "cookbook-entry-container")) + ,@(map render-recipe-entry src-pages)) + ,@(if (getenv "HAUNT_INCLUDE_FOOD_GALLERY") + `((h2 "Chow Hall") + (div (@ (class "cookbook-image-gallery")) + ,@(map (match-lambda + ((file-name thumb) + `(a (@ (href ,(format #f "/cookbook/food-pics/~a" file-name))) + (img (@ (loading "lazy") + (src ,(format #f "/cookbook/food-pics/~a" thumb))))))) + images))) + '()))) + (serialized-artifact (output-path "cookbook/index.html") + (theme #:title "Cookbook" #:content content) + sxml->html)) + +(define (make-recipes-with-tag-list tag src-pages) + (define content + `((h1 "Diary of a Gourmand") + (h2 ,(format #f "Recipes Tagged \"~a\"" tag)) + (div (@ (class "cookbook-entry-container")) + ,@(map render-recipe-entry (filter (cut page-tagged-with? <> tag) src-pages))))) + (serialized-artifact (output-path (format #f "cookbook/tag/~a.html" "tag")) + (theme #:title "Cookbook - TODO" #:content content) + sxml->html)) -(define* (cookbook directory #:key template prefix) - ;; TODO: Document me - (lambda (site posts) - ;; Recursively scan the directory and generate a page for each - ;; file found. - (define (enter? file-name stat memo) #t) - (define (noop file-name stat memo) memo) - (define keep? (site-file-filter site)) - (define (leaf file-name stat memo) - (if (keep? file-name) (cons file-name memo) memo)) - (define (err file-name stat errno memo) - (error "flat page directory scanning failed" file-name errno)) - (define src-files - (file-system-fold enter? leaf noop noop noop err '() directory)) - ;; (define (strip-extension file-name) - ;; (basename file-name - ;; (string-append "." (file-extension file-name)))) - ;; (map (lambda (file-name) - ;; (match (reader-find (site-readers site) file-name) - ;; (reader - ;; (let-values (((metadata body) (reader-read reader file-name))) - ;; (let* ((dir (substring (dirname file-name) - ;; (string-length directory))) - ;; (out (string-append (or prefix "/") dir - ;; (if (string-null? dir) "" "/") - ;; (strip-extension file-name) ".html")) - ;; (title (or (assq-ref metadata 'title) "Untitled"))) - ;; (serialized-artifact out (template site title body) - ;; sxml->html)))) - ;; (#f (error "no reader available for page" file-name)))) - ;; src-files) - )) +(define (cookbook) + "A builder for a cookbook, based on Haunt's default 'blog' builder" + (lambda (site _) + (define (process-recipe file-name) + (match (reader-find (site-readers site) file-name) + (#f #f) + (reader + (parameterize ((%additional-keys '("COOKBOOK_THUMBNAIL"))) + (let-values (((metadata body) (reader-read reader file-name))) + (make-cookbook-page (output-path file-name) metadata body)))))) + (define (process-image file-name) + (let ((file-name (substring file-name (string-length "cookbook-food-pics/")))) + (list file-name + (string-append + (substring file-name 0 (- (string-length file-name) (string-length ".jpg"))) + "-thumb.jpg")))) + (let* ((recipes (find-pages site "cookbook/recipes")) + (recipes (map process-recipe recipes)) + (recipes (filter identity recipes)) + (images (if (feature-enabled? 'food-gallery) + (find-image-entries site "cookbook-food-pics/") + '())) + (images (map process-image images)) + (images (filter identity images))) + `(,(make-index recipes images) + ,(make-recipes-with-tag-list "dish-type:baked-good" recipes) + ,@(map (cut recipe->page site <>) recipes))))) |