blob: 3e1fdfeaf1dff921dc99a9a9b976d9c70bef4290 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
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))
|
