Initial commit.

2 files changed, 225 insertions, 0 deletions

diff --git a/feed/scripts/rss.scm b/feed/scripts/rss.scm
new file mode 100644
index 0000000..a9005d5
--- /dev/null
+++ b/feed/scripts/rss.scm
@@ -0,0 +1,107 @@
+;;; 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 scripts rss)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (feed rss)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:export (feed-rss))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  ;; Alist of default option values.
+  '())
+
+(define %options
+  (list (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\o "output-file") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'output-file arg result)))
+        (option '(#\s "search") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'search arg result)))
+        (option '("show") #t #t
+                 (lambda (opt name arg result)
+                   (alist-cons 'show arg result)))))
+
+(define (show-help)
+  (display "Usage: guix rss -o FILE\n")
+  (newline)
+  (display "
+  -h, --help             display this help and exit")
+  (display "
+  -V, --version          display version information and exit")
+  (display "
+  -o, --output-file=FILE convert rss to LISP FILE")
+  (display "
+  -s, --search=REGEXP    search in name and description using REGEXP")
+  (display "
+      --show=RSS        show details about RSS")
+  (newline))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (feed-rss . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
+  (let* ((opts (parse-options))         
+         (output (assoc-ref opts 'output-file))
+         (search (assoc-ref opts 'search))
+         (show (assoc-ref opts 'show)))
+    (cond (show
+           (leave-on-EPIPE
+            (for-each (cute feed->recutils <>)
+                      (find-feeds-by-name show))))
+          (search
+           (let* ((patterns (filter-map (match-lambda
+                                          (('search . rx) rx)
+                                          (_ #f))
+                                        opts))
+                  (regexps (map (cut make-regexp* <> regexp/icase) patterns)))
+             (leave-on-EPIPE
+              (let-values (((rss scores)
+                            (find-feeds-by-description regexps)))
+                (for-each (lambda (rss score)
+                            (feed->recutils rss
+                                            #:extra-fields
+                                            `((relevance . ,score))))
+                          rss
+                          scores)))
+             #t))
+          (output
+           (with-output-to-file output
+             (lambda _ (pretty-print (feeds->lisp))))))))
diff --git a/feed/ui.scm b/feed/ui.scm
new file mode 100644
index 0000000..3e1fdfe
--- /dev/null
+++ b/feed/ui.scm
@@ -0,0 +1,118 @@
+;;; 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 ui)
+  #:use-module (guix ui)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 ftw)
+  #:export (feed-main))
+
+(define (command-files)
+  "Return the list of source files that define Feed sub-commands."
+  (define directory
+    (and=> (search-path %load-path "feed.scm")
+           (compose (cut string-append <> "/feed/scripts")
+                    dirname)))
+
+  (define dot-scm?
+    (cut string-suffix? ".scm" <>))
+
+  (if directory
+      (scandir directory dot-scm?)
+      '()))
+
+(define (commands)
+  "Return the list of Feed command names."
+  (map (compose (cut string-drop-right <> 4)
+                basename)
+       (command-files)))
+
+(define (show-feed-usage)
+  (format (current-error-port)
+          "Try `feed --help' for more information.~%")
+  (exit 1))
+
+(define (show-feed-help)
+  (format #t "Usage: feed COMMAND ARGS...
+Run COMMAND with ARGS.\n")
+  (newline)
+  (format #t "COMMAND must be one of the sub-commands listed below:\n")
+  (newline)
+  ;; TODO: Display a synopsis of each command.
+  (format #t "~{   ~a~%~}" (sort (commands) string<?)))
+
+(define program-name
+  ;; Name of the command-line program currently executing, or #f.
+  (make-parameter #f))
+
+(define (run-feed-command command . args)
+  "Run COMMAND with the given ARGS.  Report an error when COMMAND is not
+found."
+  (define module
+    (catch 'misc-error
+      (lambda ()
+        (resolve-interface `(feed scripts ,command)))
+      (lambda -
+        (format (current-error-port)
+                "feed: ~a: command not found~%" command)
+        (show-feed-usage))))
+
+  (let ((command-main (module-ref module
+                                  (symbol-append 'feed- command))))
+    (parameterize ((program-name command))
+      ;; Disable canonicalization so we don't don't stat unreasonably.
+      (with-fluids ((%file-port-name-canonicalization #f))
+        (dynamic-wind
+          (const #f)
+          (lambda ()
+            (apply command-main args))
+          (lambda ()
+            ;; Abuse 'exit-hook' (which is normally meant to be used by the
+            ;; REPL) to run things like profiling hooks upon completion.
+            (run-hook exit-hook)))))))
+
+(define (show-feed-usage)
+  (format (current-error-port)
+          "Try `feed --help' for more information.~%")
+  (exit 1))
+
+(define (run-feed . args)
+  "Run the 'feed' command defined by command line ARGS."
+  (define option? (cut string-prefix? "-" <>))
+
+  ;; The default %LOAD-EXTENSIONS includes the empty string, which doubles the
+  ;; number of 'stat' calls per entry in %LOAD-PATH.  Shamelessly remove it.
+  (set! %load-extensions '(".scm"))
+
+  (match args
+    (()
+     (format (current-error-port)
+             "feed: missing command name~%")
+     (show-feed-usage))
+    ((or ("-h") ("--help"))
+     (show-feed-help))
+    ((command args ...)
+     (apply run-feed-command
+            (string->symbol command)
+            args))))
+
+(define (feed-main arg0 . args)
+  (apply run-feed args))