summaryrefslogtreecommitdiff
path: root/update.scm
blob: 37169848aa8dd2572af7f6f4e0207c9a42aa3460 (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
(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)))))

(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)