;;; Copyright © 2019 - 2020 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 theme)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (ice-9 match)
  #:use-module (jakob utils sxml)
  #:export (theme))


;;;
;;; SHTML generation in the site's theme.
;;;

(define (fugue-icon-path name)
  (format #f "background-image: url('/static/image/icons-shadowless/~a.png')" name))

(define %title "jakob.space")
(define %stylesheets '("fonts.css" "highlight.css" "style.css"))
(define %link-rel '(("alternate" "/feed.xml" "application/atom+xml")
                    ("icon" "/static/image/favicon.ico" "image/vnd.microsoft.icon")
                    ("me" "https://social.jakob.space/jakob")
                    ("webmention" "https://webmention.io/jakob.space/webmention")
                    ("pingback" "https://webmention.io/jakob.space/xmlrpc")
                    ("pgpkey authn" "/static/gpg.txt")))
(define %nav-bar-tabs '(("Blog" "/blog/")
                        ("Projects" "/projects/")
                        ("About Me" "/pages/about-complete.html")
                        ("Changelog" "/pages/changelog.html")))

;; Currently unused as the current nav bar does not do nesting.
(define (format-nav-item item-content)
    (let* ((anchor-element (apply hyperlink (reverse (take item-content 2))))
           (children       (drop item-content 2)))
      (if (null? children)
          `(li ,anchor-element)
          `(li (@ (class "drop-parent"))
               ,anchor-element
               (ul (@ (class "drop-menu"))
                   ,@(map format-nav-item children))))))

(define %header
  `(header
    (@ (class "site-header"))
    (a (@ (href "/") (class "header-logo")) "jakob.space")
    (time (@ (datetime ,(date->string (current-date) "~Y-~m-~d")))
          (string-upcase ,(date->string (current-date) "~d~b~Y")))))

(define %default-sidebar-modules
  `((section
     (@ (class "module search-module")
        (aria-labelledby "search-heading"))
     (h3 (@ (id "search-heading")
            (class "module-title module-title-has-icon")
            (style ,(fugue-icon-path "magnifier")))
         "Search")
     (form (@ (action "/search")
              (method "GET")
              (role "search")
              (style "display: flex; gap: 5px;"))
           (input (@ (type "text") (name "q") (placeholder "Keywords...") (aria-label "Search keywords")))
           (button (@ (type "submit"))
                   "Go")))

    (section
     (@ (class "module nav-module")
        (aria-label "Main Navigation"))
     (h3 (@ (class "module-title module-title-has-icon")
            (style ,(fugue-icon-path "navigation")))
         "Navigation")
     (ul (@ (class "nav-list"))
         ,@(map (match-lambda
                  ((name target) `(li (a (@ (href ,target)) ,name))))
                %nav-bar-tabs)))

    (section
     (@ (class "module network-module")
        (aria-label "External Network"))
     (h3 (@ (class "module-title module-title-has-icon")
            (style ,(fugue-icon-path "external")))
         "Network")
     (ul (@ (class "nav-list"))
         (li (a (@ (href "https://social.jakob.space/users/jakob")) "Pleroma"))
         (li (a (@ (href "https://lobste.rs/u/jakob")) "Lobste.rs"))
         (li (a (@ (href "https://git.sr.ht/~jakob")) "Sr.ht"))))

    (section
     (@ (class "module status-module")
        (aria-label "External Network"))
     (h3 (@ (class "module-title module-title-has-icon")
            (style ,(fugue-icon-path "dashboard")))
         "Status")
     (span (@ (style "font-size: 9px; color: #666; border-bottom: 1px dotted #999;"))
           "Last updated: " (time (@ (datetime "2026-02-13"))) "13FEB2026")
     (div (@ (style "font-size: 9px; color: #666; margin-top: 4px;"))
          "Reading: ..."
          (br)
          "Playing: Earthbound"
          (br)
          "Hacking: ..."))

    (section
     (@ (class "module comments-module")
        (aria-labelledby "comments-heading"))
     (h3 (@ (class "module-title module-title-has-icon")
            (style ,(fugue-icon-path "megaphone")))
         "Recent Comments")
     (div (@ (class "sidebar-comment-list"))
          (article (@ (class "sidebar-comment-box"))
             (span (@ (class "comment-context"))
                   "on: "
                   (a (@ (href "/blog/usb-pd-is-pretty-cool.html")) "USB-PD Is Pretty Cool"))
                (strong "Bob")
                (a (@ (href "/blog/usb-pd-is-pretty-cool.html#comment-reply"))
                   "I used PETG to make sure it didn't warp..."))
          (article (@ (class "sidebar-comment-box"))
             (span (@ (class "comment-context"))
                   "on: "
                   (a (@ (href "/blog/usb-pd-is-pretty-cool.html")) "USB-PD Is Pretty Cool"))
             (strong "Alice")
             (a (@ (href "/blog/usb-pd-is-pretty-cool.html#comment-reply"))
                "This is a lifesaver for field work. Have you..."))))))

(define %footer
  (let ((year (date-year (current-date))))
    `(footer (@ (class "site-footer"))
      (img (@ (src "/static/image/cc-by-sa-4.0.png")
              (alt "Creative Commons BY-SA 4.0")))
      "© "
      (time (@ (datetime "2015")) "2015")
      " - "
      (time (@ (datetime ,year)) ,year)
      " Jakob L. Kreuze")))

(define* (theme #:key
                (title '())
                (description "")
                (keywords '())
                (meta '())
                (scripts '())
                (content '(div ""))
                (sidebar #f))
  "Return an SHTML document using the website's theme."
  `((doctype "html")
    (html
     (@ (lang "en"))

     (head
      ,(if (null? title)
           `(title ,%title)
           `(title ,(string-join (list title %title) " :: ")))

      (meta (@ (charset "utf-8")))
      (meta (@ (name "keywords") (content ,(string-join keywords ", "))))
      (meta (@ (name "description") (content ,description)))
      (meta (@ (name "language") (content "EN")))
      (meta (@ (name "viewport") (content "width=device-width, initial-scale=1.0")))
      (meta (@ (name "HandheldFriendly") (content "True")))

      (meta (@ (name "author") (content "Jakob L. Kreuze")))
      (meta (@ (name "subject") (content "Personal website of Jakob L. Kreuze")))
      (meta (@ (name "medium") (content "blog")))

      (meta (@ (name "og:title") (content ,title)))

      ,@(map (match-lambda
               ((name . content)
                `(meta (@ (name ,name) (content ,content)))))
             meta)

      ,@(map (lambda (file-name) (stylesheet file-name)) %stylesheets)

      ,@(map (match-lambda
              ((rel href) `(link (@ (rel ,rel) (href ,href))))
              ((rel href type) `(link (@ (rel ,rel) (href ,href) (type ,type)))))
             %link-rel))

     (body
      (div (@ (class "main-container"))
         ,%header
         (div (@ (class "content-wrapper"))
            (aside (@ (class "sidebar"))
               ,@(or sidebar %default-sidebar-modules))
            (main (@ (class "main-content"))
                  ,(if (and (list? content)
                            (positive? (length content))
                            (symbol? (first content)))
                       `(,content)
                       content))
            ,@scripts)
         ,%footer
         (a (@ (style "display: none")
               (href "/pages/licensing.html")
               (rel "jslicense")
               (data-jslicense "1"))
            "JavaScript license information"))))))