Add the initial implementation of the code

1 files changed, 75 insertions, 0 deletions

diff --git a/update.scm b/update.scm
new file mode 100644
index 0000000..7de35e1
--- /dev/null
+++ b/update.scm
@@ -0,0 +1,75 @@
+(load "haunt.scm")
+
+(use-modules (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)