478 lines
20 KiB
Scheme
478 lines
20 KiB
Scheme
;; Copyright (C) 2024 Skylar Widulski <cobra@vern.cc>
|
|
;;
|
|
;; This file is part of MeMe
|
|
;;
|
|
;; MeMe is free software: you can redistribute it and/or modify it under the
|
|
;; terms of the GNU Affero 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 Affero General Public License
|
|
;; for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU Affero General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
(define-module (meme templates)
|
|
#:use-module (meme scraping)
|
|
#:use-module (libxml2)
|
|
#:use-module (htmlprag)
|
|
#:use-module (rnrs)
|
|
#:use-module (ice-9 string-fun)
|
|
#:use-module (system foreign)
|
|
#:export (error-template
|
|
articles-template
|
|
meme-template
|
|
meme-list-template
|
|
category-list-template
|
|
photos-template
|
|
photo-template
|
|
videos-template
|
|
|
|
leaderboard->sxml
|
|
trending->sxml
|
|
meme->sxml
|
|
meme-list->sxml
|
|
category-list->sxml
|
|
photos->sxml
|
|
photo->sxml
|
|
videos->sxml))
|
|
|
|
(define (kym->local url)
|
|
(if (>= (string-length url) 24)
|
|
(if (equal? (substring url 0 24) "https://knowyourmeme.com")
|
|
(substring url 24)
|
|
url)
|
|
url))
|
|
|
|
(define (html-head title)
|
|
`(head (title ,title)
|
|
(meta (@ (charset "UTF-8")))
|
|
(meta (@ (name "viewport") (content "width=device-width")))
|
|
(link (@ (rel "stylesheet") (href "/style.css")))
|
|
(link (@ (rel "icon") (type "image/png") (href "/favicon.png")))))
|
|
|
|
(define heading
|
|
`(header
|
|
(div (@ (class "box heading"))
|
|
(ul (@ (class "navbar"))
|
|
(li (@ (class "home"))
|
|
(a (@ (href "/")) "home"))
|
|
(li (@ (class "memes"))
|
|
(a (@ (href "/memes")) "memes")
|
|
(div (@ (class "dropdown box"))
|
|
(ul
|
|
(li (a (@ (href "/memes/submissions")) "submissions"))
|
|
(li (a (@ (href "/memes/researching")) "researching"))
|
|
(li (a (@ (href "/memes/newsworthy")) "newsworthy"))
|
|
(li (a (@ (href "/memes/popular")) "popular"))
|
|
(li (a (@ (href "/memes/deadpool")) "deadpool"))
|
|
(li (a (@ (href "/memes/all")) "all")))))
|
|
(li (@ (class "categories"))
|
|
(a (@ (href "/categories")) "categories")
|
|
(div (@ (class "dropdown box"))
|
|
(ul
|
|
(li (a (@ (href "/categories/culture")) "cultures"))
|
|
(li (a (@ (href "/categories/event")) "events"))
|
|
(li (a (@ (href "/categories/meme")) "memes"))
|
|
(li (a (@ (href "/categories/person")) "people"))
|
|
(li (a (@ (href "/categories/site")) "sites"))
|
|
(li (a (@ (href "/categories/subculture"))
|
|
"subcultures")))))
|
|
(li (@ (class "images"))
|
|
(a (@ (href "/photos")) "images")
|
|
(div (@ (class "dropdown box"))
|
|
(ul
|
|
(li (a (@ (href "/photos/trending")) "trending"))
|
|
(li (a (@ (href "/photos/most-commented"))
|
|
"most comments"))
|
|
(li (a (@ (href "/photos/most-favorited"))
|
|
"most favorites"))
|
|
(li (a (@ (href "/photos/most-liked")) "most likes"))
|
|
(li (a (@ (href "/photos/least-liked")) "least likes"))
|
|
(li (a (@ (href "/photos/most-viewed")) "most views"))
|
|
(li (a (@ (href "/photos/templates")) "template")))))
|
|
(li (@ (class "videos"))
|
|
(a (@ (href "/videos")) "videos")
|
|
(div (@ (class "dropdown box"))
|
|
(ul
|
|
(li (a (@ (href "/videos/trending")) "trending"))
|
|
(li (a (@ (href "/videos/most-commemted"))
|
|
"most comments"))
|
|
(li (a (@ (href "/videos/most-favorited"))
|
|
"most favorites"))
|
|
(li (a (@ (href "/videos/most-liked")) "most likes"))
|
|
(li (a (@ (href "/videos/most-viewed"))
|
|
"most views")))))
|
|
(li (@ (class "editorials"))
|
|
(a (@ (href "/editorials")) "editorial")
|
|
(div (@ (class "dropdown box"))
|
|
(ul
|
|
(li (a (@ (href "/editorials/interviews"))
|
|
"interviews"))
|
|
(li (a (@ (href "/editorials/in-the-media"))
|
|
"in the media"))
|
|
(li (a (@ (href "/editorials/white-papers"))
|
|
"white papers"))
|
|
(li (a (@ (href "/editorials/episode-notes"))
|
|
"episode notes"))
|
|
(li (a (@ (href "/editorials/behind-the-scenes"))
|
|
"behind the scenes"))
|
|
(li (a (@ (href "/editorials/meme-review"))
|
|
"meme review"))
|
|
(li (a (@ (href "/editorials/collections"))
|
|
"collections"))
|
|
(li (a (@ (href "/editorials/poll")) "poll"))
|
|
(li (a (@ (href "/editorials/guides")) "guides"))
|
|
(li (a (@ (href "/editorials/meme-insider"))
|
|
"meme-insider"))
|
|
(li (a (@ (href "/editorials/insights"))
|
|
"insights")))))
|
|
(li (@ (class "episodes"))
|
|
(a (@ (href "/episodes"))))))))
|
|
|
|
(define footer
|
|
`(footer
|
|
(div (@ (class "box footer"))
|
|
(p (a (@ (href "http://git.vern.cc/cobra/MeMe"))
|
|
"Source Code"))
|
|
,(if (getenv "PATCHES_URL")
|
|
`(p (a (@ (href ,(getenv "PATCHES_URL")))
|
|
"Patches"))
|
|
`()))))
|
|
|
|
(define (leaderboard->sxml leaderboard)
|
|
`(div (@ (class "leaderboard box"))
|
|
(ul (@ (class "leaderboard"))
|
|
,(map (lambda (l)
|
|
`(li (@ (id ,(car l)))
|
|
(a (@ (href ,(kym->local (cadr l))))
|
|
(img (@ (src ,(proxy (caddr l)))
|
|
(alt ,(cadddr l))))
|
|
(p (@ (class "tooltip box")) ,(cadddr l)))))
|
|
leaderboard))))
|
|
|
|
(define (trending->sxml trending)
|
|
`(div (@ (class "trending box"))
|
|
(p "trending:")
|
|
,(map (lambda (l)
|
|
(if (equal? (length l) 2)
|
|
`(p (a (@ (href ,(kym->local (car l))))
|
|
,(html->shtml (cadr l))))
|
|
`()))
|
|
trending)))
|
|
|
|
(define (articles->sxml articles)
|
|
`(,(map (lambda (l)
|
|
`(div (@ (class "articles box"))
|
|
(a (@ (href ,(kym->local (car l))))
|
|
(h1 ,(cadr l))
|
|
(img (@ (src ,(proxy (caddr l)))
|
|
(alt ,(cadr l))))
|
|
(p ,(cadddr l)))
|
|
(i ,(list-ref l 4))))
|
|
articles)))
|
|
|
|
(define (meme->sxml meme)
|
|
`(div
|
|
(div (@ (class "box meme"))
|
|
(img (@ (src ,(proxy (cadr meme)))))
|
|
(h1 ,(car meme))
|
|
(div (@ (class "subdiv"))
|
|
,(html->shtml (caddr meme))
|
|
,(html->shtml (cadddr meme))
|
|
,(html->shtml (list-ref meme 4))))
|
|
(div (@ (class "box meme-body"))
|
|
,(map (lambda (s)
|
|
(html->shtml
|
|
(string-replace-substring
|
|
s "https://knowyourmeme.com" "")))
|
|
(list-head (list-tail meme 5) (- (length meme) 6))))
|
|
,(if (not (equal? (car (last-pair meme)) ""))
|
|
`(div (@ (class "collection-wrapper"))
|
|
,(map (lambda (l)
|
|
`(div (@ (class "box collection-item"))
|
|
,(html->shtml (car l))
|
|
(p (a (@ (href ,(cadddr l))) "Source"))
|
|
(a (@ (href
|
|
,(string-replace-substring
|
|
(cadr l) "https://knowyourmeme.com" "")))
|
|
(img (@ (src ,(proxy (caddr l))))))))
|
|
(cdar (last-pair meme))))
|
|
`())))
|
|
|
|
(define (meme-list->sxml meme-list)
|
|
`(div
|
|
(div (@ (class "box meme-list"))
|
|
,(html->shtml (car meme-list))
|
|
(p ,(cadr meme-list))
|
|
,(html->shtml (caddr meme-list))
|
|
,(html->shtml (string-replace-substring
|
|
(cadddr meme-list)
|
|
"https://knowyourmeme.com"
|
|
"")))
|
|
(div (@ (class "box meme-list-body"))
|
|
(ul (@ (class "meme-list-list"))
|
|
,(map (lambda (l)
|
|
`(li
|
|
(a (@ (href ,(string-replace-substring
|
|
(car l)
|
|
"https://knowyourmeme.com"
|
|
"")))
|
|
(img (@ (src ,(proxy (cadr l)))))
|
|
(p (@ (class "tooltip box")) ,(caddr l)))))
|
|
(cddddr meme-list))))))
|
|
|
|
(define (category-list->sxml category-list)
|
|
`(div (@ (class "box category-list"))
|
|
,(html->shtml (car category-list))
|
|
(ul
|
|
,(map (lambda (l)
|
|
`(li
|
|
(a (@ (href ,(cadar l)))
|
|
,(string-append
|
|
(caddar l) " ("
|
|
(caar l) ")"))
|
|
(ul
|
|
,(map (lambda (m)
|
|
`(li (a (@ (href ,(cadr m)))
|
|
,(string-append
|
|
(caddr m) " ("
|
|
(car m) ")"))))
|
|
(cadr l)))
|
|
(br)))
|
|
(cadr category-list)))))
|
|
|
|
(define (photos->sxml photos)
|
|
`(div
|
|
(div (@ (class "box photos"))
|
|
,(html->shtml (car photos))
|
|
(p ,(cadr photos))
|
|
,(html->shtml (caddr photos))
|
|
,(html->shtml (string-replace-substring
|
|
(cadddr photos)
|
|
"https://knowyourmeme.com"
|
|
"")))
|
|
(div (@ (class "box photos-gallery"))
|
|
,(map (lambda (p)
|
|
`(a (@ (href ,(car p)))
|
|
(img (@ (src ,(proxy (cdr p)))))))
|
|
(cddddr photos)))))
|
|
|
|
(define (photo->sxml photo)
|
|
`(div (@ (class "photo-container"))
|
|
(div (@ (class "box photo-header"))
|
|
,(html->shtml (car photo))
|
|
(p "Source: " ,(html->shtml (cadddr photo))))
|
|
(div (@ (class "box photo-body"))
|
|
(a (@ (href ,(string-replace-substring
|
|
(caddr photo) "articles" "original"))
|
|
(target "_blank"))
|
|
(img (@ (alt ,(cadr photo))
|
|
(src ,(caddr photo))))))))
|
|
|
|
(define (videos->sxml videos)
|
|
`(div
|
|
(div (@ (class "box videos"))
|
|
,(html->shtml (car videos))
|
|
(p ,(cadr videos))
|
|
,(html->shtml (caddr videos))
|
|
,(html->shtml (string-replace-substring
|
|
(cadddr videos)
|
|
"https://knowyourmeme.com"
|
|
"")))
|
|
(div (@ (class "box videos-table"))
|
|
,(map (lambda (p)
|
|
`(a (@ (href ,(car p)))
|
|
(img (@ (src ,(proxy (cdr p)))))))
|
|
(cddddr videos)))))
|
|
|
|
(define (sidebar-gallery->sxml sidebar-gallery)
|
|
(map (lambda (l)
|
|
`(div (@ (class "sidebar box"))
|
|
(h3 ,(car l))
|
|
(table (@ (class "gallery"))
|
|
(tr (td (a (@ (href ,(kym->local (cadr l))))
|
|
(img (@ (src ,(proxy (cadddr l)))
|
|
(alt ,(caddr l))))
|
|
(p (b ,(list-ref l 4)))))
|
|
(td (a (@ (href ,(kym->local (list-ref l 5))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref l 7)))
|
|
(alt ,(list-ref l 6))))
|
|
(p (b ,(list-ref l 8))))))
|
|
(tr (td (a (@ (href ,(kym->local (list-ref l 9))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref l 11)))
|
|
(alt ,(list-ref l 10))))
|
|
(p (b ,(list-ref l 12)))))
|
|
(td (a (@ (href ,(kym->local (list-ref l 13))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref l 15)))
|
|
(alt ,(list-ref l 14))))
|
|
(p (b ,(list-ref l 16)))))))))
|
|
sidebar-gallery))
|
|
|
|
(define (sidebar-trending->sxml sidebar-trending)
|
|
(if (not (equal? sidebar-trending ""))
|
|
`(div (@ (class "sidebar box"))
|
|
(h3 (a (@ (href ,(kym->local (car sidebar-trending))))
|
|
,(cadr sidebar-trending)))
|
|
(table (@ (class "trending-images"))
|
|
(tr (td (a (@ (href ,(kym->local (caddr sidebar-trending))))
|
|
(img (@ (src ,(proxy (cadddr sidebar-trending)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 4))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 5)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 6))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 7))))))))
|
|
(tr (td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 8))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 9)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 10))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 11)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 12))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(car
|
|
(list-tail sidebar-trending
|
|
13)))))))))
|
|
(tr (td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 14))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 15)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 16))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(list-ref sidebar-trending 17)))))))
|
|
(td (a (@ (href
|
|
,(kym->local (list-ref sidebar-trending 18))))
|
|
(img (@ (src
|
|
,(proxy
|
|
(car
|
|
(list-tail sidebar-trending
|
|
19)))))))))))
|
|
`()))
|
|
|
|
(define (pagination->sxml pagination)
|
|
(if (not (equal? pagination ""))
|
|
`(div (@ (class "pagination box"))
|
|
,(html->shtml pagination))
|
|
`()))
|
|
|
|
|
|
|
|
(define (error-template code)
|
|
(shtml->html
|
|
`(html ,(html-head (string-append (number->string code) " | MeMe"))
|
|
(body
|
|
,heading
|
|
(center
|
|
(h1 (@ (class "error")) ,(number->string code)))
|
|
,footer))))
|
|
|
|
(define (articles-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
(div (@ (class "left"))
|
|
,(articles->sxml (get-articles body))
|
|
,(pagination->sxml (get-pagination body)))
|
|
(div (@ (class "right"))
|
|
,(sidebar-gallery->sxml (get-sidebar-gallery body))
|
|
,(sidebar-trending->sxml (get-sidebar-trending body)))
|
|
,footer))))
|
|
|
|
(define (meme-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(meme->sxml (get-meme body))
|
|
,footer))))
|
|
|
|
(define (meme-list-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(meme-list->sxml (get-meme-list body))
|
|
,(if (not (equal? (get-pagination body) ""))
|
|
`(div (@ (class "wide-pagination"))
|
|
,(pagination->sxml (get-pagination body)))
|
|
`())
|
|
,footer))))
|
|
|
|
(define (category-list-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(category-list->sxml (get-category-list body))
|
|
,footer))))
|
|
|
|
(define (photos-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(photos->sxml (get-photos body))
|
|
,(if (not (equal? (get-pagination body) ""))
|
|
`(div (@ (class "wide-pagination"))
|
|
,(pagination->sxml (get-pagination body)))
|
|
`())
|
|
,footer))))
|
|
|
|
(define (photo-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(photo->sxml (get-photo body))
|
|
,footer))))
|
|
|
|
(define (videos-template body)
|
|
(shtml->html
|
|
`(html ,(html-head "MeMe")
|
|
(body
|
|
,heading
|
|
,(leaderboard->sxml (get-leaderboard body))
|
|
,(trending->sxml (get-trending body))
|
|
,(videos->sxml (get-videos body))
|
|
,(if (not (equal? (get-pagination body) ""))
|
|
`(div (@ (class "wide-pagination"))
|
|
,(pagination->sxml (get-pagination body)))
|
|
`())
|
|
,footer))))
|