cuirass: Add command line options.

* bin/cuirass.in (show-help, %options): new variables.
(main): Adapt.
* src/cuirass/ui.scm: New file.
* Makefile.am (dist_pkgmodule_DATA): Add it.
pull/3/head
Mathieu Lirzin 2016-06-10 22:27:41 +02:00
parent 8fb2983dce
commit 87a79ae33d
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
3 changed files with 80 additions and 10 deletions

View File

@ -3,7 +3,10 @@
bin_SCRIPTS = bin/cuirass
noinst_SCRIPTS = pre-inst-env
dist_pkgmodule_DATA = src/cuirass/base.scm
dist_pkgmodule_DATA = \
src/cuirass/base.scm \
src/cuirass/ui.scm
nodist_pkgmodule_DATA = \
$(dist_pkgmodule_DATA:%.scm=%.go) \
src/cuirass/config.scm \

View File

@ -22,8 +22,26 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(use-modules (cuirass base)
(cuirass ui)
(ice-9 getopt-long)
(ice-9 match))
(define* (show-help #:optional (prog (program-name)))
(simple-format #t "Usage: ~a [OPTIONS] [CACHEDIR]" prog)
(display "
Run Guix job from a git repository cloned in CACHEDIR.
-I, --interval[=]N Wait N seconds between each evaluation
-V, --version Display version
-h, --help Display this help message")
(newline)
(show-package-information))
(define %options
`((interval (single-char #\I) (value #t))
(version (single-char #\V) (value #f))
(help (single-char #\h) (value #f))))
(define %guix-repository
(make-parameter "git://git.savannah.gnu.org/guix.git"))
@ -92,12 +110,22 @@ DIR if required."
;;;
(define* (main #:optional (args (command-line)))
(match args
((program interval)
(let ((cachedir (getenv "CUIRASS_CACHEDIR")))
(while #t
(pull-changes cachedir)
(compile cachedir)
(evaluate cachedir)
(sleep (string->number interval)))))
(_ (main (list (car args) "60")))))
(let ((opts (getopt-long args %options))
(progname "cuirass"))
(cond
((option-ref opts 'help #f)
(show-help progname)
(exit 0))
((option-ref opts 'version #f)
(show-version progname)
(exit 0))
(else
(let* ((args (option-ref opts '() #f))
(cachedir (if (null? args)
(getenv "CUIRASS_CACHEDIR")
(car args))))
(while #t
(pull-changes cachedir)
(compile cachedir)
(evaluate cachedir)
(sleep (string->number (option-ref opts 'interval "60")))))))))

39
src/cuirass/ui.scm Normal file
View File

@ -0,0 +1,39 @@
;;;; ui.scm - user interface facilities for command-line tools
;;;
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass 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.
;;;
;;; Cuirass 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 Cuirass. If not, see <http://www.gnu.org/licenses/>.
(define-module (cuirass ui)
#:use-module (cuirass config)
#:export (show-version
show-package-information))
(define (show-version prog)
"Display version information for COMMAND."
(simple-format #t "~a (~a) ~a~%" prog %package-name %package-version)
(display "Copyright (C) 2016 the Cuirass 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.")
(newline))
(define (show-package-information)
(newline)
(format #t "Report bugs to: ~a." %package-bugreport)
(newline)
(display "General help using GNU software: <http://www.gnu.org/gethelp/>")
(newline))