Use -n and -o args like Planet Venus

planet-scheme.scm

@@ -41,31 +41,44 @@
      (h1 ,title)
      ,@(map
         (lambda (entries)
-          (let ((date (entry-iso-date (first entries))))
-            `(section
-              (h2 ,date)
-              ,@(map entry->html entries))))
+          `(section
+            (h2 ,(entry-english-year-and-month (first entries)))
+            ,@(map (lambda (entry)
+                     `(article
+                       (h3 ,(entry-title entry))
+                       ,(or (entry-content-xhtml entry)
+                            `(div))
+                       (p "by " ,(entry-author entry))))
+                   entries)))
         (planet-group-entries-by-date
          (planet-n-newest-entries 10 feeds cache-directory))))))
 
 ;;
 
-(define (refresh-cache)
+(define (refresh-cache all?)
   (for-each (lambda (feed)
-              (disp "Refreshing " (feed-url feed))
-              (planet-refresh-feed feed cache-directory))
+              (let ((new? (not (feed-cached? feed cache-directory))))
+                (when (or all? new?)
+                  (disp "Refreshing " (feed-url feed))
+                  (planet-refresh-feed feed cache-directory))))
             feeds))
 
 (define (generate-from-cache)
-  (disp "Writing index.html")
-  (write-html-file "index.html" (front-page)))
+  (disp "Writing www/index.html")
+  (write-html-file "www/index.html" (front-page)))
+
+(define (only-command-line-arg? arg)
+  (and (= 1 (length (command-args)))
+       (string=? arg (first (command-args)))))
 
 (define (main)
   (cond ((null? (command-args))
-         (refresh-cache)
+         (refresh-cache #t)
          (generate-from-cache))
-        ((and (= 1 (length (command-args)))
-              (string=? "-n" (first (command-args))))
+        ((only-command-line-arg? "-n")
+         (refresh-cache #f)
+         (generate-from-cache))
+        ((only-command-line-arg? "-o")
          (generate-from-cache))
         (else
          (error "Usage: ./planet-scheme [-n]"))))

planet.sld

@@ -3,9 +3,14 @@
           feed-id
           feed-title
           feed-url
+          feed-cache-file
+          feed-cached?
+          entry-author
           entry-title
+          entry-content-xhtml
           entry-iso-date
-          entry->html
+          entry-us-english-date
+          entry-english-year-and-month
           planet-refresh-feed
           planet-all-entries-ever
           planet-n-newest-entries
@@ -16,8 +21,7 @@
           (scheme write)
           (srfi 1)
           (srfi 13)
-          (srfi 132)
-          (srfi 193))
+          (srfi 132))
   (cond-expand
    (chicken
     (import (only (chicken file)
@@ -30,15 +34,18 @@
             (only (traversal)
                   group-by)
             (only (atom)
-                  read-atom-feed
-                  feed-entries
+                  content-xhtml
+                  entry-author
+                  entry-content
+                  entry-title
                   entry-updated
-                  entry-title))))
+                  feed-entries
+                  read-atom-feed))))
   (begin
 
     (define (take-at-most list n)
       (let loop ((n n) (new-list '()) (list list))
-        (if (< n 1) (reverse new-list)
+        (if (or (null? list) (< n 1)) (reverse new-list)
             (loop (- n 1) (cons (car list) new-list) (cdr list)))))
 
     (define (disp . xs)
@@ -69,9 +76,29 @@
               (begin (write-string chunk output)
                      (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)
       (string-join paths "/"))
 
+    (define english-month-names
+      (vector
+       "January"
+       "February"
+       "March"
+       "April"
+       "May"
+       "June"
+       "July"
+       "August"
+       "September"
+       "October"
+       "November"
+       "December"))
+
     ;;;
 
     (define-record-type feed
@@ -84,6 +111,9 @@
     (define (feed-cache-file feed cache-directory)
       (path-append cache-directory (string-append (feed-id feed) ".xml")))
 
+    (define (feed-cached? feed cache-directory)
+      (file-exists? (feed-cache-file feed cache-directory)))
+
     (define (planet-refresh-feed feed cache-directory)
       (let ((cache-file (feed-cache-file feed cache-directory)))
         (create-directory cache-directory)
@@ -91,30 +121,50 @@
          (feed-url feed)
          #f
          (lambda ()
-           (let ((temp-file (string-append cache-file ".new")))
-             (call-with-port
-              (open-output-file temp-file)
-              (lambda (output)
-                (copy-textual-port (current-input-port) output)))
-             (rename-file temp-file cache-file #t))))))
+           (supersede-text-file
+            cache-file (lambda ()
+                         (copy-textual-port (current-input-port)
+                                            (current-output-port))))))))
 
     (define (read-feed-from-cache feed cache-directory)
       (let ((cache-file (feed-cache-file feed cache-directory)))
         (call-with-port (open-binary-input-file cache-file) read-atom-feed)))
 
-    (define (entry-iso-date entry)
+    (define (entry-content-xhtml entry)
+      (content-xhtml (entry-content entry)))
+
+    (define (entry-rfc3339-digits n entry)
       (let ((rfc3339 (entry-updated entry)))
-        (if (and rfc3339 (>= (string-length rfc3339) 10))
-            (substring rfc3339 0 10)
+        (if (and rfc3339 (>= (string-length rfc3339) n))
+            (substring rfc3339 0 n)
             (error "No date"))))
 
+    (define (entry-iso-date entry) (entry-rfc3339-digits 10 entry))
+
+    (define (entry-iso-month entry) (entry-rfc3339-digits 7 entry))
+
+    (define (entry-y-m-d-integers entry)
+      (let* ((yyyy-mm-dd (entry-iso-date entry))
+             (year  (string->number (substring yyyy-mm-dd 0 4)))
+             (month (string->number (substring yyyy-mm-dd 5 7)))
+             (day   (string->number (substring yyyy-mm-dd 8 10))))
+        (values year month day)))
+
+    (define (entry-us-english-date entry)
+      (let-values (((year month day) (entry-y-m-d-integers entry)))
+        (let ((month-name (vector-ref english-month-names (- month 1))))
+          (string-append
+           (number->string day) " " month-name " " (number->string year)))))
+
+    (define (entry-english-year-and-month entry)
+      (let-values (((year month _) (entry-y-m-d-integers entry)))
+        (let ((month-name (vector-ref english-month-names (- month 1))))
+          (string-append month-name " " (number->string year)))))
+
     (define (entry-iso-date<? entry1 entry2)
       (string<? (entry-iso-date entry1)
                 (entry-iso-date entry2)))
 
-    (define (entry->html entry)
-      `(h3 ,(entry-title entry)))
-
     (define (planet-all-entries-ever feeds cache-directory)
       (let ((entries (append-map feed-entries
                                  (map (lambda (feed)
@@ -129,11 +179,12 @@
     (define (planet-group-entries-by-date entries)
       (group-by entry-iso-date entries))
 
+    (define (planet-group-entries-by-month entries)
+      (group-by entry-iso-month entries))
+
     (define (write-html-file filename sxml)
-      (let ((new-filename (string-append filename ".new")))
-        (with-output-to-file new-filename
-          (lambda ()
-            (write-string "<!DOCTYPE html>")
-            (SXML->HTML sxml)
-            (newline)))
-        (rename-file new-filename filename #t)))))
+      (supersede-text-file
+       filename (lambda ()
+                  (write-string "<!DOCTYPE html>")
+                  (SXML->HTML sxml)
+                  (newline))))))