140 lines
4.2 KiB
Scheme
140 lines
4.2 KiB
Scheme
;; Copyright (C) 2024 Skylar Widulski <cobra@vern.cc>
|
|
;;
|
|
;; This file is part of Soprano
|
|
;;
|
|
;; Soprano 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 (soprano templates)
|
|
#:use-module (soprano scraping)
|
|
#:use-module (libxml2)
|
|
#:use-module (htmlprag)
|
|
#:use-module (rnrs)
|
|
#:use-module (ice-9 string-fun)
|
|
#:use-module (system foreign)
|
|
#:export (error-template
|
|
index-template
|
|
gif-template
|
|
gif->sxml
|
|
search-template
|
|
search->sxml))
|
|
|
|
(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 (a (@ (href "/"))
|
|
(img (@ (src "/favicon.png"))))
|
|
(form (@ (id "search")
|
|
(role "search")
|
|
(method "get")
|
|
(action "/search"))
|
|
(input (@ (type "search")
|
|
(id "q")
|
|
(name "q")
|
|
(placeholder "Search")
|
|
(autofocus)))
|
|
(button "Go"))))
|
|
|
|
(define footer
|
|
`(footer
|
|
(p (a (@ (href "http://git.vern.cc/cobra/Soprano"))
|
|
"Source Code"))
|
|
,(if (getenv "PATCHES_URL")
|
|
`(p (a (@ (href ,(getenv "PATCHES_URL")))
|
|
"Patches"))
|
|
`())))
|
|
|
|
(define (gif->sxml gif)
|
|
`(div
|
|
(h1 ,(car gif))
|
|
(img (@ (alt ,(car gif))
|
|
(src ,(proxy (cadr gif)))))))
|
|
|
|
(define (search->sxml search)
|
|
`(div (@ (class "search list"))
|
|
,(map (lambda (p)
|
|
`(a (@ (href ,(car p)))
|
|
(img (@ (src ,(proxy (cadr p)))))))
|
|
search)))
|
|
|
|
(define (index-template host)
|
|
(shtml->html
|
|
`(html ,(html-head "Soprano")
|
|
(body
|
|
,heading
|
|
(h1 "Soprano")
|
|
(p "Soprano is a privacy-respecting front-end to Tenor.")
|
|
(br)
|
|
(h2 "Usage")
|
|
(p "You can use Soprano by replacing " (code "tenor.com")
|
|
" with this website's domain")
|
|
(h3 "Example")
|
|
(pre (code
|
|
,(string-append
|
|
"https://tenor.com/view/a-on-the-test-gif"
|
|
"-16733124990588327175")))
|
|
(p "becomes")
|
|
(pre (code
|
|
,(string-append
|
|
"https://" host
|
|
"/view/a-on-the-test-gif-16733124990588327175")))
|
|
,footer))))
|
|
|
|
(define (gif-template d)
|
|
(let ((gif (get-gif d)))
|
|
(shtml->html
|
|
`(html ,(html-head
|
|
(string-append
|
|
(car gif)
|
|
" - Soprano"))
|
|
(body
|
|
,heading
|
|
,(gif->sxml gif)
|
|
,footer)))))
|
|
|
|
(define (search-template d)
|
|
(shtml->html
|
|
`(html ,(html-head "Search - Soprano")
|
|
(body
|
|
,heading
|
|
(h1 "Search")
|
|
,(search->sxml (get-search d))
|
|
,footer))))
|
|
|
|
(define (error-template code)
|
|
(shtml->html
|
|
`(html ,(html-head
|
|
(string-append
|
|
(number->string code)
|
|
" - Soprano"))
|
|
(body
|
|
,heading
|
|
(h1 ,(number->string code))
|
|
,footer))))
|
|
|
|
(define (error-template code)
|
|
(shtml->html
|
|
`(html ,(html-head
|
|
(string-append
|
|
(number->string code)
|
|
" - Soprano"))
|
|
(body
|
|
,heading
|
|
(h1 ,(number->string code))
|
|
,footer))))
|