1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
;;; 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
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program 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 this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (jakob builder cookbook)
#:use-module (haunt artifact)
#:use-module (haunt html)
#: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)
#: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)
"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)))))
|
