Refactor.

2 files changed, 196 insertions, 11 deletions

diff --git a/Makefile.am b/Makefile.am
index c57d934..5be27b4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -33,18 +33,11 @@ AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY))
 AM_V_GUILEC_0 = @echo "  GUILEC     " $@;
 
 MODULES =					\
-  feed.scm					\
-  feed/scripts/rss.scm				\
   feed/ui.scm					\
-  rss/feeds.scm					\
-  rss/feeds/code.scm				\
-  rss/feeds/emacs.scm				\
-  rss/feeds/game.scm				\
-  rss/feeds/hardware.scm			\
-  rss/feeds/news.scm				\
-  rss/feeds/planet.scm				\
-  rss/feeds/video.ru.scm			\
-  rss/feeds/video.scm
+  feed/rss.scm					\
+  feed/scripts/rss.scm				\
+  feed.scm					\
+  guix.scm
 
 GO_FILES = $(MODULES:%.scm=%.go)
 
diff --git a/feed/rss.scm b/feed/rss.scm
new file mode 100644
index 0000000..08bfa89
--- /dev/null
+++ b/feed/rss.scm
@@ -0,0 +1,192 @@
+;;; Guile Feed --- Feed command-line interface.
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of Guile Feed.
+;;;
+;;; Guile Feed 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.
+;;;
+;;; Guile Feed 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 Guile Feed.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (feed rss)
+  #:use-module (guix discovery)
+  #:use-module (guix records)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:export (%feed-module-path
+            find-feeds-by-name
+            find-feeds-by-description
+            fold-feeds
+
+            feeds->lisp
+            feed->recutils
+            feeds->recutils
+
+            feed
+            feed?
+            feed-name
+
+            reddit-rss
+            youtube-channel
+            youtube-user))
+
+(define-record-type* <feed>
+  feed make-feed
+  feed?
+  (name feed-name)
+  (description feed-description)
+  (uri feed-uri)
+  (location feed-location
+            (default (and=> (current-source-location)
+                            source-properties->location))
+            (innate)))
+
+(define reddit-rss
+  (cut string-append "https://www.reddit.com/r/" <> "/.rss"))
+
+(define youtube-channel
+  (cut string-append
+       "https://www.youtube.com/feeds/videos.xml?channel_id=" <>))
+
+(define youtube-user
+  (cut string-append "https://www.youtube.com/feeds/videos.xml?user=" <>))
+
+
+;; Code from (gnu services) module.
+
+(define %distro-root-directory
+  ;; Absolute file name of the module hierarchy.
+  (let ((file (string-append (getenv "HOME") "/.config/guile-feed")))
+    (and (file-exists? file) (canonicalize-path file))))
+
+(define %default-package-module-path
+  ;; Default search path for package modules.
+  `((,%distro-root-directory . "rss")))
+
+(define %feed-module-path
+  ;; Search path for package modules.  Each item must be either a directory
+  ;; name or a pair whose car is a directory and whose cdr is a sub-directory
+  ;; to narrow the search.
+  (let* ((not-colon   (char-set-complement (char-set #\:)))
+         (environment (string-tokenize (or (getenv "GUILE_FEED_PATH") "")
+                                       not-colon)))
+    (set! %load-path
+          (append environment (list %distro-root-directory) %load-path))
+    (set! %load-compiled-path
+          (append environment (list %distro-root-directory) %load-compiled-path))
+
+    (make-parameter (append environment %default-package-module-path))))
+
+(define* (fold-feeds proc init
+                     #:optional
+                     (modules (all-modules (%feed-module-path))))
+  "For each service type exported by one of MODULES, call (PROC RESULT).  INIT
+is used as the initial value of RESULT."
+  (fold-module-public-variables (lambda (object result)
+                                  (if (feed? object)
+                                      (proc object result)
+                                      result))
+                                init
+                                modules))
+
+
+
+(define (feeds->lisp)
+  `(setq elfeed-feeds
+         (quote ,(fold-feeds (lambda (feed lst)
+                               (cons (match feed
+                                       (($ <feed> name description uri)
+                                        (cond ((string-prefix? "emacs-" name)
+                                               `(,uri emacs))
+                                              ((string-prefix? "game-" name)
+                                               `(,uri game))
+                                              ((string-prefix? "planet-" name)
+                                               `(,uri planet))
+                                              ((string-prefix? "video-" name)
+                                               `(,uri video))
+                                              (else uri))))
+                                     lst))
+                             '()))))
+
+(define* (feed->recutils feed #:key (extra-fields '()))
+  (match feed
+    (($ <feed> name description uri)
+     (format #t "name: ~a~%" name)
+     (format #t "description: ~a~%" description)
+     (format #t "link: ~a~%" uri)
+     (for-each (match-lambda
+                 ((field . value)
+                  (let ((field (symbol->string field)))
+                    (format #t "~a: ~a~%" field value))))
+               extra-fields)
+     (newline))))
+
+(define (feeds->recutils)
+  (fold-feeds (lambda (feed lst)
+                (cons (feed->recutils feed) lst))
+              '()))
+
+
+;;;
+;;; Search
+;;;
+
+(define %feed-metrics
+  ;; Metrics used to compute the "relevance score" of a feed against a set
+  ;; of regexps.
+  `((,feed-name . 3)
+    (,feed-description . 2)
+    (,(lambda (type)
+        (match (and=> (feed-location type) location-file)
+          ((? string? file) (basename file ".scm"))
+          (#f "")))
+     . 1)))
+
+(define (feed-relevance feed regexps)
+  "Return a score denoting the relevance of FEED for REGEXPS.  A score of
+zero means that FEED does not match any of REGEXPS."
+  (relevance feed regexps %feed-metrics))
+
+(define find-feeds-by-name
+  (let ((feeds (delay
+                 (fold-feeds (lambda (p r)
+                               (vhash-cons (feed-name p) p r))
+                             vlist-null))))
+    (lambda* (name #:optional version)
+      "Return the list of feeds with the given NAME."
+      (vhash-fold* cons '() name (force feeds)))))
+
+(define (find-feeds-by-description regexps)
+  "Return two values: the list of feeds whose name or description matches at
+least one of REGEXPS sorted by relevance, and the list of relevance scores."
+  (let ((matches (fold-feeds (lambda (feed result)
+                               (match (feed-relevance feed regexps)
+                                 ((? zero?)
+                                  result)
+                                 (score
+                                  (cons (list feed score)
+                                        result))))
+                                '())))
+    (unzip2 (sort matches
+                  (lambda (m1 m2)
+                    (match m1
+                      ((feed1 score1)
+                       (match m2
+                         ((feed2 score2)
+                          (if (= score1 score2)
+                              (string>? (feed-name feed1)
+                                        (feed-name feed2))
+                              (> score1 score2)))))))))))