summaryrefslogtreecommitdiff
path: root/haunt/ui.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-04-11 15:06:13 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-04-11 15:10:46 -0400
commit3320a67edb789c764fb539e97656ae811227065d (patch)
tree74c66c46d3bd4075857087cbad0075a34dde56d5 /haunt/ui.scm
parent11a3e70657ffe2727ed0d1164e77c6c9b3420cf4 (diff)
ui: Improve option processing and help output.
* haunt/ui.scm (%common-options, %default-common-options): New variables. (simple-args-fols, show-common-options-help, leave, string->number*, load-config): New procedures. (haunt-error): Remove. (show-version-and-exit): Actually exit. Add 'name' argument. (haunt-main): Use new 'show-version-and-exit'. * haunt/ui/serve.scm (show-server-help): Remove. (show-help): New procedure. (%options, %default-options): New variables. (haunt-serve): Use SRFI-37 option processing.
Diffstat (limited to 'haunt/ui.scm')
-rw-r--r--haunt/ui.scm70
1 files changed, 56 insertions, 14 deletions
diff --git a/haunt/ui.scm b/haunt/ui.scm
index 910adf9..e53adb8 100644
--- a/haunt/ui.scm
+++ b/haunt/ui.scm
@@ -26,24 +26,28 @@
#:use-module (ice-9 format)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-37)
#:use-module (haunt config)
+ #:use-module (haunt site)
#:export (program-name
- haunt-error
show-version-and-exit
+ simple-args-fold
+ %common-options
+ %default-common-options
+ show-common-options-help
+ leave
+ string->number*
+ load-config
option?
haunt-main))
(define commands
- '(serve))
+ '("serve"))
(define program-name (make-parameter 'haunt))
-(define (haunt-error str . args)
- (format (current-error-port) "~a: " (program-name))
- (apply format (current-error-port) str args)
- (newline))
-
(define (show-haunt-help)
(format #t "Usage: haunt COMMAND ARGS...
Run COMMAND with ARGS.~%~%")
@@ -54,20 +58,58 @@ Run COMMAND with ARGS.~%~%")
(format #t "Try `haunt --help' for more information.~%")
(exit 1))
-(define (show-version-and-exit)
- (let ((name (if (eq? (program-name) 'haunt)
- "haunt"
- (format #f "haunt ~a" (program-name)))))
- (format #t "~a ~a
+(define (show-version-and-exit name)
+ (format #t "~a ~a
Copyright (C) 2015 the Haunt authors
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.~%"
- name %haunt-version)))
+ name %haunt-version)
+ (exit 0))
+
+(define (leave format-string . args)
+ "Display error message and exist."
+ (apply format (current-error-port) format-string args)
+ (newline)
+ (exit 1))
+
+(define (string->number* str)
+ "Like `string->number', but error out with an error message on failure."
+ (or (string->number str)
+ (leave "~a: invalid number" str)))
+
+(define (simple-args-fold args options default-options)
+ (args-fold args options
+ (lambda (opt name arg result)
+ (leave "~A: unrecognized option" name))
+ (lambda (arg result)
+ (leave "~A: extraneuous argument" arg))
+ default-options))
+
+(define %common-options
+ (list (option '(#\c "config") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'config arg result)))))
+
+(define %default-common-options
+ '((config . "haunt.scm")))
+
+(define (show-common-options-help)
+ (display "
+ -c, --config configuration file to load"))
(define (option? str)
(string-prefix? "-" str))
+(define* (load-config file-name)
+ "Load configuration from FILE-NAME."
+ (if (file-exists? file-name)
+ (let ((obj (load file-name)))
+ (if (site? obj)
+ obj
+ (leave "configuration object must be a site, got: ~a" obj)))
+ (leave "configuration file found: ~a" file-name)))
+
(define (run-haunt-command command . args)
(let* ((module
(catch 'misc-error
@@ -87,7 +129,7 @@ There is NO WARRANTY, to the extent permitted by law.~%"
((or ("-h") ("--help"))
(show-haunt-help))
(("--version")
- (show-version-and-exit))
+ (show-version-and-exit "haunt"))
(((? option? opt) _ ...)
(format (current-error-port)
"haunt: unrecognized option '~a'~%"