From: Javier Sancho Date: Sun, 17 Oct 2021 18:29:40 +0000 (+0200) Subject: WIP: Nested commands X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=986fe49efb25343011f28262cd2b7afbf81dd78e;p=guile-click.git WIP: Nested commands --- diff --git a/.gitignore b/.gitignore index ac5a5d7..d44304a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ *.go +*.log aclocal.m4 autom4te.cache/ build-aux/ diff --git a/Makefile.am b/Makefile.am index 976d004..837f1d3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -40,14 +40,14 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache SOURCES = \ click.scm \ + click/args.scm \ click/command.scm \ click/constant.scm \ click/help.scm \ - click/util.scm \ - click/value.scm + click/util.scm TESTS = \ - tests/util.scm + tests/test-args.scm TEST_EXTENSIONS = .scm SCM_LOG_COMPILER = $(top_builddir)/test-env $(GUILE) diff --git a/click.scm b/click.scm index e8f8c09..1f6c69a 100644 --- a/click.scm +++ b/click.scm @@ -18,14 +18,12 @@ (define-module (click) - #:use-module (ice-9 getopt-long) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-1) + #:use-module (click args) #:use-module (click command) #:use-module (click constant) #:use-module (click help) #:use-module (click util) - #:use-module (click value) #:export (command group)) @@ -44,11 +42,25 @@ (new-command (make-command name click-option-spec help procedure commands))) (let ((click-manager (lambda (args) - (let ((values - (getopt-long args (getopt-long-option-spec click-option-spec)))) - (if (option-ref values 'help #f) - (let ((program-name (car args))) - (display-help program-name new-command)) - (apply procedure (map cdr (get-values option-spec values)))))))) + (let ((values (parse-args args click-option-spec))) + ;; Call current command + (cond ((option-ref values 'help #f) + (let ((program-name (car args))) + (display-help program-name new-command))) + (else + (when procedure + (apply procedure (map cdr (get-values option-spec values)))) + ;; Call nested command (if exists) + (call-nested-command commands values))))))) + (set-command-click-manager! new-command click-manager) new-command))) + + +(define (call-nested-command commands values) + (let ((next-command-args (cdar values))) + (when (not (null? next-command-args)) + (let* ((next-command-name (car next-command-args)) + (next-command (find (lambda (command) ( + (display next-command-args)(newline) + (display next-command-name) (newline))))) diff --git a/click/args.scm b/click/args.scm new file mode 100644 index 0000000..b59914d --- /dev/null +++ b/click/args.scm @@ -0,0 +1,69 @@ +;;; Click --- Command Line Interface Creation Kit for GNU Guile +;;; Copyright © 2021 Javier Sancho +;;; +;;; This file is part of Click. +;;; +;;; Click 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. +;;; +;;; Click 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 Click. If not, see . + + +(define-module (click args) + #:use-module (ice-9 getopt-long) + #:use-module (ice-9 readline) + #:use-module (click util) + #:export (get-option-default-value + get-values + parse-args)) + + +(define (parse-args args click-option-spec) + "Parse args using an option-spec click formatted" + (let ((values (getopt-long args + (getopt-long-option-spec click-option-spec) + #:stop-at-first-non-option #t))) + values)) + + +(define (get-values option-spec values) + "Return an associated list with values for all the options in option-spec" + (cond ((null? option-spec) + '()) + (else + (let* ((option (car option-spec)) + (option-name (car option)) + (value (get-normalized-value values option option-name))) + (cons (cons option-name value) + (get-values (cdr option-spec) values)))))) + + +(define (get-normalized-value values option option-name) + "Get value for option, converting from string to the appropriate value" + (let ((convert-proc (assoc-ref (option-type option) 'convert)) + (value (option-ref values option-name #f))) + (cond ((and value (not (option-property option 'flag))) + (convert-proc value)) + (value + value) + (else + (get-option-default-value option))))) + + +(define* (get-option-default-value option #:optional (no-prompt #f)) + "Get default value for option, asking user if prompt property is set" + (let ((default (option-property option 'default))) + (if (not default) + (let ((prompt (option-property option 'prompt))) + (if prompt + (readline (format #f "~a: " prompt)) + default)) + default))) diff --git a/click/value.scm b/click/value.scm deleted file mode 100644 index f42eb2f..0000000 --- a/click/value.scm +++ /dev/null @@ -1,60 +0,0 @@ -;;; Click --- Command Line Interface Creation Kit for GNU Guile -;;; Copyright © 2021 Javier Sancho -;;; -;;; This file is part of Click. -;;; -;;; Click 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. -;;; -;;; Click 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 Click. If not, see . - - -(define-module (click value) - #:use-module (ice-9 getopt-long) - #:use-module (ice-9 readline) - #:use-module (click util) - #:export (get-option-default-value - get-values)) - - -(define (get-values option-spec values) - "Return an associated list with values for all the options in option-spec" - (cond ((null? option-spec) - '()) - (else - (let* ((option (car option-spec)) - (option-name (car option)) - (value (get-normalized-value values option option-name))) - (cons (cons option-name value) - (get-values (cdr option-spec) values)))))) - - -(define (get-normalized-value values option option-name) - "Get value for option, converting from string to the appropriate value" - (let ((convert-proc (assoc-ref (option-type option) 'convert)) - (value (option-ref values option-name #f))) - (cond ((and value (not (option-property option 'flag))) - (convert-proc value)) - (value - value) - (else - (get-option-default-value option))))) - - -(define* (get-option-default-value option #:optional (no-prompt #f)) - "Get default value for option, asking user if prompt property is set" - (let ((default (option-property option 'default))) - (if (not default) - (let ((prompt (option-property option 'prompt))) - (if prompt - (readline (format #f "~a: " prompt)) - default)) - default))) diff --git a/tests/test-args.scm b/tests/test-args.scm new file mode 100644 index 0000000..d41abe2 --- /dev/null +++ b/tests/test-args.scm @@ -0,0 +1,45 @@ +;;; Click --- Command Line Interface Creation Kit for GNU Guile +;;; Copyright © 2021 Javier Sancho +;;; +;;; This file is part of Click. +;;; +;;; Click 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. +;;; +;;; Click 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 Click. If not, see . + + +(define-module (tests test-args) + #:use-module (srfi srfi-64) + #:use-module (click args)) + + +(test-begin "test-args") + +(define option-spec + '((count (single-char #\c) (default 1)) + (name (prompt "Your name")) + (help (flag #t)))) + +(test-error #t (parse-args '("program" "--count") option-spec)) + +(test-error #t (parse-args '("program" "-x") option-spec)) + +(test-equal (parse-args '("program" "-c" "2" "--name" "joe") option-spec) + '((()) (name . "joe") (count . "2"))) + +(test-equal (parse-args '("program" "-c" "2" "command" "-x") option-spec) + '((() "command" "-x") (count . "2"))) + +(test-equal (get-values option-spec '((()) (name . "joe") (count . "2"))) + '((count . 2) (name . "joe") (help . #f))) + +(test-end "test-args") diff --git a/tests/util.scm b/tests/util.scm deleted file mode 100644 index 9a7574d..0000000 --- a/tests/util.scm +++ /dev/null @@ -1,17 +0,0 @@ -;;; Click --- Command Line Interface Creation Kit for GNU Guile -;;; Copyright © 2021 Javier Sancho -;;; -;;; This file is part of Click. -;;; -;;; Click 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. -;;; -;;; Click 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 Click. If not, see .