;;; 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)))))