From 897c2747b30a6e52434891520467a0d80029a178 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 2 Nov 2019 22:03:09 +0000
Subject: Add the initial implementation of the code

---
 src/reader.scm | 119 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 119 insertions(+)
 create mode 100644 src/reader.scm

(limited to 'src/reader.scm')

diff --git a/src/reader.scm b/src/reader.scm
new file mode 100644
index 0000000..90d90eb
--- /dev/null
+++ b/src/reader.scm
@@ -0,0 +1,119 @@
+(define-module (src reader)
+  #:use-module (srfi srfi-19)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (json)
+  #:use-module (commonmark)
+  #:use-module (haunt reader)
+  #:use-module (haunt post)
+  #:use-module (src date-utils)
+  #:use-module (src urls)
+  #:export (post-reader
+
+            compare-data-filename-for-week))
+
+(define %placeholder-content
+  '("No specific news this week, if you know of something happening \
+related to Guix, please submit it for the next issue!"))
+
+(define %filename-regexp
+  (make-regexp "^posts\\/([0-9]{4})\\/([0-9]{2})/(.*)\\.md$"))
+
+;;; Comparison function data handling
+
+(define (compare-data-filename-for-week year week)
+  (format #f "data/~d/~2'0d/compare.json" year week))
+
+(define (lookup-compare-data-for-week year week)
+  (let ((filename
+         (compare-data-filename-for-week year week)))
+    (if (file-exists? filename)
+        (call-with-input-file filename json->scm)
+        #f)))
+
+(define (get-compare-data-packages-list compare-data key)
+  (stable-sort
+   (map
+    (lambda (package-data)
+      (assoc-ref package-data "name"))
+    (vector->list
+     (or (assoc-ref compare-data key)
+         (vector))))
+   string<=?))
+
+;;; Post reader
+
+(define post-reader
+  (make-reader
+   (make-file-extension-matcher "md")
+   (lambda (file)
+     (call-with-input-file file
+       (lambda (port)
+         (let ((filename-match
+                (regexp-exec %filename-regexp file)))
+           (unless filename-match
+             (error "Unknown file " file))
+           (let* ((year (string->number
+                         (match:substring filename-match 1)))
+                  (week (string->number
+                         (match:substring filename-match 2)))
+                  (locale (match:substring filename-match 3))
+                  (start-date (lookup-start-date-for-week year week))
+                  (end-date (lookup-end-date-for-week year week)))
+             (values
+              `((slug . ,(weekly-news-post-slug year week
+                                                #:locale locale))
+                (title . ,(format #f "Week ~2'0d, ~d"
+                                  week year))
+                (year . ,year)
+                (week . ,week)
+                (date . ,end-date)
+                (start-date . ,start-date)
+                (end-date . ,end-date)
+                ,@(let ((metadata (read-metadata-headers port)))
+                    (if (assoc-ref metadata 'synopsis)
+                        metadata
+                        `(,@metadata
+                          (synopsis
+                           . ,(string-append
+                               (date->string start-date "~1")
+                               " to "
+                               (date->string end-date "~1")))))))
+              (let ((compare-data
+                     (lookup-compare-data-for-week year week)))
+                (append
+                 (let ((content (commonmark->sxml port)))
+                   (if (null? content)
+                       %placeholder-content
+                       content))
+                 `((h3 "Package changes")
+                   (h4 "New packages")
+                   ,@(match (get-compare-data-packages-list compare-data
+                                                            "new-packages")
+                       (()
+                        '("None"))
+                       ((packages ...)
+                        (list
+                         (string-join packages ", "))))
+                   (h4 "Removed packages")
+                   ,@(match (get-compare-data-packages-list compare-data
+                                                            "removed-packages")
+                       (()
+                        '("None"))
+                       ((packages ...)
+                        (list
+                         (string-join packages ", "))))
+                   (h4 "Version changes")
+                   ,@(match (get-compare-data-packages-list compare-data
+                                                            "version-changes")
+                       (()
+                        '("None"))
+                       ((packages ...)
+                        (list
+                         (string-join packages ", "))))
+                   (p
+                    (a (@ (href
+                           ,(data-guix-gnu-org-compare-by-datetime-url
+                             start-date
+                             end-date)))
+                       "View comparison data")))))))))))))
-- 
cgit v1.2.3