Init

date-strings.scm

@@ -0,0 +1,53 @@
+;;
+;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
+;;
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;;
+
+;; Simple helper module for feedsnake; converts between datestrings of different
+;; formats and srfi-19 date objects.
+;; Some of these formats have dedicated output codes in srfi-19 (~c, ~x, etc),
+;; but it looks like the chicken doesn't support them.
+(module date-strings
+	(date->rfc339-string rfc339-string->date date->rfc228-string)
+
+(import scheme
+		(chicken condition) (chicken format)
+		srfi-19 srfi-13)
+
+
+;; Converts a date into an rfc399 string
+(define (date->rfc339-string date)
+  (date->string date "~Y-~m-~dT~H:~M:~S~z"))
+
+
+;; Converts an rfc339 string into a datetime, timezone optional
+;; … copied but not exported by feedsnake? mayyyybe >w>"
+(define (rfc339-string->date string)
+  (handle-exceptions exn
+	  (handle-exceptions exn
+		  (string->date string "~Y-~m-~dT~H:~M:~S")
+		#f)
+	(string->date string "~Y-~m-~dT~H:~M:~S~z")))
+
+
+;; Date into an RFC228 (e-mail) string
+(define (date->rfc228-string date)
+  (let* ([month (string-titlecase (date->string date "~b"))]
+		 [weekday (string-titlecase (date->string date "~a"))]
+		 [timezone-raw (date->string date "~z")]
+		 [timezone (if (string=? timezone-raw "Z") "+0000" timezone-raw)])
+	(format (date->string date "~~A, ~d ~~A ~Y ~T ~~A") weekday month timezone)))
+
+) ;; date-strings module

feedsnake.scm

@@ -0,0 +1,230 @@
+;;
+;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
+;;
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;;
+
+(load "date-strings.scm")
+(load "named-format.scm")
+
+
+(module feedsnake
+	(updated-feed-string read-feed entries-since entry->string)
+
+(import scheme
+		(chicken base) (chicken condition) (chicken io) (chicken port)
+		srfi-1 srfi-19 srfi-69
+		date-strings
+		http-client
+		named-format
+		atom rss)
+
+
+;; Read the given port into a feedsnake-feed (alist), no matter the format! c:<
+(define (read-feed in-port)
+  (let (;;[rss (rss:read in-port)]
+		[atom (read-atom-feed in-port)])
+	(if atom
+		(atom-doc->feedsnake-feed atom)
+		#f)))
+
+
+;; A list of entries updated since the given date
+(define (entries-since feed date-utc)
+  (let ([entry-date (lambda (entry) (car (alist-ref 'updated entry)))]
+		[since-entries '()])
+	(map
+	 (lambda (entry)
+	   (if (date>=? (entry-date entry) date-utc)
+		   (set! since-entries
+			 (append since-entries (list entry)))))
+	 (car (alist-ref 'entries feed)))
+	since-entries))
+
+
+;; Returns either the updated string of a feed (in comparison to old string),
+;; or #f if literally nothing's changed
+(define (updated-feed-string url old-string)
+  (let* ([new-string (fetch-feed-string url)]
+		 [updated? (not (eq? (hash old-string) (hash new-string)))])
+	(if updated?
+		new-string
+		#f)))
+
+
+;; Download a feed (AKA fetch over HTTP to a string)
+(define (fetch-feed-string url)
+  (call-with-output-string
+   (lambda (out) (fetch-http url out))))
+
+
+(define (entry->string entry template)
+  (named-format
+   template
+   (entry-string-templating-parameters entry template)))
+
+
+;; Returns an alist of string replacements/parameters for a given entry
+;; For use with named-format
+(define (entry-string-templating-parameters entry template)
+  (let* ([alist-car
+		  (lambda (key alist)
+			(let ([value (alist-ref key alist)])
+			  (if value
+				  (car value))))]
+		 [updated (or (alist-car 'updated entry) (alist-car 'published entry))]
+		 [published (or (alist-car 'published entry) updated)]
+		 [urls (alist-car 'url entry)])
+	`((title ,(alist-car 'title entry))
+	  (updated ,(if updated (date->rfc228-string updated)))
+	  (published ,(if published (date->rfc228-string published)))
+	  (summary ,(alist-car 'summary entry))
+	  (url ,(cond
+			 [(list? urls) (car urls)]
+			 [(string? urls) urls]))
+	  (urls ,(cond
+			  [(list? urls) urls]
+			  [(string? urls) (list urls)])))))
+
+
+;; Parse an atom feed into a feedsnake-friendly alist
+(define (atom-doc->feedsnake-feed atom)
+  `((title ,(last (feed-title atom)))
+	(updated ,(feed-updated atom))
+	(entry-updated ,(atom-feed-latest-entry-date atom))
+	(entries ,(map atom-entry->feedsnake-entry (feed-entries atom)))))
+
+
+;; Parse an atom entry into a feedsnake entry :>
+(define (atom-entry->feedsnake-entry entry)
+  (let ([published (rfc339-string->date (entry-published entry))]
+		[updated (rfc339-string->date (entry-updated entry))])
+	`((title ,(last (entry-title entry)))
+	  (updated ,(or updated published))
+	  (published ,(or published updated))
+	  (summary ,(last (entry-summary entry)))
+	  (url ,(map link-uri (entry-links entry))))))
+
+
+;; Get an atom feed's latest date for an entry's updating/publishing
+(define (atom-feed-latest-entry-date atom)
+  (let ([entry-date
+		 (lambda (entry)
+		   (or (rfc339-string->date (entry-updated entry))
+			   (rfc339-string->date (entry-published entry))))])
+	(reduce
+	 (lambda (a b)
+	   (if (date>=? a b) a b))
+	 #f
+	 (map entry-date (feed-entries atom)))))
+
+
+;; Download a file over HTTP to the given port.
+(define (fetch-http url out-port)
+  (call-with-input-request
+   url #f
+   (lambda (in-port) (copy-port in-port out-port))))
+
+) ;; feedsnake module
+
+
+
+;; The UNIX-style frontend for feedsnake
+(module feedsnake-unix
+	(update-feed-file latest-entries feed-files)
+
+(import scheme
+		(chicken base) (chicken condition) (chicken file) (chicken io)
+		(chicken process-context) (chicken process-context posix)
+		srfi-1 srfi-19
+		date-strings
+		feedsnake
+		xattr)
+
+
+;; Switch the cached version of the feed with a newer version, if available
+(define (update-feed-file feed-path)
+  (let* ([old-string (call-with-input-file feed-path
+					   (lambda (in-port) (read-string #f in-port)))]
+		 [new-string (updated-feed-string
+					  (get-xattr feed-path "user.xdg.origin.url")
+					  old-string)])
+	(if new-string
+		(call-with-output-file feed-path
+		  (lambda (out) (write-string new-string #f out))))
+	new-string))
+
+
+;; List of entries updated/published since last feed parsing
+(define (latest-entries feed-path)
+  (let* ([feed (call-with-input-file feed-path read-feed)]
+		 [xattr-last-update (get-xattr feed-path "user.feedsnake.parsed")]
+		 [last-update (if xattr-last-update
+						  (rfc339-string->date xattr-last-update)
+						  (date->utc-date (make-date 0 0 0 0 01 01 1971)))])
+	(set-xattr feed-path "user.feedsnake.parsed"
+			   (date->rfc339-string (current-date-utc)))
+	(entries-since feed last-update)))
+
+
+;; List of all entries of the feed
+(define (all-entries feed-path)
+  (let ([feed (call-with-input-file feed-path read-feed)])
+	(car (alist-ref 'entries feed))))
+
+
+;; The user's presumed config root.
+(define (config-directory)
+  (or (get-environment-variable "XDG_CONFIG_HOME")
+	  (string-append (sixth (user-information (current-user-id))) "/.config")))
+
+
+;; Path of the feedsnake config directory
+(define (feedsnake-directory)
+  (create-directory (string-append (config-directory) "/feedsnake") #t))
+
+
+;; Path of the feeds directory
+(define (feeds-directory)
+  (create-directory (string-append (feedsnake-directory) "/feeds") #t))
+
+
+;; Lists all configured feeds (files in feed directory)
+(define (feed-files)
+  (map (lambda (relative-path)
+		 (string-append (feeds-directory) "/" relative-path))
+	   (directory (feeds-directory))))
+
+
+;; Convert a date of arbitrary timezone to UTC
+(define (date->utc-date date)
+  (time-utc->date (date->time-utc date)))
+
+
+;; The current date, with UTC (-0; Z) timezone
+(define (current-date-utc)
+  (date->utc-date (current-date)))
+
+) ;; feedsnake-unix module
+
+
+
+(define *retpoŝto*
+  "Subject: ~{{~A||Unnamed post||title}}
+From:~{{ ~A ||||from-name}}<~{{~A||feedsnake@localhost||from-address}}>
+To:~{{ ~A ||You||to-name}}<~{{~A||you@localhost||to-address}}>
+Date: ~{{~A||||updated}}
+
+~{{~{~a~^, ~}~%~%***~%||||urls}}
+~{{~A||||summary}}")

named-format.scm

@@ -0,0 +1,94 @@
+;;
+;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
+;;
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+;;
+
+
+;; A simple module for making "template" strings á la `format` (but less flexible, more
+;; broken, and based on named/keyed parameters rather than positional parameters).
+;; TL;DR, "hi #{{role}}!!" instead of "hi ~A!!"
+;; (Helper module for feedsnake.)
+(module named-format
+	(named-format)
+
+(import scheme
+		(chicken base) (chicken string)
+		srfi-1 srfi-13 (only srfi-130 string-split)
+		format)
+
+
+;; Replaces all named "parameters" within a string with their associated values in the given alist.
+;; A string with two parameters might look something like this:
+;;      "You're about to eat #{{food||rice}} for #{{cost}}! Bonne apetit!"
+;; Whose parameter alist might look like this:
+;;      '((food "omlette") (cost "$9.00"))
+;; If you don't specify a parameter's value in the alist, it's #{{mention}} in the string will just
+;; be removed, or replaced with a default value, if provided like so:
+;;      #{{food||rice}}
+;; has a default value of "rice".
+(define (named-format string parameter-alist)
+  (replace-parameters string
+					  parameter-alist
+					  (reverse (string-contains-all string "~{{" 0))
+					  #f))
+
+
+;; Replaces the parameter mentions in the given string at the given indices with their
+;; associated alist values. The `parameter-indices` list must be given in reverse order
+;; (e.g., 100, 99, 73).
+(define (replace-parameters string parameters parameter-indices previous-index)
+  (let* ([index (car parameter-indices)]
+		 [next-index (if (null? (cdr parameter-indices))
+						 #f
+						 (cadr parameter-indices))]
+		 [substituted
+		  (replace-parameter string parameters index (or previous-index (string-length string)))])
+	(if next-index
+		(replace-parameters substituted parameters (cdr parameter-indices) index)
+		substituted)))
+
+
+;; Substitute a single string's parameter beginning at the given index.
+;; This is bad, I'm genuinely ashamed. Please forgive me ;-;
+(define (replace-parameter string parameters index max-index)
+  (let* ([end-of-substitution (+ 2 (string-contains string "}}" index max-index))]
+		 [columns (string-split
+				   (string-copy string (+ 3 index) (- end-of-substitution 2))
+				   "||")]
+		 [key-symbols (map string->symbol (cddr columns))]
+		 [values (filter (lambda (a) a)
+						 (map (lambda (key)
+								(let ([value (alist-ref key parameters)])
+								  (if value (car value) #f)))
+							  key-symbols))]
+		 [value (if (null? values)
+					(cadr columns)
+					(car values))]
+		 [formatting (if (and (string? value) (string-null? value))
+						 "~A"
+						 (car columns))])
+	(string-replace string (format formatting value) index end-of-substitution)))
+
+
+;; A list of all instances of a substring within a string, by index
+(define (string-contains-all string needle from-index)
+  (let* ([match-index (string-contains string needle from-index)]
+		 [next-match-index (string-contains string needle (+ 1 match-index))])
+	(if next-match-index
+		(append (list match-index)
+				(string-contains-all string needle (+ 1 match-index)))
+		(list match-index))))
+
+) ;; named-format module