lassik
/
another-planet
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Refactor

This commit is contained in:
Lassi Kortela 2021-08-21 16:48:10 +03:00
parent d1df666af4
commit d5301833eb
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
planet.sld
View File

@ -16,8 +16,7 @@
(scheme write) (scheme write)
(srfi 1) (srfi 1)
(srfi 13) (srfi 13)
(srfi 132) (srfi 132))
(srfi 193))
(cond-expand (cond-expand
(chicken (chicken
(import (only (chicken file) (import (only (chicken file)
@ -69,6 +68,11 @@
(begin (write-string chunk output) (begin (write-string chunk output)
(loop)))))) (loop))))))
(define (supersede-text-file filename thunk)
(let ((new-filename (string-append filename ".new")))
(with-output-to-file new-filename thunk)
(rename-file new-filename filename #t)))
(define (path-append . paths) (define (path-append . paths)
(string-join paths "/")) (string-join paths "/"))
@ -91,12 +95,10 @@
(feed-url feed) (feed-url feed)
#f #f
(lambda () (lambda ()
(let ((temp-file (string-append cache-file ".new"))) (supersede-text-file
(call-with-port cache-file (lambda ()
(open-output-file temp-file) (copy-textual-port (current-input-port)
(lambda (output) (current-output-port))))))))
(copy-textual-port (current-input-port) output)))
(rename-file temp-file cache-file #t))))))
(define (read-feed-from-cache feed cache-directory) (define (read-feed-from-cache feed cache-directory)
(let ((cache-file (feed-cache-file feed cache-directory))) (let ((cache-file (feed-cache-file feed cache-directory)))
@ -130,10 +132,8 @@
(group-by entry-iso-date entries)) (group-by entry-iso-date entries))
(define (write-html-file filename sxml) (define (write-html-file filename sxml)
(let ((new-filename (string-append filename ".new"))) (supersede-text-file
(with-output-to-file new-filename filename (lambda ()
(lambda () (write-string "<!DOCTYPE html>")
(write-string "<!DOCTYPE html>") (SXML->HTML sxml)
(SXML->HTML sxml) (newline))))))
(newline)))
(rename-file new-filename filename #t)))))