Commit ffeb1c8e authored by Neil Mather's avatar Neil Mather

Move utility functions into separate modules

parent 552d5f83
Pipeline #73292911 passed with stage
in 54 seconds
(define-module (evalapply utils dates)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:export (date))
(define (date year month day)
"Create a SRFI-19 date for the given YEAR, MONTH, DAY"
(let ((tzoffset (tm:gmtoff (localtime (time-second (current-time))))))
(make-date 0 0 0 0 day month year tzoffset)))
(define-module (evalapply utils sxml)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (ice-9 match)
#:export (date
stylesheet
anchor
link
centered-image
first-paragraph
%cc-by-sa-button
%cc-by-sa-link))
(define (stylesheet name)
`(link (@ (rel "stylesheet")
(href ,(string-append "/css/" name ".css")))))
(define* (anchor content #:optional (uri content))
`(a (@ (href ,uri)) ,content))
(define %cc-by-sa-link
'(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
"Creative Commons Attribution Share-Alike 4.0 International"))
(define %cc-by-sa-button
'(a (@ (class "cc-button")
(href "https://creativecommons.org/licenses/by-sa/4.0/"))
(img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png")))))
(define (link name uri)
`(a (@ (href ,uri)) ,name))
(define* (centered-image url #:optional alt)
`(img (@ (class "centered-image")
(src ,url)
,@(if alt
`((alt ,alt))
'()))))
(define (first-paragraph post)
(let loop ((sxml (post-sxml post))
(result '()))
(match sxml
(() (reverse result))
((or (('p ...) _ ...) (paragraph _ ...))
(reverse (cons paragraph result)))
((head . tail)
(loop tail (cons head result))))))
(define (raw-snippet code)
`(pre (code ,(if (string? code) code (read-string code)))))
......@@ -14,7 +14,9 @@
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(use-modules (haunt asset)
(use-modules (evalapply utils sxml)
(evalapply utils dates)
(haunt asset)
(haunt builder blog)
(haunt builder atom)
(haunt builder assets)
......@@ -26,62 +28,12 @@
(haunt site)
(haunt utils)
(commonmark)
;; (syntax-highlight)
;; (syntax-highlight scheme)
;; (syntax-highlight xml)
;; (syntax-highlight c)
;; (syntax-highlight)
;; (syntax-highlight scheme)
(sxml match)
(sxml transform)
(texinfo)
(texinfo html)
(srfi srfi-1)
(srfi srfi-19)
(ice-9 rdelim)
(ice-9 regex)
(ice-9 match)
(web uri))
(define (date year month day)
"Create a SRFI-19 date for the given YEAR, MONTH, DAY"
(let ((tzoffset (tm:gmtoff (localtime (time-second (current-time))))))
(make-date 0 0 0 0 day month year tzoffset)))
(define (stylesheet name)
`(link (@ (rel "stylesheet")
(href ,(string-append "/css/" name ".css")))))
(define* (anchor content #:optional (uri content))
`(a (@ (href ,uri)) ,content))
(define %cc-by-sa-link
'(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
"Creative Commons Attribution Share-Alike 4.0 International"))
(define %cc-by-sa-button
'(a (@ (class "cc-button")
(href "https://creativecommons.org/licenses/by-sa/4.0/"))
(img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png")))))
(define (link name uri)
`(a (@ (href ,uri)) ,name))
(define* (centered-image url #:optional alt)
`(img (@ (class "centered-image")
(src ,url)
,@(if alt
`((alt ,alt))
'()))))
(define (first-paragraph post)
(let loop ((sxml (post-sxml post))
(result '()))
(match sxml
(() (reverse result))
((or (('p ...) _ ...) (paragraph _ ...))
(reverse (cons paragraph result)))
((head . tail)
(loop tail (cons head result))))))
(define evalapply-theme
(theme #:name "evalapply"
#:layout
......@@ -191,9 +143,6 @@ free culture works available under the " ,%cc-by-sa-link " license.")
(define (highlight-scheme code)
`(pre (code ,(highlights->sxml (highlight lex-scheme code)))))
(define (raw-snippet code)
`(pre (code ,(if (string? code) code (read-string code)))))
;; Markdown doesn't support video, so let's hack around that! Find
;; <img> tags with a ".webm" source and substitute a <video> tag.
(define (media-hackery . tree)
......
<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>evalapply</title><subtitle>Recent Posts</subtitle><updated>2019-07-23T21:04:02+0100</updated><link href="evalapply.space/feed.xml" rel="self" /><link href="evalapply.space" /><entry><title>First post!</title><author><name>Eval Apply</name><email>lambda@evalapply.space</email></author><updated>2019-06-18T21:00:00+0100</updated><link href="/first-post.html" rel="alternate" /><summary type="html">&lt;p&gt;Hello, world!&lt;/p&gt;</summary></entry></feed>
\ No newline at end of file
<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>evalapply</title><subtitle>Recent Posts</subtitle><updated>2019-07-27T15:24:53+0100</updated><link href="evalapply.space/feed.xml" rel="self" /><link href="evalapply.space" /><entry><title>First post!</title><author><name>Eval Apply</name><email>lambda@evalapply.space</email></author><updated>2019-06-18T21:00:00+0100</updated><link href="/first-post.html" rel="alternate" /><summary type="html">&lt;p&gt;Hello, world!&lt;/p&gt;</summary></entry></feed>
\ No newline at end of file
<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>evalapply</title><subtitle>Tag: hello</subtitle><updated>2019-07-23T21:04:02+0100</updated><link href="evalapply.space/feeds/tags/hello.xml" rel="self" /><link href="evalapply.space" /><entry><title>First post!</title><author><name>Eval Apply</name><email>lambda@evalapply.space</email></author><updated>2019-06-18T21:00:00+0100</updated><link href="/first-post.html" rel="alternate" /><summary type="html">&lt;p&gt;Hello, world!&lt;/p&gt;</summary></entry></feed>
\ No newline at end of file
<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>evalapply</title><subtitle>Tag: hello</subtitle><updated>2019-07-27T15:24:53+0100</updated><link href="evalapply.space/feeds/tags/hello.xml" rel="self" /><link href="evalapply.space" /><entry><title>First post!</title><author><name>Eval Apply</name><email>lambda@evalapply.space</email></author><updated>2019-06-18T21:00:00+0100</updated><link href="/first-post.html" rel="alternate" /><summary type="html">&lt;p&gt;Hello, world!&lt;/p&gt;</summary></entry></feed>
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment