blob: 45dfd653f0621bf99578e4bbba0b36835c11cc71 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
(load "haunt.scm")
(use-modules (srfi srfi-1)
(srfi srfi-11)
(srfi srfi-19)
(ice-9 format)
(ice-9 match)
(rnrs bytevectors)
(web client)
(web response)
(json)
(src urls)
(src reader)
(src date-utils))
(define (mkdir-p filename)
(fold (lambda (next-part done-parts)
(let ((filename
(string-append done-parts
"/"
next-part)))
(unless (file-exists? filename)
(mkdir filename))
filename))
"./"
(string-split filename #\/)))
(define (download-data-for-week year week)
(define (date->string* date)
(date->string date "~1%20~T"))
(let-values
(((response body)
(http-get
(data-guix-gnu-org-compare-by-datetime-url
(lookup-start-date-for-week year week)
(lookup-end-date-for-week year week)
#:json #t))))
(let ((output (compare-data-filename-for-week year week)))
(mkdir-p (dirname output))
(let ((data
(scm->json-string
(json-string->scm (utf8->string body))
#:pretty #t)))
(call-with-output-file output
(lambda (port)
(display data port)))
(simple-format #t "written ~A\n" output)))))
(define (update)
(for-each
(match-lambda
((year . weeks)
(for-each
(lambda (week)
(let ((week-string
(format #f "~2'0d" week)))
(let ((week-end-date
(lookup-end-date-for-week year week)))
(when (time>? (current-time)
(date->time-utc week-end-date))
(unless (file-exists?
(compare-data-filename-for-week year week))
(download-data-for-week year week)))
(let ((filename
(format
#f "posts/~d/~2'0d/en_US.md"
year week)))
(mkdir-p (dirname filename))
(when (not (file-exists? filename))
(call-with-output-file filename
(lambda (port)
(display "---\n" port)))
(simple-format #t "written ~A\n" filename))))))
(map car weeks))))
%week-start-lookup-data))
(update)
|