├── .gitignore ├── .github ├── FUNDING.yml └── workflows │ └── run-tests.yaml ├── images ├── clingon-demo.gif ├── clingon-demo-tree.png └── clingon-zsh-completions.gif ├── Dockerfile.tests ├── Dockerfile.ccl ├── Dockerfile.ecl ├── Dockerfile.sbcl ├── Makefile ├── scripts ├── run-tests.sh └── run-ci-tests.sh ├── Dockerfile.demo ├── Dockerfile.intro ├── extras ├── completions.bash └── _clingon-demo ├── LICENSE ├── tests ├── test-package.lisp ├── test-utils.lisp ├── test-options.lisp └── test-command.lisp ├── examples ├── demo │ ├── package.lisp │ ├── print-doc.lisp │ ├── echo.lisp │ ├── zsh-completion.lisp │ ├── greet.lisp │ ├── engine.lisp │ ├── sleep.lisp │ ├── math.lisp │ ├── logging.lisp │ └── main.lisp └── intro │ └── intro.lisp ├── src ├── package.lisp ├── utils.lisp ├── conditions.lisp └── options.lisp ├── clingon.intro.asd ├── clingon.test.asd ├── clingon.demo.asd ├── clingon.asd ├── CHANGELOG.org └── docs └── clingon-demo.md /.gitignore: -------------------------------------------------------------------------------- 1 | # Emacs backup files 2 | *~ 3 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | --- 2 | github: [dnaeon] 3 | -------------------------------------------------------------------------------- /images/clingon-demo.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ruricolist/clingon/master/images/clingon-demo.gif -------------------------------------------------------------------------------- /images/clingon-demo-tree.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ruricolist/clingon/master/images/clingon-demo-tree.png -------------------------------------------------------------------------------- /images/clingon-zsh-completions.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ruricolist/clingon/master/images/clingon-zsh-completions.gif -------------------------------------------------------------------------------- /Dockerfile.tests: -------------------------------------------------------------------------------- 1 | FROM clfoundation/sbcl:2.1.7 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | WORKDIR /root/quicklisp/local-projects/clingon 5 | COPY . . 6 | RUN /usr/local/bin/install-quicklisp 7 | ENTRYPOINT ["./run-tests.sh"] 8 | -------------------------------------------------------------------------------- /Dockerfile.ccl: -------------------------------------------------------------------------------- 1 | FROM clfoundation/ccl:1.12 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | ENV QUICKLISP_DIST_VERSION=latest 5 | ENV LISP=ccl 6 | 7 | WORKDIR /app 8 | COPY . . 9 | 10 | RUN mkdir -p ~/.config/common-lisp/source-registry.conf.d && \ 11 | echo '(:tree "/app/")' > ~/.config/common-lisp/source-registry.conf.d/workspace.conf && \ 12 | /usr/local/bin/install-quicklisp 13 | 14 | ENTRYPOINT ["./scripts/run-tests.sh"] 15 | -------------------------------------------------------------------------------- /Dockerfile.ecl: -------------------------------------------------------------------------------- 1 | FROM clfoundation/ecl:21.2.1 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | ENV QUICKLISP_DIST_VERSION=latest 5 | ENV LISP=ecl 6 | 7 | WORKDIR /app 8 | COPY . . 9 | 10 | RUN mkdir -p ~/.config/common-lisp/source-registry.conf.d && \ 11 | echo '(:tree "/app/")' > ~/.config/common-lisp/source-registry.conf.d/workspace.conf && \ 12 | /usr/local/bin/install-quicklisp 13 | 14 | ENTRYPOINT ["./scripts/run-tests.sh"] 15 | -------------------------------------------------------------------------------- /Dockerfile.sbcl: -------------------------------------------------------------------------------- 1 | FROM clfoundation/sbcl:2.2.4 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | ENV QUICKLISP_DIST_VERSION=latest 5 | ENV LISP=sbcl 6 | 7 | WORKDIR /app 8 | COPY . . 9 | 10 | RUN mkdir -p ~/.config/common-lisp/source-registry.conf.d && \ 11 | echo '(:tree "/app/")' > ~/.config/common-lisp/source-registry.conf.d/workspace.conf && \ 12 | /usr/local/bin/install-quicklisp 13 | 14 | ENTRYPOINT ["./scripts/run-tests.sh"] 15 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | LISP ?= sbcl 2 | 3 | intro: 4 | ${LISP} --eval '(ql:quickload :clingon.intro)' \ 5 | --eval '(asdf:make :clingon.intro)' \ 6 | --eval '(quit)' 7 | 8 | demo: 9 | ${LISP} --eval '(ql:quickload :clingon.demo)' \ 10 | --eval '(asdf:make :clingon.demo)' \ 11 | --eval '(quit)' 12 | 13 | demo-doc: demo 14 | ./bin/clingon-demo print-doc > docs/clingon-demo.md 15 | 16 | test: 17 | ./scripts/run-tests.sh 18 | 19 | .PHONY: intro demo demo-doc test 20 | -------------------------------------------------------------------------------- /scripts/run-tests.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | set -e 4 | 5 | LISP=${LISP:-sbcl} 6 | 7 | _no_debug_flag="" 8 | case "${LISP}" in 9 | sbcl) 10 | _no_debug_flag="--non-interactive" 11 | ;; 12 | ecl) 13 | _no_debug_flag="--nodebug" 14 | ;; 15 | esac 16 | 17 | ${LISP} ${_no_debug_flag} \ 18 | --eval '(ql:quickload :clingon.test)' \ 19 | --eval '(setf rove:*enable-colors* nil)' \ 20 | --eval '(asdf:test-system :clingon.test)' \ 21 | --eval '(uiop:quit (length (rove/core/stats:all-failed-assertions rove/core/stats:*stats*)))' 22 | -------------------------------------------------------------------------------- /Dockerfile.demo: -------------------------------------------------------------------------------- 1 | FROM clfoundation/sbcl:2.1.7 as builder 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | 5 | WORKDIR /root/quicklisp/local-projects/clingon 6 | COPY . . 7 | RUN /usr/local/bin/install-quicklisp && \ 8 | sbcl \ 9 | --eval '(ql:quickload :clingon.demo)' \ 10 | --eval '(asdf:make :clingon.demo)' \ 11 | --eval '(quit)' 12 | 13 | FROM debian:bullseye-slim 14 | WORKDIR /app 15 | RUN apt-get update && apt-get install -y bash-completion 16 | COPY --from=builder /root/quicklisp/local-projects/clingon/clingon-demo . 17 | COPY --from=builder /root/quicklisp/local-projects/clingon/extras/completions.bash . 18 | ENTRYPOINT ["./clingon-demo"] 19 | -------------------------------------------------------------------------------- /Dockerfile.intro: -------------------------------------------------------------------------------- 1 | FROM clfoundation/sbcl:2.1.7 as builder 2 | 3 | ENV QUICKLISP_ADD_TO_INIT_FILE=true 4 | 5 | WORKDIR /root/quicklisp/local-projects/clingon 6 | COPY . . 7 | RUN /usr/local/bin/install-quicklisp && \ 8 | sbcl \ 9 | --eval '(ql:quickload :clingon.intro)' \ 10 | --eval '(asdf:make :clingon.intro)' \ 11 | --eval '(quit)' 12 | 13 | FROM debian:bullseye-slim 14 | WORKDIR /app 15 | RUN apt-get update && apt-get install -y bash-completion 16 | COPY --from=builder /root/quicklisp/local-projects/clingon/clingon-intro . 17 | COPY --from=builder /root/quicklisp/local-projects/clingon/extras/completions.bash . 18 | ENTRYPOINT ["./clingon-intro"] 19 | -------------------------------------------------------------------------------- /scripts/run-ci-tests.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | # 3 | # Runs the CI tests 4 | # 5 | 6 | set -e 7 | 8 | SCRIPTS_DIR=$( dirname `readlink -f -- "${0}"` ) 9 | SYSTEMS_DIR=$( dirname "${SCRIPTS_DIR}" ) 10 | ASDF_SOURCE_REGISTRY=~/.config/common-lisp/source-registry.conf.d 11 | 12 | if [ -z "${CI_SYSTEM}" ]; then 13 | echo "Script does not seem to be invoked from a CI system, exiting." 14 | exit 1 15 | fi 16 | 17 | # Install Quicklisp 18 | /usr/local/bin/install-quicklisp 19 | 20 | # Configure ASDF, so that it finds our systems 21 | mkdir -p "${ASDF_SOURCE_REGISTRY}" 22 | echo "(:tree \"${SYSTEMS_DIR}\")" > "${ASDF_SOURCE_REGISTRY}/workspace.conf" 23 | 24 | ${SCRIPTS_DIR}/run-tests.sh 25 | -------------------------------------------------------------------------------- /extras/completions.bash: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | # 3 | # Enable the bash completions by simply sourcing this file 4 | # and configuring APP to your app's name, e.g. 5 | # 6 | # $ APP=my-app source /path/to/clingon/extras/completions.bash 7 | # 8 | 9 | APP=${APP:-$(basename ${BASH_SOURCE})} 10 | 11 | function _clingon_app_completions() { 12 | local cur prev words cword 13 | _init_completion -s || return 14 | 15 | local _suggestions=$( "${words[@]:0:${cword}}" --bash-completions ) 16 | local _options=$( grep -E '^-' <<<${_suggestions} ) 17 | local _sub_commands=$( grep -v -E '^-' <<<${_suggestions} ) 18 | 19 | if [[ "${cur}" == "-"* ]]; then 20 | # Options only 21 | COMPREPLY=( $(compgen -W "${_options}" -- "${cur}") ) 22 | else 23 | # Sub-commands only 24 | COMPREPLY=( $(compgen -W "${_sub_commands}" -- "${cur}") ) 25 | fi 26 | } 27 | 28 | complete -o bashdefault \ 29 | -o default \ 30 | -o nospace \ 31 | -F _clingon_app_completions ${APP} 32 | unset APP 33 | -------------------------------------------------------------------------------- /.github/workflows/run-tests.yaml: -------------------------------------------------------------------------------- 1 | # .github/workflows/run-tests.yaml 2 | name: test 3 | on: [ push, pull_request ] 4 | jobs: 5 | run-tests: 6 | strategy: 7 | fail-fast: false 8 | matrix: 9 | implementation: 10 | - sbcl 11 | - ecl 12 | - ccl 13 | include: 14 | - implementation: sbcl 15 | image: clfoundation/sbcl:2.2.4 16 | command: sbcl 17 | - implementation: ecl 18 | image: clfoundation/ecl:21.2.1 19 | command: ecl 20 | - implementation: ccl 21 | image: clfoundation/ccl:1.12 22 | command: ccl 23 | runs-on: ubuntu-latest 24 | container: 25 | image: ${{ matrix.image }} 26 | env: 27 | CI_SYSTEM: github 28 | QUICKLISP_ADD_TO_INIT_FILE: true 29 | QUICKLISP_DIST_VERSION: latest 30 | steps: 31 | - name: Checkout repository 32 | uses: actions/checkout@v3 33 | - name: Run tests 34 | run: | 35 | env LISP=${{ matrix.command }} ./scripts/run-ci-tests.sh 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021-2023 Marin Atanasov Nikolov 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer 10 | in this position and unchanged. 11 | 2. Redistributions in binary form must reproduce the above copyright 12 | notice, this list of conditions and the following disclaimer in the 13 | documentation and/or other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /tests/test-package.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon.test 28 | (:use :cl :rove) 29 | (:import-from 30 | :clingon)) 31 | (in-package :clingon.test) 32 | -------------------------------------------------------------------------------- /examples/demo/package.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon.demo 28 | (:use :cl) 29 | (:import-from :clingon) 30 | (:export 31 | :main 32 | :buildapp-main)) 33 | (in-package :clingon.demo) 34 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon 28 | (:use :cl)) 29 | (in-package :clingon) 30 | 31 | (cl-reexport:reexport-from :clingon.utils) 32 | (cl-reexport:reexport-from :clingon.conditions) 33 | (cl-reexport:reexport-from :clingon.options) 34 | (cl-reexport:reexport-from :clingon.command) 35 | -------------------------------------------------------------------------------- /examples/demo/print-doc.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun print-doc/command () 29 | "Returns a command which will print the app's documentation" 30 | (clingon:make-command 31 | :name "print-doc" 32 | :description "print the documentation" 33 | :usage "" 34 | :handler (lambda (cmd) 35 | ;; Print the documentation starting from the parent 36 | ;; command, so we can traverse all sub-commands in the 37 | ;; tree. 38 | (clingon:print-documentation :markdown (clingon:command-parent cmd) t)))) 39 | -------------------------------------------------------------------------------- /examples/demo/echo.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun echo/handler (cmd) 29 | "Handler for the `echo' command" 30 | (dolist (arg (clingon:command-arguments cmd)) 31 | (format t "~A~&" arg))) 32 | 33 | (defun echo/command () 34 | "Creates a new command which echoes every argument we are given" 35 | (clingon:make-command 36 | :name "echo" 37 | :usage "[ARGUMENT ...]" 38 | :description "echoes back each argument on a newline" 39 | :handler #'echo/handler 40 | :examples '(("Echo back each argument on a new line:" . "clingon-demo echo foo bar baz")))) 41 | -------------------------------------------------------------------------------- /examples/demo/zsh-completion.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun zsh-completion/command () 29 | "Returns a command for generating Zsh completion script" 30 | (clingon:make-command 31 | :name "zsh-completion" 32 | :description "generate the Zsh completion script" 33 | :usage "" 34 | :handler (lambda (cmd) 35 | ;; Use the parent command when generating the completions, 36 | ;; so that we can traverse all sub-commands in the tree. 37 | (let ((parent (clingon:command-parent cmd))) 38 | (clingon:print-documentation :zsh-completions parent t))))) 39 | -------------------------------------------------------------------------------- /clingon.intro.asd: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (defpackage :clingon-intro-system 27 | (:use :cl :asdf)) 28 | (in-package :clingon-intro-system) 29 | 30 | (defsystem "clingon.intro" 31 | :name "clingon.intro" 32 | :long-name "clingon.intro" 33 | :description "An introduction to the clingon system" 34 | :version "0.4.0" 35 | :author "John Doe " 36 | :license "BSD 2-Clause" 37 | :depends-on (:clingon) 38 | :components ((:module "intro" 39 | :pathname #P"examples/intro/" 40 | :components ((:file "intro")))) 41 | :build-operation "program-op" 42 | :build-pathname "bin/clingon-intro" 43 | :entry-point "clingon.intro:main") 44 | -------------------------------------------------------------------------------- /examples/intro/intro.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage :clingon.intro 3 | (:use :cl) 4 | (:import-from :clingon) 5 | (:export :main)) 6 | (in-package :clingon.intro) 7 | 8 | (defun shout/handler (cmd) 9 | "The handler for the `shout' command" 10 | (let ((args (mapcar #'string-upcase (clingon:command-arguments cmd))) 11 | (user (clingon:getopt cmd :user))) ;; <- a global option 12 | (format t "HEY, ~A!~%" user) 13 | (format t "~A!~%" (clingon:join-list args #\Space)))) 14 | 15 | (defun shout/command () 16 | "Returns a command which SHOUTS back anything we write on the command-line" 17 | (clingon:make-command 18 | :name "shout" 19 | :description "shouts back anything you write" 20 | :usage "[options] [arguments ...]" 21 | :handler #'shout/handler)) 22 | 23 | (defun top-level/options () 24 | "Creates and returns the options for the top-level command" 25 | (list 26 | (clingon:make-option 27 | :counter 28 | :description "verbosity level" 29 | :short-name #\v 30 | :long-name "verbose" 31 | :key :verbose) 32 | (clingon:make-option 33 | :string 34 | :description "user to greet" 35 | :short-name #\u 36 | :long-name "user" 37 | :initial-value "stranger" 38 | :env-vars '("USER") 39 | :key :user))) 40 | 41 | (defun top-level/handler (cmd) 42 | "The top-level handler" 43 | (let ((args (clingon:command-arguments cmd)) 44 | (user (clingon:getopt cmd :user)) 45 | (verbose (clingon:getopt cmd :verbose))) 46 | (format t "Hello, ~A!~%" user) 47 | (format t "The current verbosity level is set to ~A~%" verbose) 48 | (format t "You have provided ~A arguments~%" (length args)) 49 | (format t "Bye.~%"))) 50 | 51 | (defun top-level/command () 52 | "Creates and returns the top-level command" 53 | (clingon:make-command 54 | :name "clingon-intro" 55 | :description "my first clingon cli app" 56 | :version "0.1.0" 57 | :license "BSD 2-Clause" 58 | :authors '("John Doe ") 59 | :usage "[-v] [-u ]" 60 | :options (top-level/options) 61 | :handler #'top-level/handler 62 | :sub-commands (list (shout/command)))) 63 | 64 | (defun main () 65 | (let ((app (top-level/command))) 66 | (clingon:run app))) 67 | -------------------------------------------------------------------------------- /examples/demo/greet.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun greet/options () 29 | "Returns the options for the `greet' command" 30 | (list 31 | (clingon:make-option :string 32 | :description "Person to greet" 33 | :short-name #\u 34 | :long-name "user" 35 | :initial-value "stranger" 36 | :env-vars '("USER") 37 | :key :user))) 38 | 39 | (defun greet/handler (cmd) 40 | "Handler for the `greet' command" 41 | (let ((who (clingon:getopt cmd :user))) 42 | (format t "Hello, ~A!~%" who))) 43 | 44 | (defun greet/command () 45 | "Creates a new command which greets people" 46 | (clingon:make-command 47 | :name "greet" 48 | :aliases '("hi" "hey") 49 | :description "greets people" 50 | :version "0.1.0" 51 | :options (greet/options) 52 | :handler #'greet/handler 53 | :examples '(("Greet someone:" . "clingon-demo greet --user Lisper")))) 54 | -------------------------------------------------------------------------------- /examples/demo/engine.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun engine/options () 29 | "Returns the options for the `engine' command" 30 | (list 31 | (clingon:make-option :switch 32 | :description "state of our engine" 33 | :short-name #\s 34 | :long-name "state" 35 | :required t 36 | :key :engine-state))) 37 | 38 | (defun engine/handler (cmd) 39 | "Handler for the `engine' command" 40 | (let ((state (clingon:getopt cmd :engine-state))) 41 | (if state 42 | (format t "Starting engine.~%") 43 | (format t "Stopping engine.~%")))) 44 | 45 | (defun engine/command () 46 | "Creates a new command to switch the state of our engine" 47 | (clingon:make-command 48 | :name "engine" 49 | :usage "-s " 50 | :description "start or stop an imaginary engine" 51 | :options (engine/options) 52 | :handler #'engine/handler 53 | :examples '(("Start engine:" . "clingon-demo engine --state=on") 54 | ("Stop engine:" . "clingon-demo engine --state=off")))) 55 | -------------------------------------------------------------------------------- /examples/demo/sleep.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun sleep/options () 29 | "Returns the options for the `sleep' command" 30 | (list 31 | (clingon:make-option 32 | :integer 33 | :short-name #\s 34 | :long-name "seconds" 35 | :description "number of seconds to sleep" 36 | :initial-value 60 37 | :key :seconds))) 38 | 39 | (defun sleep/handler (cmd) 40 | "Handler for the `sleep' command" 41 | (let ((seconds (clingon:getopt cmd :seconds))) 42 | (format t "Sleeping for ~d seconds. Press CTRL-C to interrupt.~%" seconds) 43 | (sleep (clingon:getopt cmd :seconds)))) 44 | 45 | (defun sleep/command () 46 | "Creates a new command which sleeps for a given period of time" 47 | (clingon:make-command 48 | :name "sleep" 49 | :description "sleeps for the given period of time" 50 | :options (sleep/options) 51 | :handler #'sleep/handler 52 | :examples '(("Sleep for 60 seconds. Send SIGINT via CTRL-C to catch the signal" . "clingon-demo sleep --seconds 60")))) 53 | -------------------------------------------------------------------------------- /clingon.test.asd: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (defpackage :clingon-test-system 27 | (:use :cl :asdf)) 28 | (in-package :clingon-test-system) 29 | 30 | (defsystem "clingon.test" 31 | :name "clingon.test" 32 | :long-name "clingon.test" 33 | :description "Test suite for the :clingon system" 34 | :version "0.4.0" 35 | :author "Marin Atanasov Nikolov " 36 | :maintainer "Marin Atanasov Nikolov " 37 | :license "BSD 2-Clause" 38 | :homepage "https://github.com/dnaeon/clingon" 39 | :bug-tracker "https://github.com/dnaeon/clingon" 40 | :source-control "https://github.com/dnaeon/clingon" 41 | :depends-on (:clingon 42 | :rove) 43 | :components ((:module "tests" 44 | :pathname #P"tests/" 45 | :serial t 46 | :components ((:file "test-package") 47 | (:file "test-utils") 48 | (:file "test-options") 49 | (:file "test-command")))) 50 | :perform (test-op (op c) (uiop:symbol-call :rove :run-suite :clingon.test))) 51 | -------------------------------------------------------------------------------- /examples/demo/math.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun math/options () 29 | "Returns the options for the `math' command" 30 | (list 31 | (clingon:make-option :enum 32 | :description "operation to perform" 33 | :short-name #\o 34 | :long-name "operation" 35 | :required t 36 | :items `(("add" . ,#'+) 37 | ("sub" . ,#'-) 38 | ("mul" . ,#'*) 39 | ("div" . ,#'/)) 40 | :key :math/operation) 41 | (clingon:make-option :list/integer 42 | :description "integers to work on" 43 | :short-name #\i 44 | :long-name "int" 45 | :required t 46 | :key :math/integers))) 47 | 48 | (defun math/handler (cmd) 49 | "Handler for the `math' command" 50 | (let ((operation (clingon:getopt cmd :math/operation)) 51 | (integers (clingon:getopt cmd :math/integers))) 52 | (format t "The result is ~A~%" (apply operation integers)))) 53 | 54 | (defun math/command () 55 | "Creates a new command to do some basic math" 56 | (clingon:make-command 57 | :name "math" 58 | :usage "-o -i ..." 59 | :description "perform basic math on integers" 60 | :options (math/options) 61 | :handler #'math/handler 62 | :examples '(("Sum some numbers:" . "clingon-demo math -o add -i 1 -i 42 -i 84") 63 | ("Multiply some numbers:" . "clingon-demo math -o mul -i 2 -i 3 -i 4")))) 64 | -------------------------------------------------------------------------------- /clingon.demo.asd: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (defpackage :clingon-demo-system 27 | (:use :cl :asdf)) 28 | (in-package :clingon-demo-system) 29 | 30 | (defsystem "clingon.demo" 31 | :name "clingon.demo" 32 | :long-name "clingon.demo" 33 | :description "Example demo of the Common Lisp clingon system" 34 | :version "0.4.0" 35 | :author "Marin Atanasov Nikolov " 36 | :maintainer "Marin Atanasov Nikolov " 37 | :license "BSD 2-Clause" 38 | :homepage "https://github.com/dnaeon/clingon" 39 | :bug-tracker "https://github.com/dnaeon/clingon" 40 | :source-control "https://github.com/dnaeon/clingon" 41 | :depends-on (:clingon) 42 | :components ((:module "demo" 43 | :serial t 44 | :pathname #P"examples/demo/" 45 | :components ((:file "package") 46 | (:file "greet") 47 | (:file "logging") 48 | (:file "math") 49 | (:file "echo") 50 | (:file "engine") 51 | (:file "print-doc") 52 | (:file "sleep") 53 | (:file "zsh-completion") 54 | (:file "main")))) 55 | :build-operation "program-op" 56 | :build-pathname "bin/clingon-demo" 57 | :entry-point "clingon.demo:main") 58 | -------------------------------------------------------------------------------- /clingon.asd: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (defpackage :clingon-system 27 | (:use :cl :asdf)) 28 | (in-package :clingon-system) 29 | 30 | (defsystem "clingon" 31 | :name "clingon" 32 | :long-name "clingon" 33 | :description "Command-line options parser system for Common Lisp" 34 | :version "0.5.0" 35 | :author "Marin Atanasov Nikolov " 36 | :maintainer "Marin Atanasov Nikolov " 37 | :license "BSD 2-Clause" 38 | :long-description #.(uiop:read-file-string 39 | (uiop:subpathname *load-pathname* "README.org")) 40 | :homepage "https://github.com/dnaeon/clingon" 41 | :bug-tracker "https://github.com/dnaeon/clingon" 42 | :source-control "https://github.com/dnaeon/clingon" 43 | :depends-on (:uiop 44 | :bobbin 45 | :cl-reexport 46 | :split-sequence 47 | :with-user-abort) 48 | :components ((:module "utils" 49 | :pathname #P"src/" 50 | :components ((:file "utils"))) 51 | (:module "core" 52 | :pathname #P"src/" 53 | :components ((:file "conditions") 54 | (:file "options") 55 | (:file "command" :depends-on ("conditions" "options"))) 56 | :depends-on ("utils")) 57 | (:module "client-package" 58 | :pathname #P"src/" 59 | :components ((:file "package")) 60 | :depends-on ("core"))) 61 | :in-order-to ((test-op (test-op "clingon.test")))) 62 | -------------------------------------------------------------------------------- /CHANGELOG.org: -------------------------------------------------------------------------------- 1 | * 2023-05-19 2 | 3 | Version =0.5.0= has been tagged. 4 | 5 | New conditions added: 6 | 7 | - =CLINGON:BASE-ERROR= 8 | - =CLINGON:EXIT-ERROR= (sub-class of =CLINGON:BASE-ERROR=) 9 | 10 | New generic functions added: 11 | 12 | - =CLINGON:HANDLE-ERROR= 13 | 14 | The =CLINGON:BASE-ERROR= condition can be used as the base for new 15 | user-defined conditions, which can be signalled by command handlers. 16 | 17 | Whenever a =CLINGON:BASE-ERROR= condition is signalled, the 18 | =CLINGON:RUN= method will invoke =CLINGON:HANDLE-ERROR=, which allows 19 | developers to provide custom logic for reporting and handling of app 20 | specific errors. 21 | 22 | Make sure to check the =Custom Errors= section from the documentation 23 | for some examples on how to create user-defined conditions. 24 | 25 | The utility function =CLINGON:EXIT= will not exit if the REPL is 26 | connected via SLY or SLIME, which allows for better interactive 27 | testing of the final application. 28 | 29 | * 2023-01-24 30 | 31 | =clingon= version =0.4.0= has been tagged. 32 | 33 | - Added Github Actions to automatically test the =clingon= system. 34 | - Exported =CLINGON:PARSE-INTEGER-OR-LOSE= 35 | - Export symbols to control the default list of options for newly 36 | created commands. See [[https://github.com/dnaeon/clingon/issues/4][issue #4]] 37 | - =CLINGON:FIND-OPTION= can now search for options by their keys 38 | - =CLINGON:GETOPT= returns three values -- the option value, a boolean 39 | indicating whether the option was set, and the command which 40 | provided the option. 41 | - If =--version= is specified for any command, then =clingon= will try 42 | to find a parent command with an associated version string, if the 43 | sub-command does not provide it's own version string. 44 | - Added =CLINGON:GETOPT*= which will return the first value from the 45 | command's lineage, for which the option was defined and set. 46 | - Added =CLINGON:IS-OPT-SET-P*= predicate 47 | - Additional tests related to =CLINGON:GETOPT= and =CLINGON:GETOPT*= 48 | - Added support for /persistent/ options. A /persistent/ option is an 49 | option which is propagated from parent to all sub-commands. Please 50 | refer to the documentation for more details and examples. 51 | - =CLINGON:PRINT-DOCUMENTATION= can generate the tree representation 52 | for commands in [[https://en.wikipedia.org/wiki/DOT_(graph_description_language)][Dot]] format. 53 | 54 | This is how the generated tree for the =clingon-demo= app looks like. 55 | 56 | [[./images/clingon-demo-tree.png]] 57 | 58 | * 2022-03-25 59 | 60 | Added support for =pre-hook= and =post-hook= actions for commands. 61 | 62 | The =CLIGON:COMMAND= class now accepts the =:pre-hook= and 63 | =:post-hook= initargs, which allows specifying a function to be 64 | invoked before and after the respective handler of the command is 65 | executed. 66 | 67 | The generic function =CLINGON:APPLY-HOOKS= have been added, which 68 | takes care of applying the =pre-hook= and =post-hook= hooks. 69 | 70 | Version of =clingon= system has been bumped to 0.3.5. 71 | 72 | * 2022-03-24 73 | 74 | Add support for grouping related options into categories. 75 | 76 | The =:category= initarg for =CLINGON:OPTION= is used for specifying 77 | the option's category. 78 | 79 | New option kind has been added - =:list/filepath=. 80 | 81 | The =clingon-demo= and =clingon-intro= binaries are now installed into 82 | the =bin/= directory. 83 | 84 | Additional utility functions have been implemented as part of the 85 | =CLINGON.UTILS= package. 86 | 87 | =clingon= system updated to version 0.3.3. 88 | 89 | * 2021-12-26 90 | 91 | =clingon= system updated to version v0.3.1. 92 | 93 | Added support for =FILEPATH= option kinds. 94 | 95 | * 2021-11-19 96 | 97 | Added support for Zsh completions. 98 | 99 | =clingon= system version bumped to v0.3.0. 100 | 101 | * 2021-07-26 102 | 103 | Initial release of =clingon= version v0.1.0. 104 | -------------------------------------------------------------------------------- /examples/demo/logging.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun logging/enable/command () 29 | "Returns the `logging enable' command" 30 | (clingon:make-command :name "enable" 31 | :description "enables logging" 32 | :handler (lambda (cmd) 33 | (declare (ignore cmd)) 34 | (format t "Enabling logging~&")))) 35 | 36 | (defun logging/disable/command () 37 | "Returns the `logging disable' command" 38 | (clingon:make-command :name "disable" 39 | :description "disables logging" 40 | :handler (lambda (cmd) 41 | (declare (ignore cmd)) 42 | (format t "Disabling logging~&")))) 43 | 44 | (defun logging/options () 45 | "Returns the options for the `logging' command" 46 | (list 47 | (clingon:make-option :enum 48 | :description "level to configure" 49 | :short-name #\l 50 | :long-name "level" 51 | :parameter "LEVEL" 52 | :env-vars '("LOG_LEVEL") 53 | :items '(("info" . :info) 54 | ("warn" . :warn) 55 | ("error" . :error) 56 | ("debug" . :debug)) 57 | :initial-value "info" 58 | :key :log-level))) 59 | 60 | (defun logging/handler (cmd) 61 | "Handler for the `logging' command" 62 | (let ((verbose (clingon:getopt cmd :verbose)) ;; <- global option 63 | (level (clingon:getopt cmd :log-level))) 64 | (format t "Global verbose option is set to ~A~&" verbose) 65 | (format t "Configuring log level to ~A~&" level))) 66 | 67 | (defun logging/sub-commands () 68 | "Returns the sub-commands for the `logging' command" 69 | (list 70 | (logging/enable/command) 71 | (logging/disable/command))) 72 | 73 | (defun logging/command () 74 | "Creates a new command to configure logging" 75 | (clingon:make-command 76 | :name "logging" 77 | :aliases '("log") 78 | :description "configure the logging system" 79 | :options (logging/options) 80 | :sub-commands (logging/sub-commands) 81 | :handler #'logging/handler 82 | :examples '(("Configure logging level:" . "clingon-demo -vvv logging --level=debug") 83 | ("Enable logging:" . "clingon-demo logging enable") 84 | ("Disable logging:" . "clingon-demo logging disable")))) 85 | -------------------------------------------------------------------------------- /tests/test-utils.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.test) 27 | 28 | (defun get-neighbors (graph) 29 | "Returns a function which discovers the adjacent nodes in the given graph. 30 | The function is meant to be used with the sample graphs from the 31 | this test package." 32 | (lambda (name) 33 | (let ((node (find name graph :key (lambda (x) (getf x :node))))) 34 | (getf node :neighbors)))) 35 | 36 | (deftest graph-walk 37 | (testing "Simple graph" 38 | (let* ((g '((:node :A :neighbors (:B :C)) 39 | (:node :B :neighbors (:D :A)) 40 | (:node :C :neighbors (:D :A)) 41 | (:node :D :neighbors (:B :C)))) 42 | (dfs-from-a (clingon.utils:walk :A (get-neighbors g) :order :dfs)) 43 | (want-dfs-from-a '(:A :B :D :C)) 44 | (dfs-from-c (clingon.utils:walk :C (get-neighbors g) :order :dfs)) 45 | (want-dfs-from-c '(:C :D :B :A)) 46 | (dfs-from-d (clingon.utils:walk :D (get-neighbors g) :order :dfs)) 47 | (want-dfs-from-d '(:D :B :A :C)) 48 | (bfs-from-a (clingon.utils:walk :A (get-neighbors g) :order :bfs)) 49 | (want-bfs-from-a '(:A :B :C :D))) 50 | (ok (equal want-dfs-from-a dfs-from-a) "DFS walk from :A root") 51 | (ok (equal want-dfs-from-c dfs-from-c) "DFS walk from :C root") 52 | (ok (equal want-dfs-from-d dfs-from-d) "DFS walk from :D root") 53 | (ok (equal want-bfs-from-a bfs-from-a) "BFS walk from :A root"))) 54 | 55 | (testing "Tremaux tree" 56 | (let* ((g '((:node :A :neighbors (:B :C :E)) 57 | (:node :B :neighbors (:D :F :A)) 58 | (:node :C :neighbors (:G :A)) 59 | (:node :D :neighbors (:B)) 60 | (:node :E :neighbors (:F :A)) 61 | (:node :F :neighbors (:B :E)) 62 | (:node :G :neighbors (:C)))) 63 | (dfs-from-a (clingon.utils:walk :A (get-neighbors g) :order :dfs)) 64 | (want-dfs-from-a '(:A :B :D :F :E :C :G)) 65 | (bfs-from-a (clingon.utils:walk :A (get-neighbors g) :order :bfs)) 66 | (want-bfs-from-a '(:A :B :C :E :D :F :G))) 67 | (ok (equal want-dfs-from-a dfs-from-a) "DFS walk from :A root") 68 | (ok (equal want-bfs-from-a bfs-from-a) "BFS walk from :A root")))) 69 | 70 | (deftest join-list 71 | (testing "non-empty list" 72 | (ok (string= "foo,bar,baz" (clingon:join-list '("foo" "bar" "baz") ",")) 73 | "joined string matches") 74 | (ok (string= "127.0.0.1" (clingon:join-list '(127 0 0 1) ".")) 75 | "joined string matches")) 76 | (testing "empty list" 77 | (ok (string= "" (clingon:join-list nil ".")) 78 | "joined string matches"))) 79 | -------------------------------------------------------------------------------- /examples/demo/main.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.demo) 27 | 28 | (defun dot/command () 29 | "Returns the command for the `dot' command" 30 | (clingon:make-command 31 | :name "dot" 32 | :description "generate tree representation in Dot format" 33 | :usage "" 34 | :handler (lambda (cmd) 35 | (let ((parent (clingon:command-parent cmd))) 36 | (clingon:print-documentation :dot parent t))))) 37 | 38 | (defun top-level/options () 39 | "Returns the options for the top-level command" 40 | (list 41 | (clingon:make-option :string 42 | :long-name "persistent-opt" 43 | :description "example persistent option" 44 | :persistent t 45 | :key :persistent-opt) 46 | (clingon:make-option :counter 47 | :description "how noisy we want to be" 48 | :short-name #\v 49 | :long-name "verbose" 50 | :key :verbose))) 51 | 52 | (defun top-level/sub-commands () 53 | "Returns the list of sub-commands for the top-level command" 54 | (list 55 | (greet/command) 56 | (logging/command) 57 | (math/command) 58 | (echo/command) 59 | (engine/command) 60 | (print-doc/command) 61 | (sleep/command) 62 | (zsh-completion/command) 63 | (dot/command))) 64 | 65 | (defun top-level/handler (cmd) 66 | "The handler for the top-level command. Will print the usage of the app" 67 | (clingon:print-usage-and-exit cmd t)) 68 | 69 | (defun top-level/command () 70 | "Returns the top-level command" 71 | (clingon:make-command :name "clingon-demo" 72 | :version "0.1.0" 73 | :description "The clingon demo app" 74 | :long-description (format nil "A demo CLI application ~ 75 | showing some of the features of the ~ 76 | Common Lisp system for parsing ~ 77 | command-line arguments -- clingon.") 78 | :authors '("Marin Atanasov Nikolov ") 79 | :license "BSD 2-Clause" 80 | :handler #'top-level/handler 81 | :options (top-level/options) 82 | :sub-commands (top-level/sub-commands))) 83 | 84 | (defun main () 85 | "The main entrypoint of our demo app" 86 | (let ((app (top-level/command))) 87 | (clingon:run app))) 88 | 89 | (defun buildapp-main (argv) 90 | "The main entrypoint for buildapp" 91 | (let ((app (top-level/command))) 92 | (clingon:run app (rest argv)))) 93 | -------------------------------------------------------------------------------- /src/utils.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon.utils 28 | (:use :cl) 29 | (:export 30 | :walk 31 | :join-list 32 | :exit 33 | :git-rev-parse 34 | :group-by 35 | :hashtable-keys 36 | :hashtable-values)) 37 | (in-package :clingon.utils) 38 | 39 | (defun walk (root neighbors-func &key (order :dfs)) 40 | "Walks a tree structure starting from ROOT. Neighbors of each node are 41 | discovered by invoking the NEIGHBORS-FUNC function, which should accept a 42 | single argument -- the node we are currently visiting, and should 43 | return a list of adjacent nodes. 44 | 45 | The ORDER should be either :dfs or :bfs for Depth-First Search or 46 | Breadth-First Search respectively." 47 | (let ((to-visit (list root)) 48 | (visited nil)) 49 | (loop :while to-visit 50 | :for node = (pop to-visit) 51 | :for neighbors = (funcall neighbors-func node) 52 | :for not-seen = (remove-if (lambda (x) 53 | (member x visited :test #'equal)) 54 | neighbors) 55 | :do 56 | (ecase order 57 | (:bfs (setf to-visit (nconc to-visit not-seen))) 58 | (:dfs (setf to-visit (nconc not-seen to-visit)))) 59 | (unless (member node visited :test #'equal) 60 | (push node visited))) 61 | (nreverse visited))) 62 | 63 | (defun argv () 64 | "Returns the list of command-line arguments" 65 | #+ecl 66 | (rest (uiop:raw-command-line-arguments)) 67 | #-ecl 68 | (uiop:command-line-arguments)) 69 | 70 | (defun join-list (list separator) 71 | "Returns a string representing the items in the given LIST with SEPARATOR between each item" 72 | (with-output-to-string (s) 73 | (loop :for (item . remaining) :on list :while item :do 74 | (if remaining 75 | (format s "~A~A" item separator) 76 | (format s "~A" item))))) 77 | 78 | (defun exit (&optional (code 0)) 79 | "Exit the program returning the given exit code to the operating system" 80 | ;; Do not exit if we are running from SLY or SLIME 81 | (unless (some (lambda (feat) 82 | (member feat *features*)) 83 | (list :slynk :swank)) 84 | (uiop:quit code))) 85 | 86 | (defun git-rev-parse (&key short (rev "HEAD") (path ".")) 87 | "Returns the git revision with the given REV" 88 | (let ((args (if short 89 | (list "git" "-C" path "rev-parse" "--short" rev) 90 | (list "git" "-C" path "rev-parse" rev)))) 91 | (uiop:run-program args :output '(:string :stripped t)))) 92 | 93 | (defun group-by (sequence predicate) 94 | "Groups the items from SEQUENCE based on the result from PREDICATE" 95 | (reduce (lambda (acc item) 96 | (let* ((key (funcall predicate item)) 97 | (group (gethash key acc nil))) 98 | (setf (gethash key acc) (cons item group)) 99 | acc)) 100 | sequence 101 | :initial-value (make-hash-table :test #'equal))) 102 | 103 | (defun hashtable-keys (htable) 104 | "Returns the keys from the given hashtable" 105 | (let ((result nil)) 106 | (maphash (lambda (k v) 107 | (declare (ignore v)) 108 | (push k result)) 109 | htable) 110 | result)) 111 | 112 | (defun hashtable-values (htable) 113 | "Returns the values from the given hashtable" 114 | (let ((result nil)) 115 | (maphash (lambda (k v) 116 | (declare (ignore k)) 117 | (push v result)) 118 | htable) 119 | result)) 120 | -------------------------------------------------------------------------------- /extras/_clingon-demo: -------------------------------------------------------------------------------- 1 | #compdef _clingon-demo clingon-demo 2 | # 3 | # Install this file to ~/.zsh-completions and edit your ~/.zshrc file 4 | # in order to include the following lines. 5 | # 6 | # fpath=(~/.zsh-completions $fpath) 7 | # 8 | # autoload -U compinit 9 | # compinit 10 | 11 | _clingon-demo_zsh-completion() { 12 | local -a curr_cmd_options=( 13 | --version'[display version and exit]' 14 | --help'[display usage information and exit]' 15 | ) 16 | 17 | _arguments -C -S -s \ 18 | $curr_cmd_options 19 | } 20 | 21 | _clingon-demo_sleep() { 22 | local -a curr_cmd_options=( 23 | --version'[display version and exit]' 24 | --help'[display usage information and exit]' 25 | {-s,--seconds}'[number of seconds to sleep]':INT 26 | ) 27 | 28 | _arguments -C -S -s \ 29 | $curr_cmd_options 30 | } 31 | 32 | _clingon-demo_print-doc() { 33 | local -a curr_cmd_options=( 34 | --version'[display version and exit]' 35 | --help'[display usage information and exit]' 36 | ) 37 | 38 | _arguments -C -S -s \ 39 | $curr_cmd_options 40 | } 41 | 42 | _clingon-demo_engine() { 43 | local -a curr_cmd_options=( 44 | --version'[display version and exit]' 45 | --help'[display usage information and exit]' 46 | {-s,--state}'[state of our engine]':STATE:'(on yes true enable 1 off no false disable 0)' 47 | ) 48 | 49 | _arguments -C -S -s \ 50 | $curr_cmd_options 51 | } 52 | 53 | _clingon-demo_echo() { 54 | local -a curr_cmd_options=( 55 | --version'[display version and exit]' 56 | --help'[display usage information and exit]' 57 | ) 58 | 59 | _arguments -C -S -s \ 60 | $curr_cmd_options 61 | } 62 | 63 | _clingon-demo_math() { 64 | local -a curr_cmd_options=( 65 | --version'[display version and exit]' 66 | --help'[display usage information and exit]' 67 | {-o,--operation}'[operation to perform]':VARIANT:'(add sub mul div)' 68 | {-i,--int}'[integers to work on]':ITEM 69 | ) 70 | 71 | _arguments -C -S -s \ 72 | $curr_cmd_options 73 | } 74 | 75 | _clingon-demo_logging_disable() { 76 | local -a curr_cmd_options=( 77 | --version'[display version and exit]' 78 | --help'[display usage information and exit]' 79 | ) 80 | 81 | _arguments -C -S -s \ 82 | $curr_cmd_options 83 | } 84 | 85 | _clingon-demo_logging_enable() { 86 | local -a curr_cmd_options=( 87 | --version'[display version and exit]' 88 | --help'[display usage information and exit]' 89 | ) 90 | 91 | _arguments -C -S -s \ 92 | $curr_cmd_options 93 | } 94 | 95 | _clingon-demo_logging() { 96 | local line state 97 | local -a curr_cmd_options=( 98 | --version'[display version and exit]' 99 | --help'[display usage information and exit]' 100 | {-l,--level}'[level to configure]':LEVEL:'(info warn error debug)' 101 | ) 102 | 103 | _arguments -C -S -s \ 104 | $curr_cmd_options \ 105 | "1: :->cmds" \ 106 | "*::arg:->args" 107 | 108 | case "$state" in 109 | cmds) 110 | _values \ 111 | "clingon-demo logging command" \ 112 | "enable[enables logging]" \ 113 | "disable[disables logging]" 114 | ;; 115 | args) 116 | case $line[1] in 117 | enable) 118 | _clingon-demo_logging_enable 119 | ;; 120 | disable) 121 | _clingon-demo_logging_disable 122 | ;; 123 | esac 124 | ;; 125 | esac 126 | } 127 | 128 | _clingon-demo_greet() { 129 | local -a curr_cmd_options=( 130 | --version'[display version and exit]' 131 | --help'[display usage information and exit]' 132 | {-u,--user}'[Person to greet]':VALUE 133 | ) 134 | 135 | _arguments -C -S -s \ 136 | $curr_cmd_options 137 | } 138 | 139 | _clingon-demo() { 140 | local line state 141 | local -a curr_cmd_options=( 142 | --version'[display version and exit]' 143 | --help'[display usage information and exit]' 144 | {-v,--verbose}'[how noisy we want to be]' 145 | ) 146 | 147 | _arguments -C -S -s \ 148 | $curr_cmd_options \ 149 | "1: :->cmds" \ 150 | "*::arg:->args" 151 | 152 | case "$state" in 153 | cmds) 154 | _values \ 155 | "clingon-demo command" \ 156 | "greet[greets people]" \ 157 | "hi[alias for 'greet']" \ 158 | "hey[alias for 'greet']" \ 159 | "logging[configure the logging system]" \ 160 | "log[alias for 'logging']" \ 161 | "math[perform basic math on integers]" \ 162 | "echo[echoes back each argument on a newline]" \ 163 | "engine[start or stop an imaginary engine]" \ 164 | "print-doc[print the documentation]" \ 165 | "sleep[sleeps for the given period of time]" \ 166 | "zsh-completion[generate the Zsh completion script]" 167 | ;; 168 | args) 169 | case $line[1] in 170 | greet) 171 | _clingon-demo_greet 172 | ;; 173 | hi) 174 | _clingon-demo_greet 175 | ;; 176 | hey) 177 | _clingon-demo_greet 178 | ;; 179 | logging) 180 | _clingon-demo_logging 181 | ;; 182 | log) 183 | _clingon-demo_logging 184 | ;; 185 | math) 186 | _clingon-demo_math 187 | ;; 188 | echo) 189 | _clingon-demo_echo 190 | ;; 191 | engine) 192 | _clingon-demo_engine 193 | ;; 194 | print-doc) 195 | _clingon-demo_print-doc 196 | ;; 197 | sleep) 198 | _clingon-demo_sleep 199 | ;; 200 | zsh-completion) 201 | _clingon-demo_zsh-completion 202 | ;; 203 | esac 204 | ;; 205 | esac 206 | } 207 | 208 | -------------------------------------------------------------------------------- /src/conditions.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon.conditions 28 | (:use :cl) 29 | (:export 30 | :circular-dependency 31 | :circular-dependency-items 32 | :duplicate-options 33 | :duplicate-option-kind 34 | :duplicate-option-items 35 | :duplicate-option-name 36 | :duplicate-commands 37 | :duplicate-command-items 38 | :unknown-option 39 | :unknown-option-name 40 | :unknown-option-kind 41 | :unknown-option-p 42 | :missing-option-argument 43 | :missing-option-argument-item 44 | :missing-option-argument-command 45 | :missing-option-argument-p 46 | :invalid-option 47 | :invalid-option-item 48 | :invalid-option-reason 49 | :missing-required-option-value 50 | :missing-required-option-value-item 51 | :missing-required-option-value-command 52 | :option-derive-error 53 | :option-derive-error-reason 54 | :option-derive-error-p 55 | :base-error 56 | :exit-error 57 | :exit-error-code)) 58 | (in-package :clingon.conditions) 59 | 60 | (define-condition option-derive-error (simple-error) 61 | ((reason 62 | :initarg :reason 63 | :initform (error "Must specify reason") 64 | :reader option-derive-error-reason 65 | :documentation "Reason for which deriving a value failed")) 66 | (:report (lambda (condition stream) 67 | (format stream "~A" (option-derive-error-reason condition)))) 68 | (:documentation "A condition which is signalled when deriving an option's value has failed")) 69 | 70 | (defun option-derive-error-p (value) 71 | (typep value 'option-derive-error)) 72 | 73 | (define-condition missing-required-option-value (simple-error) 74 | ((item 75 | :initarg :item 76 | :initform (error "Must specify option item") 77 | :reader missing-required-option-value-item 78 | :documentation "The option item which requires a value") 79 | (command 80 | :initarg :command 81 | :initform (error "Must specify command") 82 | :reader missing-required-option-value-command 83 | :documentation "The command to which the option is associated")) 84 | (:report (lambda (condition stream) 85 | (declare (ignore condition)) 86 | (format stream "Required option not set"))) 87 | (:documentation "A condition which is signalled when a required option value was not set")) 88 | 89 | (define-condition circular-dependency (simple-error) 90 | ((items 91 | :initarg :items 92 | :initform (error "Must specify items") 93 | :reader circular-dependency-items)) 94 | (:report (lambda (condition stream) 95 | (declare (ignore condition)) 96 | (format stream "Circular dependency detected"))) 97 | (:documentation "A condition which is signalled when a circular dependency is detected")) 98 | 99 | (define-condition duplicate-options (simple-error) 100 | ((kind 101 | :initarg :kind 102 | :initform (error "Must specify option kind") 103 | :reader duplicate-option-kind) 104 | (items 105 | :initarg :items 106 | :initform (error "Must specify option items") 107 | :reader duplicate-option-items) 108 | (name 109 | :initarg :name 110 | :initform (error "Must specify option name") 111 | :reader duplicate-option-name)) 112 | (:report (lambda (condition stream) 113 | (format stream "Duplicate option ~A of kind ~A found" 114 | (duplicate-option-name condition) 115 | (duplicate-option-kind condition)))) 116 | (:documentation "A condition which is signalled when a command provides duplicate options")) 117 | 118 | (define-condition duplicate-commands (simple-error) 119 | ((items 120 | :initarg :items 121 | :initform (error "Must specify duplicate items") 122 | :reader duplicate-command-items)) 123 | (:report (lambda (condition stream) 124 | (let ((items (duplicate-command-items condition))) 125 | (format stream 126 | "Detected ~A duplicate command names/aliases.~2%~ 127 | The following commands have been identified as ~ 128 | providing duplicate names/aliases.~2%~ 129 | ~A~%" 130 | (length items) items)))) 131 | (:documentation "A condition which is signalled when a command provides duplicate sub-commands")) 132 | 133 | (define-condition unknown-option (error) 134 | ((name 135 | :initarg :name 136 | :initform (error "Must specify option name") 137 | :reader unknown-option-name) 138 | (kind 139 | :initarg :kind 140 | :initform (error "Must specify option kind") 141 | :reader unknown-option-kind)) 142 | (:report (lambda (condition stream) 143 | (format stream "Unknown option ~A of kind ~A" 144 | (unknown-option-name condition) 145 | (unknown-option-kind condition)))) 146 | (:documentation "A condition which is signalled when an unknown option is seen")) 147 | 148 | (defun unknown-option-p (value) 149 | (typep value 'unknown-option)) 150 | 151 | (define-condition missing-option-argument (simple-error) 152 | ((item 153 | :initarg :item 154 | :initform (error "Must specify option item") 155 | :reader missing-option-argument-item) 156 | (command 157 | :initarg :command 158 | :initform (error "Must specify command") 159 | :reader missing-option-argument-command)) 160 | (:report (lambda (condition stream) 161 | (declare (ignore condition)) 162 | (format stream "Missing argument for option"))) 163 | (:documentation "A condition which is signalled when an option expects an argument, but none was provided")) 164 | 165 | (defun missing-option-argument-p (value) 166 | (typep value 'missing-option-argument)) 167 | 168 | (define-condition invalid-option (simple-error) 169 | ((item 170 | :initarg :item 171 | :initform (error "Must specify option item") 172 | :reader invalid-option-item 173 | :documentation "The option which is identified as invalid") 174 | (reason 175 | :initarg :reason 176 | :initform (error "Must specify reason") 177 | :reader invalid-option-reason 178 | :documentation "The reason why this option is invalid")) 179 | (:report (lambda (condition stream) 180 | (format stream "Invalid option: ~A" (invalid-option-reason condition)))) 181 | (:documentation "A condition which is signalled when an option is identified as invalid")) 182 | 183 | (define-condition base-error (simple-error) 184 | () 185 | (:documentation "A base condition to be used for app specific errors")) 186 | 187 | (define-condition exit-error (base-error) 188 | ((code 189 | :initarg :code 190 | :initform (error "Must specify exit code") 191 | :reader exit-error-code 192 | :documentation "The exit code to be returned to the operating system")) 193 | (:documentation "A condition representing an error with associated exit code")) 194 | -------------------------------------------------------------------------------- /docs/clingon-demo.md: -------------------------------------------------------------------------------- 1 | # clingon-demo 2 | 3 | A demo CLI application showing some of the features of the Common Lisp system 4 | for parsing command-line arguments -- clingon. 5 | 6 | ## Usage 7 | 8 | ``` shell 9 | clingon-demo [global-options] [] [command-options] [arguments ...] 10 | ``` 11 | 12 | ## Options 13 | 14 | `clingon-demo` accepts the following options: 15 | 16 | ``` shell 17 | --help display usage information and exit 18 | --persistent-opt example persistent option 19 | --version display version and exit 20 | -v, --verbose how noisy we want to be [default: 0] 21 | 22 | ``` 23 | 24 | ## Sub Commands 25 | 26 | `clingon-demo` provides the following sub commands: 27 | 28 | ``` shell 29 | greet, hi, hey greets people 30 | logging, log configure the logging system 31 | math perform basic math on integers 32 | echo echoes back each argument on a newline 33 | engine start or stop an imaginary engine 34 | print-doc print the documentation 35 | sleep sleeps for the given period of time 36 | zsh-completion generate the Zsh completion script 37 | dot generate tree representation in Dot format 38 | 39 | ``` 40 | 41 | ## Authors 42 | 43 | * Marin Atanasov Nikolov 44 | 45 | ## License 46 | 47 | BSD 2-Clause 48 | 49 | # clingon-demo greet 50 | 51 | `clingon-demo greet` -- greets people 52 | 53 | ## Usage 54 | 55 | ``` shell 56 | clingon-demo [global-options] greet [options] [arguments ...] 57 | ``` 58 | 59 | ## Options 60 | 61 | `clingon-demo greet` accepts the following options: 62 | 63 | ``` shell 64 | --help display usage information and exit 65 | --persistent-opt example persistent option 66 | --version display version and exit 67 | -u, --user Person to greet [default: stranger] [env: $USER] 68 | 69 | ``` 70 | 71 | ## Examples 72 | 73 | Greet someone: 74 | 75 | ``` shell 76 | clingon-demo greet --user Lisper 77 | ``` 78 | 79 | # clingon-demo logging 80 | 81 | `clingon-demo logging` -- configure the logging system 82 | 83 | ## Usage 84 | 85 | ``` shell 86 | clingon-demo [global-options] logging [] [command-options] [arguments ...] 87 | ``` 88 | 89 | ## Options 90 | 91 | `clingon-demo logging` accepts the following options: 92 | 93 | ``` shell 94 | --help display usage information and exit 95 | --persistent-opt example persistent option 96 | --version display version and exit 97 | -l, --level level to configure [default: info] [env: $LOG_LEVEL] [choices: info, 98 | warn, error, debug] 99 | 100 | ``` 101 | 102 | ## Sub Commands 103 | 104 | `clingon-demo logging` provides the following sub commands: 105 | 106 | ``` shell 107 | enable enables logging 108 | disable disables logging 109 | 110 | ``` 111 | 112 | ## Examples 113 | 114 | Configure logging level: 115 | 116 | ``` shell 117 | clingon-demo -vvv logging --level=debug 118 | ``` 119 | 120 | Enable logging: 121 | 122 | ``` shell 123 | clingon-demo logging enable 124 | ``` 125 | 126 | Disable logging: 127 | 128 | ``` shell 129 | clingon-demo logging disable 130 | ``` 131 | 132 | # clingon-demo logging enable 133 | 134 | `clingon-demo logging enable` -- enables logging 135 | 136 | ## Usage 137 | 138 | ``` shell 139 | clingon-demo logging [global-options] enable [options] [arguments ...] 140 | ``` 141 | 142 | ## Options 143 | 144 | `clingon-demo logging enable` accepts the following options: 145 | 146 | ``` shell 147 | --help display usage information and exit 148 | --persistent-opt example persistent option 149 | --version display version and exit 150 | 151 | ``` 152 | 153 | # clingon-demo logging disable 154 | 155 | `clingon-demo logging disable` -- disables logging 156 | 157 | ## Usage 158 | 159 | ``` shell 160 | clingon-demo logging [global-options] disable [options] [arguments ...] 161 | ``` 162 | 163 | ## Options 164 | 165 | `clingon-demo logging disable` accepts the following options: 166 | 167 | ``` shell 168 | --help display usage information and exit 169 | --persistent-opt example persistent option 170 | --version display version and exit 171 | 172 | ``` 173 | 174 | # clingon-demo math 175 | 176 | `clingon-demo math` -- perform basic math on integers 177 | 178 | ## Usage 179 | 180 | ``` shell 181 | clingon-demo math -o -i ... 182 | ``` 183 | 184 | ## Options 185 | 186 | `clingon-demo math` accepts the following options: 187 | 188 | ``` shell 189 | --help display usage information and exit 190 | --persistent-opt example persistent option 191 | --version display version and exit 192 | -i, --int integers to work on 193 | -o, --operation operation to perform [choices: add, sub, mul, div] 194 | 195 | ``` 196 | 197 | ## Examples 198 | 199 | Sum some numbers: 200 | 201 | ``` shell 202 | clingon-demo math -o add -i 1 -i 42 -i 84 203 | ``` 204 | 205 | Multiply some numbers: 206 | 207 | ``` shell 208 | clingon-demo math -o mul -i 2 -i 3 -i 4 209 | ``` 210 | 211 | # clingon-demo echo 212 | 213 | `clingon-demo echo` -- echoes back each argument on a newline 214 | 215 | ## Usage 216 | 217 | ``` shell 218 | clingon-demo echo [ARGUMENT ...] 219 | ``` 220 | 221 | ## Options 222 | 223 | `clingon-demo echo` accepts the following options: 224 | 225 | ``` shell 226 | --help display usage information and exit 227 | --persistent-opt example persistent option 228 | --version display version and exit 229 | 230 | ``` 231 | 232 | ## Examples 233 | 234 | Echo back each argument on a new line: 235 | 236 | ``` shell 237 | clingon-demo echo foo bar baz 238 | ``` 239 | 240 | # clingon-demo engine 241 | 242 | `clingon-demo engine` -- start or stop an imaginary engine 243 | 244 | ## Usage 245 | 246 | ``` shell 247 | clingon-demo engine -s 248 | ``` 249 | 250 | ## Options 251 | 252 | `clingon-demo engine` accepts the following options: 253 | 254 | ``` shell 255 | --help display usage information and exit 256 | --persistent-opt example persistent option 257 | --version display version and exit 258 | -s, --state state of our engine 259 | 260 | ``` 261 | 262 | ## Examples 263 | 264 | Start engine: 265 | 266 | ``` shell 267 | clingon-demo engine --state=on 268 | ``` 269 | 270 | Stop engine: 271 | 272 | ``` shell 273 | clingon-demo engine --state=off 274 | ``` 275 | 276 | # clingon-demo print-doc 277 | 278 | `clingon-demo print-doc` -- print the documentation 279 | 280 | ## Usage 281 | 282 | ``` shell 283 | clingon-demo print-doc 284 | ``` 285 | 286 | ## Options 287 | 288 | `clingon-demo print-doc` accepts the following options: 289 | 290 | ``` shell 291 | --help display usage information and exit 292 | --persistent-opt example persistent option 293 | --version display version and exit 294 | 295 | ``` 296 | 297 | # clingon-demo sleep 298 | 299 | `clingon-demo sleep` -- sleeps for the given period of time 300 | 301 | ## Usage 302 | 303 | ``` shell 304 | clingon-demo [global-options] sleep [options] [arguments ...] 305 | ``` 306 | 307 | ## Options 308 | 309 | `clingon-demo sleep` accepts the following options: 310 | 311 | ``` shell 312 | --help display usage information and exit 313 | --persistent-opt example persistent option 314 | --version display version and exit 315 | -s, --seconds number of seconds to sleep [default: 60] 316 | 317 | ``` 318 | 319 | ## Examples 320 | 321 | Sleep for 60 seconds. Send SIGINT via CTRL-C to catch the signal 322 | 323 | ``` shell 324 | clingon-demo sleep --seconds 60 325 | ``` 326 | 327 | # clingon-demo zsh-completion 328 | 329 | `clingon-demo zsh-completion` -- generate the Zsh completion script 330 | 331 | ## Usage 332 | 333 | ``` shell 334 | clingon-demo zsh-completion 335 | ``` 336 | 337 | ## Options 338 | 339 | `clingon-demo zsh-completion` accepts the following options: 340 | 341 | ``` shell 342 | --help display usage information and exit 343 | --persistent-opt example persistent option 344 | --version display version and exit 345 | 346 | ``` 347 | 348 | # clingon-demo dot 349 | 350 | `clingon-demo dot` -- generate tree representation in Dot format 351 | 352 | ## Usage 353 | 354 | ``` shell 355 | clingon-demo dot 356 | ``` 357 | 358 | ## Options 359 | 360 | `clingon-demo dot` accepts the following options: 361 | 362 | ``` shell 363 | --help display usage information and exit 364 | --persistent-opt example persistent option 365 | --version display version and exit 366 | 367 | ``` 368 | 369 | -------------------------------------------------------------------------------- /tests/test-options.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.test) 27 | 28 | (deftest generic-options 29 | (testing "invalid options" 30 | (ok (signals (clingon:make-option :generic 31 | :description "foo" 32 | :short-name #\f 33 | :initial-value "bar")) 34 | "Signals on missing option key") 35 | (ok (signals (clingon:make-option :generic 36 | :description "foo" 37 | :key :foo) 38 | 'clingon:invalid-option) 39 | "Signals on missing short and long options") 40 | (ok (signals (clingon:make-option :generic 41 | :short-name #\f 42 | :required t 43 | :description "foo" 44 | :key :foo) 45 | 'clingon:invalid-option) 46 | "Signals on required option with missing parameter") 47 | (ok (signals (clingon:make-option :generic 48 | :parameter "FOO" 49 | :initial-value "some-value" 50 | :short-name #\f 51 | :required t 52 | :description "foo" 53 | :key :foo) 54 | 'clingon:invalid-option) 55 | "Signals on required option with default value") 56 | (ok (signals (clingon:make-option :generic 57 | :description "foo" 58 | :short-name #\f 59 | :key "invalid-key") 60 | 'clingon:invalid-option) 61 | "Signals when option key is not a keyword")) 62 | 63 | (testing "initialize, derive and finalize" 64 | (let ((foo (clingon:make-option :generic 65 | :description "foo" 66 | :short-name #\f 67 | :key :foo 68 | :initial-value "bar"))) 69 | (ok (equal (clingon:option-value foo) nil) "value of foo is nil") 70 | 71 | ;; Initialize the option and derive a few sample values. The 72 | ;; default implementation of DERIVE-OPTION-VALUE returns the 73 | ;; value itself. 74 | (clingon:initialize-option foo) 75 | (ok (string= (clingon:option-value foo) "bar") "option foo is properly initialized") 76 | (ok (string= (clingon:derive-option-value foo "baz") "baz") "derive baz value") 77 | (ok (string= (clingon:derive-option-value foo "qux") "qux") "derive qux value") 78 | 79 | ;; The finalized value of the option will still be "bar", since 80 | ;; we haven't set that place yet. It is usually set by the 81 | ;; parser. 82 | (ok (string= (clingon:finalize-option foo) "bar") "finalized value matches")))) 83 | 84 | (deftest option-predicates 85 | (testing "short-options" 86 | (ok (clingon:short-option-p "-x") "-x matches a short option") 87 | (ok (clingon:short-option-p "-abc") "-abc matches a short option") 88 | (ng (clingon:short-option-p "--long") "--long does not match a short option") 89 | (ng (clingon:short-option-p "-") "`-' does not match a short option")) 90 | 91 | (testing "long-options" 92 | (ok (clingon:long-option-p "--foo") "--foo matches a long option") 93 | (ok (clingon:long-option-p "--foo=bar") "--foo=bar matches a long option") 94 | (ng (clingon:long-option-p "-x") "-x does not match a long option") 95 | (ng (clingon:long-option-p "--") "`--' does not match a long option") 96 | (ng (clingon:long-option-p "-abc") "-abc does not match a long option")) 97 | 98 | (testing "end-of-options-p" 99 | (ng (clingon:end-of-options-p "-") "`-' does not match end of options") 100 | (ok (clingon:end-of-options-p "--") "`--' matches end of options") 101 | (ng (clingon:end-of-options-p "---") "`---' does not match end of options"))) 102 | 103 | (deftest option-booleans 104 | (testing "generic boolean" 105 | (let ((foo (clingon:make-option :boolean 106 | :description "foo boolean" 107 | :short-name #\b 108 | :key :boolean))) 109 | (clingon:initialize-option foo) 110 | (ok (equal nil (clingon:option-value foo)) "option is properly initialized") 111 | (ok (equal :true (clingon:derive-option-value foo "true")) "derive value from \"true\"") 112 | (ok (equal :true (clingon:derive-option-value foo "1")) "derive value from \"1\"") 113 | (ok (equal :false (clingon:derive-option-value foo "false")) "derive value from \"false\"") 114 | (ok (equal :false (clingon:derive-option-value foo "0")) "derive value from \"0\"") 115 | (ok (equal :false (clingon:derive-option-value foo nil)) "derive value from nil") 116 | (ok (equal :false (clingon:derive-option-value foo "random-string")) "derive value from \"random-string\"") 117 | 118 | ;; Set option and test finalized value 119 | (setf (clingon:option-value foo) 120 | (clingon:derive-option-value foo "false")) 121 | (ok (equal nil (clingon:finalize-option foo)) "finalized value matches"))) 122 | 123 | (testing "boolean-always-true" 124 | (let ((foo (clingon:make-option :boolean/true 125 | :description "always true option" 126 | :short-name #\b 127 | :key :boolean))) 128 | (clingon:initialize-option foo) 129 | (ok (equal nil (clingon:option-value foo)) "option is properly initialized") 130 | (ok (equal :true (clingon:derive-option-value foo "true")) "derive value from \"true\"") 131 | (ok (equal :true (clingon:derive-option-value foo "1")) "derive value from \"1\"") 132 | (ok (equal :true (clingon:derive-option-value foo "false")) "derive value from \"false\"") 133 | (ok (equal :true (clingon:derive-option-value foo "0")) "derive value from \"0\"") 134 | (ok (equal :true (clingon:derive-option-value foo nil)) "derive value from nil") 135 | (ok (equal :true (clingon:derive-option-value foo "random-string")) "derive value from \"random-string\"") 136 | 137 | ;; Set option and test finalized value 138 | (setf (clingon:option-value foo) 139 | (clingon:derive-option-value foo nil)) 140 | (ok (equal t (clingon:finalize-option foo)) "finalized value matches"))) 141 | 142 | (testing "boolean-always-false" 143 | (let ((foo (clingon:make-option :boolean/false 144 | :description "always false option" 145 | :short-name #\b 146 | :key :boolean))) 147 | (clingon:initialize-option foo) 148 | (ok (equal nil (clingon:option-value foo)) "option is properly initialized") 149 | (ok (equal :false (clingon:derive-option-value foo "true")) "derive value from \"true\"") 150 | (ok (equal :false (clingon:derive-option-value foo "1")) "derive value from \"1\"") 151 | (ok (equal :false (clingon:derive-option-value foo "false")) "derive value from \"false\"") 152 | (ok (equal :false (clingon:derive-option-value foo "0")) "derive value from \"0\"") 153 | (ok (equal :false (clingon:derive-option-value foo nil)) "derive value from nil") 154 | (ok (equal :false (clingon:derive-option-value foo "random-string")) "derive value from \"random-string\"") 155 | 156 | ;; Set option and test finalized value 157 | (setf (clingon:option-value foo) 158 | (clingon:derive-option-value foo "true")) 159 | (ok (equal nil (clingon:finalize-option foo)) "finalized value matches")))) 160 | 161 | (deftest option-counter 162 | (testing "counter with defaults" 163 | (let ((opt (clingon:make-option :counter 164 | :description "counter with defaults" 165 | :short-name #\c 166 | :key :counter))) 167 | (clingon:initialize-option opt) 168 | (loop :repeat 42 :do 169 | (setf (clingon:option-value opt) 170 | (clingon:derive-option-value opt nil))) 171 | (ok (= 42 (clingon:finalize-option opt)) "finalized value matches"))) 172 | 173 | (testing "counter with a step" 174 | (let ((opt (clingon:make-option :counter 175 | :description "counter with a step" 176 | :short-name #\c 177 | :key :counter 178 | :initial-value 42 179 | :step 3))) 180 | (clingon:initialize-option opt) 181 | (loop :repeat 3 :do 182 | (setf (clingon:option-value opt) 183 | (clingon:derive-option-value opt nil))) 184 | (ok (= 51 (clingon:finalize-option opt)) "finalized value matches")))) 185 | 186 | (deftest option-list 187 | (testing "list with defaults" 188 | (let ((opt (clingon:make-option :list 189 | :description "list with defaults" 190 | :short-name #\l 191 | :key :list)) 192 | (items (list "foo" "bar" "baz"))) 193 | (clingon:initialize-option opt) 194 | (loop :for item :in items :do 195 | (setf (clingon:option-value opt) 196 | (clingon:derive-option-value opt item))) 197 | (ok (equal items (clingon:finalize-option opt)) "finalized value matches"))) 198 | 199 | (testing "list with initial string value" 200 | ;; The string value for a list would usually be provided from 201 | ;; environment variables. 202 | (let ((opt (clingon:make-option :list 203 | :description "list with defaults" 204 | :short-name #\l 205 | :key :list 206 | :initial-value "foo, bar, baz"))) 207 | (clingon:initialize-option opt) 208 | (ok (equal (list "foo" "bar" "baz") (clingon:finalize-option opt)) "finalized value matches"))) 209 | 210 | (testing "list with initial list value" 211 | (let ((opt (clingon:make-option :list 212 | :description "list initialized from a list" 213 | :short-name #\l 214 | :key :list 215 | :initial-value '("foo" "bar" "baz")))) 216 | (clingon:initialize-option opt) 217 | (setf (clingon:option-value opt) (clingon:derive-option-value opt "qux")) 218 | (ok (equal (list "foo" "bar" "baz" "qux") (clingon:finalize-option opt)) "finalized value matches")))) 219 | 220 | (deftest option-integer 221 | (testing "integer with defaults" 222 | (let ((opt (clingon:make-option :integer 223 | :description "int with defaults" 224 | :short-name #\i 225 | :key :int 226 | :initial-value 0))) 227 | (clingon:initialize-option opt) 228 | (ok (= 0 (clingon:option-value opt)) "initial value matches") 229 | (ok (= 42 (clingon:derive-option-value opt "42")) "derive 42 as int") 230 | (ok (= 42 (clingon:derive-option-value opt "42.0")) "derive 42.0 as int") 231 | (ok (= 42 (clingon:derive-option-value opt "42.42")) "derive 42.42 as int") 232 | (ok (signals (clingon:derive-option-value opt "NaN")) "signals on NaN") 233 | 234 | ;; The value's place has not been set at all 235 | (ok (= 0 (clingon:finalize-option opt)) "finalized value matches"))) 236 | 237 | (testing "integer initialized from string with good input" 238 | ;; The string initial-value would usually come from an env var 239 | (let ((opt (clingon:make-option :integer 240 | :description "int with default string value" 241 | :short-name #\i 242 | :key :int 243 | :initial-value "42"))) 244 | (clingon:initialize-option opt) 245 | (ok (= 42 (clingon:finalize-option opt)) "finalized value matches"))) 246 | 247 | (testing "integer initialized with bad input" 248 | (let ((opt (clingon:make-option :integer 249 | :description "int with bad default string value" 250 | :short-name #\i 251 | :key :int 252 | :initial-value "NaN"))) 253 | (ok (signals (clingon:initialize-option opt)) "signals on invalid initialization")))) 254 | 255 | (deftest option-list-integer 256 | (testing "derive values from integers" 257 | (let ((opt (clingon:make-option :list/integer 258 | :description "list of integers" 259 | :short-name #\l 260 | :key :list-of-integers))) 261 | (clingon:initialize-option opt) 262 | (loop :for i :from 0 :to 5 :do 263 | (setf (clingon:option-value opt) 264 | (clingon:derive-option-value opt i))) 265 | (ok (equal '(0 1 2 3 4 5) (clingon:finalize-option opt)) "finalized value matches"))) 266 | 267 | (testing "derive values from strings" 268 | (let ((opt (clingon:make-option :list/integer 269 | :description "list of integers" 270 | :short-name #\l 271 | :key :list-of-integers))) 272 | (clingon:initialize-option opt) 273 | (loop :for i :from 0 :to 5 :do 274 | (setf (clingon:option-value opt) 275 | (clingon:derive-option-value opt (format nil "~d" i)))) 276 | (ok (equal '(0 1 2 3 4 5) (clingon:finalize-option opt)) "finalized value matches"))) 277 | 278 | (testing "derive values with a default value as a list" 279 | (let ((opt (clingon:make-option :list/integer 280 | :description "list of integers" 281 | :short-name #\l 282 | :key :list-of-integers 283 | :initial-value '(-3 -2 -1)))) 284 | (clingon:initialize-option opt) 285 | (loop :for i :from 0 :to 5 :do 286 | (setf (clingon:option-value opt) 287 | (clingon:derive-option-value opt (format nil "~d" i)))) 288 | (ok (equal '(-3 -2 -1 0 1 2 3 4 5) (clingon:finalize-option opt)) "finalized value matches"))) 289 | 290 | (testing "derive values with a default value as a string" 291 | (let ((opt (clingon:make-option :list/integer 292 | :description "list of integers" 293 | :short-name #\l 294 | :key :list-of-integers 295 | :initial-value "-3, -2, -1"))) 296 | (clingon:initialize-option opt) 297 | (loop :for i :from 0 :to 5 :do 298 | (setf (clingon:option-value opt) 299 | (clingon:derive-option-value opt (format nil "~d" i)))) 300 | (ok (equal '(-3 -2 -1 0 1 2 3 4 5) (clingon:finalize-option opt)) "finalized value matches")))) 301 | 302 | (deftest option-choice 303 | (testing "test with no default choice set" 304 | (let ((opt (clingon:make-option :choice 305 | :description "choice option" 306 | :short-name #\c 307 | :key :choice 308 | :items '("foo" "bar" "baz")))) 309 | (clingon:initialize-option opt) 310 | (ok (string= "foo" (clingon:derive-option-value opt "foo")) "derive foo choice") 311 | (ok (string= "bar" (clingon:derive-option-value opt "bar")) "derive bar choice") 312 | (ok (string= "baz" (clingon:derive-option-value opt "baz")) "derive baz choice") 313 | (ok (signals (clingon:derive-option-value opt "INVALID") 314 | 'clingon:option-derive-error) 315 | "signals on invalid choice"))) 316 | 317 | (testing "test with a default choice" 318 | (let ((opt (clingon:make-option :choice 319 | :description "choice option with default value" 320 | :short-name #\c 321 | :key :choice 322 | :items '("foo" "bar" "baz") 323 | :initial-value "foo"))) 324 | (clingon:initialize-option opt) 325 | (ok (string= "foo" (clingon:finalize-option opt)) "finalized value matches"))) 326 | 327 | (testing "test with invalid default choice" 328 | (let ((opt (clingon:make-option :choice 329 | :description "choice option with invalid default value" 330 | :short-name #\c 331 | :key :choice 332 | :items '("foo" "bar" "baz") 333 | :initial-value "INVALID"))) 334 | (ok (signals (clingon:initialize-option opt) 'clingon:option-derive-error) "signals on invalid default choice")))) 335 | 336 | (deftest option-enum 337 | (testing "test with no default value" 338 | (let ((opt (clingon:make-option :enum 339 | :description "enum option" 340 | :short-name #\e 341 | :key :enum 342 | :items '(("one" . 1) 343 | ("two" . 2) 344 | ("three" . 3))))) 345 | (clingon:initialize-option opt) 346 | (ok (= 1 (clingon:derive-option-value opt "one")) "derive value from \"one\"") 347 | (ok (= 2 (clingon:derive-option-value opt "two")) "derive value from \"two\"") 348 | (ok (= 3 (clingon:derive-option-value opt "three")) "derive value from \"three\"") 349 | (ok (signals (clingon:derive-option-value opt "INVALID") 'clingon:option-derive-error) 350 | "signals on invalid enum variant"))) 351 | 352 | (testing "test with default value" 353 | (let ((opt (clingon:make-option :enum 354 | :description "enum option" 355 | :short-name #\e 356 | :key :enum 357 | :items '(("one" . 1) 358 | ("two" . 2) 359 | ("three" . 3)) 360 | :initial-value "one"))) 361 | (clingon:initialize-option opt) 362 | (ok (= 1 (clingon:finalize-option opt)) "finalized value matches"))) 363 | 364 | (testing "test with invalid default value" 365 | (let ((opt (clingon:make-option :enum 366 | :description "enum option" 367 | :short-name #\e 368 | :key :enum 369 | :items '(("one" . 1) 370 | ("two" . 2) 371 | ("three" . 3)) 372 | :initial-value "INVALID"))) 373 | (ok (signals (clingon:initialize-option opt) 'clingon:option-derive-error) 374 | "signals on invalid default value")))) 375 | 376 | (deftest option-string 377 | (testing "test with no default" 378 | (let ((opt (clingon:make-option :string 379 | :description "string option" 380 | :short-name #\c 381 | :key :string))) 382 | (clingon:initialize-option opt) 383 | (ok (string= "foo" (clingon:derive-option-value opt "foo")) "derive foo") 384 | (ok (string= "bar" (clingon:derive-option-value opt "bar")) "derive bar") 385 | (ok (string= "baz" (clingon:derive-option-value opt "baz")) "derive baz"))) 386 | 387 | (testing "test with a default value" 388 | (let ((opt (clingon:make-option :string 389 | :description "string with default value" 390 | :short-name #\c 391 | :key :string 392 | :initial-value "foo"))) 393 | (clingon:initialize-option opt) 394 | (ok (string= "foo" (clingon:finalize-option opt)) "finalized value matches")))) 395 | 396 | (deftest option-switch 397 | (testing "test with no default value" 398 | (let ((opt (clingon:make-option :switch 399 | :description "switch option" 400 | :short-name #\s 401 | :key :switch))) 402 | (clingon:initialize-option opt) 403 | (ok (equal :true (clingon:derive-option-value opt "on")) "derive value from \"on\"") 404 | (ok (equal :true (clingon:derive-option-value opt "yes")) "derive value from \"yes\"") 405 | (ok (equal :true (clingon:derive-option-value opt "enable")) "derive value from \"enable\"") 406 | (ok (equal :true (clingon:derive-option-value opt "1")) "derive value from \"1\"") 407 | (ok (equal :true (clingon:derive-option-value opt "true")) "derive value from \"true\"") 408 | (ok (equal :false (clingon:derive-option-value opt "off")) "derive value from \"off\"") 409 | (ok (equal :false (clingon:derive-option-value opt "no")) "derive value from \"no\"") 410 | (ok (equal :false (clingon:derive-option-value opt "false")) "derive value from \"false\"") 411 | (ok (equal :false (clingon:derive-option-value opt "disable")) "derive value from \"disable\"") 412 | (ok (equal :false (clingon:derive-option-value opt "0")) "derive value from \"0\"") 413 | (ok (signals (clingon:derive-option-value opt "INVALID") 'clingon:option-derive-error) 414 | "signals on invalid switch state"))) 415 | 416 | (testing "test with a default value" 417 | (let ((opt (clingon:make-option :switch 418 | :description "switch with a default state" 419 | :short-name #\s 420 | :key :switch 421 | :initial-value "on"))) 422 | (clingon:initialize-option opt) 423 | (ok (equal t (clingon:finalize-option opt)) "finalized value matches"))) 424 | 425 | (testing "test with invalid default value" 426 | (let ((opt (clingon:make-option :switch 427 | :description "switch with invalid default" 428 | :short-name #\s 429 | :key :switch 430 | :initial-value "INVALID"))) 431 | (ok (signals (clingon:initialize-option opt) 'clingon:option-derive-error) 432 | "signals on invalid default value")))) 433 | -------------------------------------------------------------------------------- /src/options.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :cl-user) 27 | (defpackage :clingon.options 28 | (:use :cl) 29 | (:import-from 30 | :clingon.utils 31 | :join-list) 32 | (:import-from 33 | :clingon.conditions 34 | :invalid-option 35 | :missing-required-option-value 36 | :option-derive-error) 37 | (:export 38 | :*end-of-options-marker* 39 | :option 40 | :option-short-name 41 | :option-long-name 42 | :option-required-p 43 | :option-parameter 44 | :option-description 45 | :option-category 46 | :option-env-vars 47 | :option-initial-value 48 | :option-key 49 | :option-value 50 | :option-is-set-p 51 | :option-hidden-p 52 | :option-persistent-p 53 | :initialize-option 54 | :finalize-option 55 | :derive-option-value 56 | :make-option 57 | :option-usage-details 58 | :option-description-details 59 | :end-of-options-p 60 | :short-option-p 61 | :long-option-p 62 | :option-boolean 63 | :option-boolean-true 64 | :option-boolean-false 65 | :option-counter 66 | :option-counter-step 67 | :option-list 68 | :option-list-separator 69 | :option-choice 70 | :option-choices 71 | :option-integer 72 | :option-integer-radix 73 | :option-list-integer 74 | :option-choice 75 | :option-choice-items 76 | :option-enum 77 | :option-enum-items 78 | :option-switch 79 | :option-switch-on-states 80 | :option-switch-off-states 81 | :option-filepath 82 | :option-list-filepath 83 | :parse-integer-or-lose)) 84 | (in-package :clingon.options) 85 | 86 | (defgeneric initialize-option (option &key) 87 | (:documentation "Initializes an option, e.g. sets initial option value")) 88 | 89 | (defgeneric finalize-option (option &key) 90 | (:documentation "Finalizes an option, e.g. performs any value transformations")) 91 | 92 | (defgeneric derive-option-value (option value &key) 93 | (:documentation "Derives a new value for the option based on the given string VALUE")) 94 | 95 | (defgeneric make-option (kind &rest rest) 96 | (:documentation "Creates a new option of the given kind")) 97 | 98 | (defgeneric option-usage-details (kind object &key) 99 | (:documentation "Returns the usage details for the option as a 100 | string. The returned string will be used for formatting and 101 | displaying the option as part of help pages.")) 102 | 103 | (defgeneric option-description-details (kind object &key) 104 | (:documentation "Returns a formatted and probably enriched content 105 | of the option's description")) 106 | 107 | (defparameter *end-of-options-marker* 108 | "--" 109 | "A marker specifying the end of options") 110 | 111 | (defun end-of-options-p (arg) 112 | "A predicate which returns T if the given argument specifies end of options" 113 | (string= arg *end-of-options-marker*)) 114 | 115 | (defun short-option-p (arg) 116 | "A predicate which returns T if the given argument is a short option" 117 | (and (> (length arg) 1) 118 | (char= #\- (aref arg 0)) 119 | (char/= #\- (aref arg 1)))) 120 | 121 | (defun long-option-p (arg) 122 | "A predicate which returns T if the given argument is a long option" 123 | (and (> (length arg) 2) 124 | (char= #\- (aref arg 0)) 125 | (char= #\- (aref arg 1)))) 126 | 127 | (defclass option () 128 | ((parameter 129 | :initarg :parameter 130 | :initform nil 131 | :reader option-parameter 132 | :documentation "Option takes a parameter identified by the given name") 133 | (required 134 | :initarg :required 135 | :initform nil 136 | :reader option-required-p 137 | :documentation "Mark the option as required. Only valid if the option takes a parameter") 138 | (short-name 139 | :initarg :short-name 140 | :initform nil 141 | :reader option-short-name 142 | :documentation "Short option name") 143 | (long-name 144 | :initarg :long-name 145 | :initform nil 146 | :reader option-long-name 147 | :documentation "Long option name") 148 | (description 149 | :initarg :description 150 | :initform (error "Must specify description") 151 | :reader option-description 152 | :documentation "Short description of the option") 153 | (category 154 | :initarg :category 155 | :initform "" 156 | :reader option-category 157 | :documentation "Category for the option. Options with the same category will be grouped together") 158 | (env-vars 159 | :initarg :env-vars 160 | :initform nil 161 | :reader option-env-vars 162 | :documentation "List of env vars which can set the option value") 163 | (initial-value 164 | :initarg :initial-value 165 | :initform nil 166 | :reader option-initial-value 167 | :documentation "Initial value for the option") 168 | (key 169 | :initarg :key 170 | :initform (error "Must specify option key") 171 | :reader option-key 172 | :documentation "Key used to associate the option with it's value") 173 | (is-set-p 174 | :initarg :is-set-p 175 | :initform nil 176 | :accessor option-is-set-p 177 | :documentation "Predicate which returns T if the option was set") 178 | (hidden 179 | :initarg :hidden 180 | :initform nil 181 | :reader option-hidden-p 182 | :documentation "Whether or not this option will be hidden on the usage pages") 183 | (persistent 184 | :initarg :persistent 185 | :initform nil 186 | :reader option-persistent-p 187 | :documentation "Whether or not this option is persistent across sub-commands") 188 | (value 189 | :initarg :value 190 | :initform nil 191 | :accessor option-value 192 | :documentation "Computed value after finalizing the option")) 193 | (:documentation "A class representing a command-line option")) 194 | 195 | (defmethod print-object ((option option) stream) 196 | (print-unreadable-object (option stream :type t) 197 | (format stream "short=~A long=~A" 198 | (option-short-name option) 199 | (option-long-name option)))) 200 | 201 | (defmethod option-usage-details ((kind (eql :default)) (option option) &key) 202 | (with-output-to-string (s) 203 | (cond 204 | ;; Short and long names are defined 205 | ((and (option-short-name option) (option-long-name option)) 206 | (format s "-~A, --~A" (option-short-name option) (option-long-name option))) 207 | ;; We only have a short name defined 208 | ((option-short-name option) 209 | (format s "-~A" (option-short-name option))) 210 | ;; Long name defined only, align it properly 211 | (t 212 | (format s "~vA--~A" 4 #\Space (option-long-name option)))) 213 | (when (option-parameter option) 214 | (format s " <~A>" (option-parameter option))))) 215 | 216 | (defmethod option-description-details ((kind (eql :default)) (option option) &key) 217 | (with-output-to-string (s) 218 | (format s "~A" (option-description option)) 219 | (when (option-initial-value option) 220 | (format s " [default: ~A]" (option-initial-value option))) 221 | (when (option-env-vars option) 222 | (let ((vars (mapcar (lambda (var) (format nil "$~A" var)) (option-env-vars option)))) 223 | (format s " [env: ~A]" (join-list vars ", ")))))) 224 | 225 | (defmethod option-usage-details ((kind (eql :zsh-option-spec)) (option option) &key) 226 | (with-output-to-string (s) 227 | (cond 228 | ;; Short and long names are defined 229 | ((and (option-short-name option) (option-long-name option)) 230 | (format s "{-~A,--~A}" (option-short-name option) (option-long-name option))) 231 | ;; Short name only 232 | ((option-short-name option) 233 | (format s "-~A" (option-short-name option))) 234 | (t 235 | ;; Long name only 236 | (format s "--~A" (option-long-name option)))))) 237 | 238 | (defmethod option-description-details ((kind (eql :zsh-option-spec)) (option option) &key) 239 | (with-output-to-string (s) 240 | (format s "'[~A]'" (option-description option)) 241 | (when (option-parameter option) 242 | (format s ":~A" (option-parameter option))))) 243 | 244 | ;;;; 245 | ;;;; Generic options 246 | ;;;; 247 | 248 | (defmethod make-option ((kind (eql :generic)) &rest rest) 249 | "Creates a generic option" 250 | (apply #'make-instance 'option rest)) 251 | 252 | (defmethod initialize-instance :after ((option option) &key) 253 | (unless (keywordp (option-key option)) 254 | (error 'invalid-option :item option 255 | :reason "key must be a keyword")) 256 | 257 | ;; Test for required short/long names 258 | (with-slots (short-name long-name) option 259 | (unless (or short-name long-name) 260 | (error 'invalid-option :item option 261 | :reason (format nil "option must specify a short and/or long name")))) 262 | 263 | ;; Required option must have a parameter associated with it 264 | (when (and (option-required-p option) 265 | (not (option-parameter option))) 266 | (error 'invalid-option :item option 267 | :reason (format nil "required option must have a parameter associated with it"))) 268 | 269 | ;; Required option must not have a default value associated with it. 270 | ;; However, it can still be initialized through other means, 271 | ;; e.g. environment variables. 272 | (when (and (option-required-p option) 273 | (option-initial-value option)) 274 | (error 'invalid-option :item option 275 | :reason "required option may not have a default value"))) 276 | 277 | (defmethod initialize-option ((option option) &key) 278 | "Initialize the value of the option. 279 | 280 | Environment variables take precedence over any 281 | initial-value configured for the option. 282 | 283 | The first environment variable that resolves to a 284 | non-NIL result will be used to set the option." 285 | (setf (option-is-set-p option) nil) 286 | (let* ((env-vars (option-env-vars option)) 287 | (value-from-env (some #'uiop:getenvp env-vars)) 288 | (value (or value-from-env (option-initial-value option)))) 289 | (setf (option-value option) value) 290 | (when value 291 | (setf (option-is-set-p option) t)))) 292 | 293 | (defmethod derive-option-value ((option option) arg &key) 294 | arg) 295 | 296 | (defmethod finalize-option ((option option) &key) 297 | "Finalizes the value of the option" 298 | (option-value option)) 299 | 300 | ;;;; 301 | ;;;; String options 302 | ;;;; 303 | 304 | (defclass option-string (option) 305 | () 306 | (:default-initargs 307 | :parameter "VALUE") 308 | (:documentation "An option which represents a string")) 309 | 310 | (defmethod make-option ((kind (eql :string)) &rest rest) 311 | (apply #'make-instance 'option-string rest)) 312 | 313 | (defclass option-filepath (option) 314 | () 315 | (:default-initargs 316 | :parameter "PATH") 317 | (:documentation "An option which represents a filepath")) 318 | 319 | (defmethod make-option ((kind (eql :filepath)) &rest rest) 320 | (apply #'make-instance 'option-filepath rest)) 321 | 322 | (defmethod option-description-details ((kind (eql :zsh-option-spec)) (option option-filepath) &key) 323 | ;; Use the `_files' function for completing file paths 324 | (with-output-to-string (s) 325 | (write-string (call-next-method) s) 326 | (format s ":_files"))) 327 | 328 | ;;;; 329 | ;;;; Boolean options 330 | ;;;; 331 | 332 | (defclass option-boolean (option) 333 | () 334 | (:default-initargs 335 | :parameter "VALUE") 336 | (:documentation "An option which represents a boolean flag")) 337 | 338 | (defmethod make-option ((kind (eql :boolean)) &rest rest) 339 | (apply #'make-instance 'option-boolean rest)) 340 | 341 | (defmethod derive-option-value ((option option-boolean) arg &key) 342 | (let ((arg (string-downcase arg))) 343 | (cond 344 | ((string= "1" arg) :true) 345 | ((string= "true" arg) :true) 346 | (t :false)))) 347 | 348 | (defmethod finalize-option ((option option-boolean) &key) 349 | (ecase (option-value option) 350 | (:true t) 351 | (:false nil))) 352 | 353 | (defclass option-boolean-true (option-boolean) 354 | () 355 | (:default-initargs 356 | :parameter nil) 357 | (:documentation "A boolean option which always returns true")) 358 | 359 | (defmethod make-option ((kind (eql :boolean/true)) &rest rest) 360 | (apply #'make-instance 'option-boolean-true rest)) 361 | 362 | (defmethod make-option ((kind (eql :flag)) &rest rest) 363 | (apply #'make-instance 'option-boolean-true rest)) 364 | 365 | (defmethod derive-option-value ((option option-boolean-true) arg &key) 366 | (declare (ignore arg)) 367 | :true) 368 | 369 | (defclass option-boolean-false (option-boolean) 370 | () 371 | (:default-initargs 372 | :parameter nil) 373 | (:documentation "A boolean option which always returns false")) 374 | 375 | (defmethod make-option ((kind (eql :boolean/false)) &rest rest) 376 | (apply #'make-instance 'option-boolean-false rest)) 377 | 378 | (defmethod derive-option-value ((option option-boolean-false) arg &key) 379 | (declare (ignore arg)) 380 | :false) 381 | 382 | ;;;; 383 | ;;;; Counter options 384 | ;;;; 385 | 386 | (defclass option-counter (option) 387 | ((step 388 | :initarg :step 389 | :initform 1 390 | :reader option-counter-step 391 | :documentation "Numeric value to increase the counter with")) 392 | (:default-initargs 393 | :initial-value 0) 394 | (:documentation "An option which increments every time it is set")) 395 | 396 | (defmethod make-option ((kind (eql :counter)) &rest rest) 397 | (apply #'make-instance 'option-counter rest)) 398 | 399 | (defmethod derive-option-value ((option option-counter) arg &key) 400 | (declare (ignore arg)) 401 | (+ (option-value option) (option-counter-step option))) 402 | 403 | (defmethod option-usage-details ((kind (eql :zsh-option-spec)) (option option-counter) &key) 404 | "Counter options may be repeated on the command-line" 405 | (with-output-to-string (s) 406 | (format s "\\*") 407 | (write-string (call-next-method) s))) 408 | 409 | ;;;; 410 | ;;;; List options 411 | ;;;; 412 | 413 | (defclass option-list (option) 414 | ((separator 415 | :initarg :separator 416 | :initform #\, 417 | :reader option-list-separator 418 | :documentation "Character used to separate items in a list represented as a string")) 419 | (:default-initargs 420 | :initial-value nil 421 | :parameter "ITEM") 422 | (:documentation "An option which collects values into a list")) 423 | 424 | (defmethod make-option ((kind (eql :list)) &rest rest) 425 | (apply #'make-instance 'option-list rest)) 426 | 427 | (defmethod initialize-option ((option option-list) &key) 428 | "Initializes a list option. If the option has been initialized 429 | via environment variables, the initial value for the list would 430 | be represented as a string. This method will ensure that if the 431 | option is initialized from a string source it is represented as 432 | a valid list before deriving any other values for the option." 433 | ;; Make sure we call our parent initialization method first to set 434 | ;; things up. 435 | (call-next-method) 436 | 437 | ;; Nothing to initialize further 438 | (unless (option-value option) 439 | (return-from initialize-option)) 440 | 441 | (let ((value (option-value option)) 442 | (separator (option-list-separator option))) 443 | (setf (option-value option) 444 | (etypecase value 445 | (list (reverse value)) 446 | (string (nreverse (mapcar (lambda (x) 447 | (string-trim #(#\ ) x)) 448 | (split-sequence:split-sequence separator value)))))))) 449 | 450 | (defmethod derive-option-value ((option option-list) arg &key) 451 | (cons arg (option-value option))) 452 | 453 | (defmethod finalize-option ((option option-list) &key) 454 | (setf (option-value option) (nreverse (option-value option)))) 455 | 456 | (defmethod option-usage-details ((kind (eql :zsh-option-spec)) (option option-list) &key) 457 | "List options may be repeated on the command-line" 458 | (with-output-to-string (s) 459 | (format s "\\*") 460 | (write-string (call-next-method) s))) 461 | 462 | (defclass option-list-filepath (option-filepath option-list) 463 | () 464 | (:default-initargs 465 | :parameter "PATH") 466 | (:documentation "An option which represents a list of filepaths")) 467 | 468 | (defmethod make-option ((kind (eql :list/filepath)) &rest rest) 469 | (apply #'make-instance 'option-list-filepath rest)) 470 | 471 | ;;;; 472 | ;;;; Integer options 473 | ;;;; 474 | 475 | (defun parse-integer-or-lose (value &key (radix 10)) 476 | (when (integerp value) 477 | (return-from parse-integer-or-lose value)) 478 | 479 | (let ((int (parse-integer value :radix radix :junk-allowed t))) 480 | (unless int 481 | (error 'option-derive-error :reason (format nil "Cannot parse ~A as integer" value))) 482 | int)) 483 | 484 | (defclass option-integer (option) 485 | ((radix 486 | :initarg :radix 487 | :initform 10 488 | :reader option-integer-radix)) 489 | (:default-initargs 490 | :parameter "INT") 491 | (:documentation "An option class to represent an integer")) 492 | 493 | (defmethod make-option ((kind (eql :integer)) &rest rest) 494 | (apply #'make-instance 'option-integer rest)) 495 | 496 | (defmethod initialize-option ((option option-integer) &key) 497 | "Initializes the integer option. In case the option was 498 | first initialized by other means, such as environment variables, 499 | we make sure that the provided value is a valid integer." 500 | (call-next-method) 501 | 502 | ;; Nothing to initialize further 503 | (unless (option-value option) 504 | (return-from initialize-option)) 505 | 506 | (let ((value (option-value option))) 507 | (setf (option-value option) 508 | (etypecase value 509 | (integer value) 510 | (string (parse-integer-or-lose value :radix (option-integer-radix option))))))) 511 | 512 | (defmethod derive-option-value ((option option-integer) arg &key) 513 | (parse-integer-or-lose arg :radix (option-integer-radix option))) 514 | 515 | (defclass option-list-integer (option-list) 516 | ((radix 517 | :initarg :radix 518 | :initform 10 519 | :reader option-integer-radix)) 520 | (:documentation "An option which collects integers into a list")) 521 | 522 | (defmethod make-option ((kind (eql :list/integer)) &rest rest) 523 | (apply #'make-instance 'option-list-integer rest)) 524 | 525 | (defmethod initialize-option ((option option-list-integer) &key) 526 | (call-next-method) 527 | (unless (option-value option) 528 | (return-from initialize-option)) 529 | 530 | (setf (option-value option) 531 | (mapcar (lambda (x) 532 | (etypecase x 533 | (integer x) 534 | (string (parse-integer-or-lose x :radix (option-integer-radix option))))) 535 | (option-value option)))) 536 | 537 | (defmethod derive-option-value ((option option-list-integer) arg &key) 538 | (cons (parse-integer-or-lose arg :radix (option-integer-radix option)) 539 | (option-value option))) 540 | 541 | ;;;; 542 | ;;;; Choice/enum options 543 | ;;;; 544 | 545 | (defclass option-choice (option) 546 | ((items 547 | :initarg :items 548 | :initform (error "Must specify available items") 549 | :reader option-choice-items 550 | :documentation "The available choices")) 551 | (:default-initargs 552 | :parameter "CHOICE") 553 | (:documentation "An option which allows selecting an item from a predefined list")) 554 | 555 | (defmethod option-description-details ((kind (eql :default)) (option option-choice) &key) 556 | (with-output-to-string (s) 557 | (write-string (call-next-method) s) 558 | (let ((choices (option-choice-items option))) 559 | (format s " [choices: ~A]" (join-list choices ", "))))) 560 | 561 | (defmethod option-description-details ((kind (eql :zsh-option-spec)) (option option-choice) &key) 562 | (with-output-to-string (s) 563 | (write-string (call-next-method) s) 564 | (let ((choices (option-choice-items option))) 565 | (format s ":'(~A)'" (join-list choices #\Space))))) 566 | 567 | (defmethod make-option ((kind (eql :choice)) &rest rest) 568 | (apply #'make-instance 'option-choice rest)) 569 | 570 | (defmethod initialize-option ((option option-choice) &key) 571 | ;; Set things up 572 | (call-next-method) 573 | 574 | ;; Nothing to be done further 575 | (unless (option-value option) 576 | (return-from initialize-option)) 577 | 578 | ;; Derive a new value based on the already set initialized value 579 | (let ((current (option-value option))) 580 | (setf (option-value option) (derive-option-value option current)))) 581 | 582 | (defmethod derive-option-value ((option option-choice) arg &key) 583 | (let ((items (option-choice-items option))) 584 | (unless (member arg items :test #'string=) 585 | (error 'option-derive-error :reason (format nil "Invalid choice: must be one of ~A" items)))) 586 | arg) 587 | 588 | (defclass option-enum (option) 589 | ((items 590 | :initarg :items 591 | :initform (error "Must specify available variants") 592 | :reader option-enum-items 593 | :documentation "The enum variants and their associated values")) 594 | (:default-initargs 595 | :parameter "VARIANT") 596 | (:documentation "An option which represents an enum with variants and associated values")) 597 | 598 | (defmethod option-description-details ((kind (eql :default)) (option option-enum) &key) 599 | (with-output-to-string (s) 600 | (write-string (call-next-method) s) 601 | (let ((choices (mapcar #'car (option-enum-items option)))) 602 | (format s " [choices: ~A]" (join-list choices ", "))))) 603 | 604 | (defmethod option-description-details ((kind (eql :zsh-option-spec)) (option option-enum) &key) 605 | (with-output-to-string (s) 606 | (write-string (call-next-method) s) 607 | (let ((choices (mapcar #'car (option-enum-items option)))) 608 | (format s ":'(~A)'" (join-list choices #\Space))))) 609 | 610 | (defmethod make-option ((kind (eql :enum)) &rest rest) 611 | (apply #'make-instance 'option-enum rest)) 612 | 613 | (defmethod initialize-option ((option option-enum) &key) 614 | (call-next-method) 615 | (unless (option-value option) 616 | (return-from initialize-option)) 617 | 618 | (let ((current (option-value option))) 619 | (setf (option-value option) (derive-option-value option current)))) 620 | 621 | (defmethod derive-option-value ((option option-enum) arg &key) 622 | (let* ((items (option-enum-items option)) 623 | (pair (find arg items :key #'car :test #'string=))) 624 | (unless pair 625 | (error 'option-derive-error 626 | :reason (format nil "Invalid choice: must be one of ~A" (mapcar #'car items)))) 627 | (cdr pair))) 628 | 629 | (defclass option-switch (option-boolean) 630 | ((on-states 631 | :initarg :on-states 632 | :initform '("on" "yes" "true" "enable" "1") 633 | :reader option-switch-on-states 634 | :documentation "The list of states considered to `activate' the switch") 635 | (off-states 636 | :initarg :off-states 637 | :initform '("off" "no" "false" "disable" "0") 638 | :reader option-switch-off-states 639 | :documentation "The list of states considered to `deactivate' the switch")) 640 | (:default-initargs 641 | :parameter "STATE") 642 | (:documentation "An option which represents a switch with a state")) 643 | 644 | (defmethod option-description-details ((kind (eql :zsh-option-spec)) (option option-switch) &key) 645 | (with-output-to-string (s) 646 | (write-string (call-next-method) s) 647 | (let ((on-states (option-switch-on-states option)) 648 | (off-states (option-switch-off-states option))) 649 | (format s ":'(~A)'" (join-list (append on-states off-states) #\Space))))) 650 | 651 | (defmethod initialize-option ((option option-switch) &key) 652 | "Initializes the switch option kind" 653 | (call-next-method) 654 | (unless (option-value option) 655 | (return-from initialize-option)) 656 | 657 | ;; Derive a new value if we have an initial value 658 | (let ((current (option-value option))) 659 | (setf (option-value option) 660 | (derive-option-value option current)))) 661 | 662 | (defmethod derive-option-value ((option option-switch) arg &key) 663 | (cond 664 | ((member arg (option-switch-on-states option) :test #'string=) :true) 665 | ((member arg (option-switch-off-states option) :test #'string=) :false) 666 | (t 667 | (error 'option-derive-error :reason (format nil "Invalid switch state: ~A" arg))))) 668 | 669 | (defmethod make-option ((kind (eql :switch)) &rest rest) 670 | (apply #'make-instance 'option-switch rest)) 671 | -------------------------------------------------------------------------------- /tests/test-command.lisp: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) 2021 Marin Atanasov Nikolov 2 | ;; All rights reserved. 3 | ;; 4 | ;; Redistribution and use in source and binary forms, with or without 5 | ;; modification, are permitted provided that the following conditions 6 | ;; are met: 7 | ;; 8 | ;; 1. Redistributions of source code must retain the above copyright 9 | ;; notice, this list of conditions and the following disclaimer 10 | ;; in this position and unchanged. 11 | ;; 2. Redistributions in binary form must reproduce the above copyright 12 | ;; notice, this list of conditions and the following disclaimer in the 13 | ;; documentation and/or other materials provided with the distribution. 14 | ;; 15 | ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) ``AS IS'' AND ANY EXPRESS OR 16 | ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | ;; IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | (in-package :clingon.test) 27 | 28 | (defun foo/options () 29 | "Creates some sample options" 30 | (list 31 | (clingon:make-option :boolean/true 32 | :short-name #\a 33 | :long-name "a-option" 34 | :description "option a" 35 | :key :a) 36 | (clingon:make-option :boolean/true 37 | :short-name #\b 38 | :long-name "b-option" 39 | :description "option b" 40 | :key :b) 41 | (clingon:make-option :boolean/true 42 | :long-name "lonely-long-option" 43 | :description "no short option defined here" 44 | :key :x) 45 | (clingon:make-option :boolean/true 46 | :hidden t 47 | :long-name "hidden-option" 48 | :description "a hidden option" 49 | :key :hidden-flag))) 50 | 51 | (defun foo/command () 52 | "A sample command with options" 53 | (clingon:make-command :name "foo" 54 | :description "foo command" 55 | :options (foo/options))) 56 | 57 | (defun make-duplicate-options () 58 | "Returns a list of options which contain duplicates" 59 | (list 60 | (clingon:make-option :generic 61 | :short-name #\a 62 | :description "option a" 63 | :key :a) 64 | (clingon:make-option :generic 65 | :short-name #\a ;; <- duplicate short option 66 | :description "option b" 67 | :key :b))) 68 | 69 | (deftest initialize-command-instance 70 | (testing "ensure parent is set" 71 | (let* ((child (clingon:make-command :name "child" 72 | :description "child command")) 73 | (parent (clingon:make-command :name "parent" 74 | :description "parent command" 75 | :sub-commands (list child)))) 76 | (ok (equal (clingon:command-parent child) parent) "parent command matches")))) 77 | 78 | (deftest initialize-command 79 | (testing "ensure command arguments are nil" 80 | (let ((c (clingon:make-command :name "foo" 81 | :description "foo command" 82 | :arguments '(1 2 3)))) 83 | (clingon:initialize-command c) 84 | (ok (equal (clingon:command-arguments c) nil) "free arguments are nil upon initialization")))) 85 | 86 | (deftest finalize-command 87 | (testing "args to parse are nil" 88 | (let ((c (clingon:make-command :name "foo" 89 | :description "foo command" 90 | :arguments '(1 2 3)))) 91 | (clingon:initialize-command c) 92 | (clingon:finalize-command c) 93 | (ok (equal (clingon.command:command-args-to-parse c) nil) "no more args to parse")))) 94 | 95 | (deftest find-option 96 | (testing "short option" 97 | (let ((c (foo/command))) 98 | (ok (clingon:find-option :short c #\a) "short option found"))) 99 | (testing "find long option" 100 | (let ((c (foo/command))) 101 | (ok (clingon:find-option :long c "b-option") "long option found"))) 102 | (testing "missing option" 103 | (let ((c (foo/command))) 104 | (ng (clingon:find-option :short c #\x) "missing short option") 105 | (ng (clingon:find-option :long c "missing-option") "missing long option")))) 106 | 107 | (deftest ensure-unique-options 108 | (testing "ensure no duplicates" 109 | (let ((c (clingon:make-command :name "foo" 110 | :description "command with duplicate options" 111 | :options (make-duplicate-options)))) 112 | (ok (signals (clingon:validate-top-level-command c) 'clingon:duplicate-options) 113 | "signals on duplicate options")))) 114 | 115 | (deftest ensure-unique-sub-commands 116 | (testing "ensure no duplicate sub commands" 117 | (let* ((foo (clingon:make-command :name "foo" :description "foo command")) 118 | (bar (clingon:make-command :name "foo" :description "bar command")) ;; <- duplicate name 119 | (top-level (clingon:make-command :name "top-level" 120 | :description "top-level command" 121 | :sub-commands (list foo bar)))) 122 | (ok (signals (clingon:validate-top-level-command top-level) 'clingon:duplicate-commands) 123 | "signals on duplicate sub-commands"))) 124 | 125 | (testing "ensure no duplicate sub commands with aliases" 126 | (let* ((foo (clingon:make-command :name "foo" :description "foo command" :aliases '("foo-1"))) 127 | (bar (clingon:make-command :name "bar" :description "bar command" :aliases '("bar-1" "foo-1"))) ;; <- duplicate alias 128 | (top-level (clingon:make-command :name "top-level" 129 | :description "top-level command" 130 | :sub-commands (list foo bar)))) 131 | (ok (signals (clingon:validate-top-level-command top-level) 'clingon:duplicate-commands) 132 | "signals on duplicate sub-commands aliases")))) 133 | 134 | (deftest command-relationships 135 | (testing "verify command lineage" 136 | (let* ((c3 (clingon:make-command :name "c3" 137 | :description "c3 command")) 138 | (c2 (clingon:make-command :name "c2" 139 | :description "c2 command" 140 | :sub-commands (list c3))) 141 | (c1 (clingon:make-command :name "c1" 142 | :description "c1 command" 143 | :sub-commands (list c2))) 144 | (top-level (clingon:make-command :name "top-level" 145 | :description "top-level command" 146 | :sub-commands (list c1)))) 147 | (let ((lineage (clingon:command-lineage c3))) 148 | (ok (equal (list c3 c2 c1 top-level) lineage) "lineage matches") 149 | (ok (equal t (clingon:command-is-top-level-p top-level)) 150 | "top-level command matches") 151 | (ok (equal nil (clingon:command-is-top-level-p c1)) 152 | "c1 is not a top-level command") 153 | (ok (equal nil (clingon:command-is-top-level-p c2)) 154 | "c2 is not a top-level command") 155 | (ok (equal nil (clingon:command-is-top-level-p c3)) 156 | "c3 is not a top-level command")))) 157 | 158 | (testing "circular dependencies" 159 | (let* ((c3 (clingon:make-command :name "c3" 160 | :description "c3 command")) 161 | (c2 (clingon:make-command :name "c2" 162 | :description "c2 command" 163 | :sub-commands (list c3))) 164 | (c1 (clingon:make-command :name "c1" 165 | :description "c1 command" 166 | :sub-commands (list c2))) 167 | (top-level (clingon:make-command :name "top-level" 168 | :description "top-level command" 169 | :sub-commands (list c1)))) 170 | ;; Create a circular dependency between top-level and c3 171 | (setf (clingon:command-parent top-level) c3) 172 | (ok (signals (clingon:command-lineage c3) 'clingon:circular-dependency) 173 | "signals on circular dependencies"))) 174 | 175 | (testing "verify full path to command" 176 | (let* ((c3 (clingon:make-command :name "c3" 177 | :description "c3 command")) 178 | (c2 (clingon:make-command :name "c2" 179 | :description "c2 command" 180 | :sub-commands (list c3))) 181 | (c1 (clingon:make-command :name "c1" 182 | :description "c1 command" 183 | :sub-commands (list c2))) 184 | (top-level (clingon:make-command :name "top-level" 185 | :description "top-level command" 186 | :sub-commands (list c1))) 187 | (full-path (clingon:command-full-path c3))) 188 | (declare (ignore top-level)) 189 | (ok (equal '("top-level" "c1" "c2" "c3") full-path) 190 | "full path matches"))) 191 | 192 | (testing "find sub-commands" 193 | (let* ((foo (clingon:make-command :name "foo" 194 | :aliases '("foo-1" "foo-2") 195 | :description "foo command")) 196 | (bar (clingon:make-command :name "bar" 197 | :aliases '("bar-1" "bar-2") 198 | :description "bar command")) 199 | (top-level (clingon:make-command :name "top-level" 200 | :description "top-level command" 201 | :sub-commands (list foo bar)))) 202 | (ok (equal foo (clingon:find-sub-command top-level "foo")) 203 | "find existing command \"foo\"") 204 | (ok (equal foo (clingon:find-sub-command top-level "foo-1")) 205 | "find foo-1 alias") 206 | (ok (equal foo (clingon:find-sub-command top-level "foo-2")) 207 | "find foo-2 alias") 208 | (ok (equal bar (clingon:find-sub-command top-level "bar")) 209 | "find existing command \"bar\"") 210 | (ok (equal bar (clingon:find-sub-command top-level "bar-1")) 211 | "find bar-1 alias") 212 | (ok (equal bar (clingon:find-sub-command top-level "bar-2")) 213 | "find bar-2 alias") 214 | (ok (equal nil (clingon:find-sub-command top-level "INVALID")) 215 | "returns nil on missing command"))) 216 | 217 | (testing "walk commands tree" 218 | (let* ((c3 (clingon:make-command :name "c3" 219 | :description "c3 command")) 220 | (c2 (clingon:make-command :name "c2" 221 | :description "c2 command" 222 | :sub-commands (list c3))) 223 | (c1 (clingon:make-command :name "c1" 224 | :description "c1 command" 225 | :sub-commands (list c2))) 226 | (top-level (clingon:make-command :name "top-level" 227 | :description "top-level command" 228 | :sub-commands (list c1))) 229 | (result nil)) 230 | (clingon:with-command-tree (node top-level) 231 | (push node result)) 232 | (setf result (nreverse result)) 233 | (ok (equal '("top-level" "c1" "c2" "c3") (mapcar #'clingon:command-name result)) 234 | "walked nodes match")))) 235 | 236 | (deftest hidden-options 237 | (testing "test for hidden options" 238 | (let* ((c (foo/command)) 239 | (visible-opts (clingon:visible-options c))) 240 | (ok (equal nil (find "hidden-option" visible-opts :key #'clingon:option-long-name :test #'string=)) 241 | "hidden option is not present")))) 242 | 243 | (deftest parse-options 244 | (testing "consume all arguments" 245 | (let ((c (clingon:make-command :name "top-level" 246 | :description "sample top-level command" 247 | :args-to-parse (list "--" "foo" "bar" "baz" "qux")))) 248 | (clingon:initialize-command c) 249 | (clingon:parse-option :consume-all-arguments c) 250 | (clingon:finalize-command c) 251 | (ok (equal nil (clingon:command-args-to-parse c)) "args to parse is nil") 252 | (ok (equal '("foo" "bar" "baz" "qux") (clingon:command-arguments c)) 253 | "free arguments match"))) 254 | 255 | (testing "parse free arguments" 256 | (let ((c (clingon:make-command :name "top-level" 257 | :description "sample top-level command" 258 | :args-to-parse (list "foo" "bar" "baz")))) 259 | (clingon:initialize-command c) 260 | ;; Parse just two arguments 261 | (clingon:parse-option :free-argument c) 262 | (clingon:parse-option :free-argument c) 263 | 264 | (ok (equal '("baz") (clingon:command-args-to-parse c)) "remaining args to parse match") 265 | 266 | ;; After finalizing the command we don't have any remaining args to parse 267 | (clingon:finalize-command c) 268 | (ok (equal nil (clingon:command-args-to-parse c)) "no more args to parse") 269 | (ok (equal '("foo" "bar") (clingon:command-arguments c)) "free arguments match"))) 270 | 271 | (testing "parse short and long options" 272 | (let ((c (foo/command))) 273 | ;; Set some args to parse 274 | (setf (clingon:command-args-to-parse c) '("-a" "-b" "--a-option" "--b-option" "-X" "--invalid")) 275 | (clingon:initialize-command c) 276 | (ok (equal :true (clingon:parse-option :short c)) "parse -a flag") 277 | (ok (equal :true (clingon:parse-option :short c)) "parse -b flag") 278 | (ok (equal :true (clingon:parse-option :long c)) "parse --a-option flag") 279 | (ok (equal :true (clingon:parse-option :long c)) "parse --b-option flag") 280 | (ok (signals (clingon:parse-option :short c) 'clingon:unknown-option) 281 | "signals on first unknown -X option") 282 | (ok (signals (clingon:parse-option :short c) 'clingon:unknown-option) 283 | "signals on second unknown --invalid option") 284 | (clingon:finalize-command c))) 285 | 286 | (testing "parse options with restarts" 287 | (let ((c (clingon:make-command :name "foo" ;; <- no options defined for the command 288 | :description "foo with restarts" 289 | :args-to-parse '("-a" "--long" "-b")))) 290 | (clingon:initialize-command c) 291 | (handler-bind ((clingon:unknown-option #'clingon:treat-as-argument)) 292 | (clingon:parse-option :short c) 293 | (clingon:parse-option :long c) 294 | (clingon:parse-option :short c)) 295 | (clingon:finalize-command c) 296 | (ok (equal '("-a" "--long" "-b") (clingon:command-arguments c)) 297 | "treat unknowns as free arguments") 298 | 299 | ;; Re-initialize the command with different input 300 | (setf (clingon:command-args-to-parse c) '("-a" "--long" "-b")) 301 | (clingon:initialize-command c) 302 | (handler-bind ((clingon:unknown-option #'clingon:discard-option)) 303 | (clingon:parse-option :short c) 304 | (clingon:parse-option :long c) 305 | (clingon:parse-option :short c)) 306 | (clingon:finalize-command c) 307 | (ok (equal nil (clingon:command-arguments c)) "discard unknown options"))) 308 | 309 | (testing "parse required options" 310 | (let ((c (clingon:make-command :name "foo" 311 | :description "foo command" 312 | :options 313 | (list 314 | (clingon:make-option :string 315 | :short-name #\s 316 | :long-name "string" 317 | :description "required options" 318 | :required t 319 | :key :string))))) 320 | ;; Test short option parsing 321 | (setf (clingon:command-args-to-parse c) '("-s" "foo")) 322 | (clingon:initialize-command c) 323 | (clingon:parse-option :short c) 324 | (clingon:finalize-command c) 325 | (ok (string= "foo" (clingon:getopt c :string)) "short option value matches") 326 | 327 | ;; Test long option parsing 328 | (setf (clingon:command-args-to-parse c) '("--string" "bar")) 329 | (clingon:initialize-command c) 330 | (clingon:parse-option :long c) 331 | (clingon:finalize-command c) 332 | (ok (string= "bar" (clingon:getopt c :string)) "long option value matches") 333 | 334 | ;; Test with missing optarg for short option 335 | (setf (clingon:command-args-to-parse c) '("-s")) 336 | (clingon:initialize-command c) 337 | (ok (signals (clingon:parse-option :short c) 'clingon:missing-option-argument) 338 | "signals on missing option argument (short option)") 339 | (clingon:finalize-command c) 340 | 341 | ;; Test with missing optarg for long option 342 | (setf (clingon:command-args-to-parse c) '("--string")) 343 | (clingon:initialize-command c) 344 | (ok (signals (clingon:parse-option :long c) 'clingon:missing-option-argument) 345 | "signals on missing option argument (long option) #1") 346 | (clingon:finalize-command c) 347 | 348 | ;; Test with missing optarg for long option 349 | (setf (clingon:command-args-to-parse c) '("--string=")) 350 | (clingon:initialize-command c) 351 | (ok (signals (clingon:parse-option :long c) 'clingon:missing-option-argument) 352 | "signals on missing option argument (long option) #2") 353 | (clingon:finalize-command c)))) 354 | 355 | (defun status/options () 356 | "Creates the options for the sample `status' command" 357 | (list 358 | (clingon:make-option :boolean 359 | :description "real-time updates" 360 | :short-name #\r 361 | :long-name "real-time" 362 | :required t 363 | :key :real-time) 364 | (clingon:make-option :string 365 | :description "same option defined in all commands" 366 | :long-name "same-opt" 367 | :key :same-opt))) 368 | 369 | (defun status/command () 370 | "Creates the sample `status' command" 371 | (clingon:make-command :name "status" 372 | :description "status information" 373 | :options (status/options))) 374 | 375 | (defun display/options () 376 | "Returns the options for the sample `display' sub-command" 377 | ;; An option that acts as a switch 378 | (list 379 | (clingon:make-option :boolean/true 380 | :description "enable progress reporting" 381 | :short-name #\p 382 | :long-name "progress" 383 | :key :progress) 384 | (clingon:make-option :boolean/false 385 | :description "disable progress reporting" 386 | :short-name #\P 387 | :long-name "no-progress" 388 | :key :progress) 389 | (clingon:make-option :string 390 | :description "same option defined in all commands" 391 | :long-name "same-opt" 392 | :key :same-opt))) 393 | 394 | (defun display/command () 395 | "Creates a sample `display' command" 396 | (clingon:make-command :name "display" 397 | :description "displays something funny" 398 | :options (display/options) 399 | :sub-commands (list (status/command)))) 400 | 401 | (defun top-level/options () 402 | "Returns the top-level command options" 403 | (list 404 | (clingon:make-option :counter 405 | :description "how noisy we want to be" 406 | :short-name #\v 407 | :long-name "verbose" 408 | :key :verbose) 409 | (clingon:make-option :string 410 | :description "same option defined in all commands" 411 | :long-name "same-opt" 412 | :key :same-opt) 413 | (clingon:make-option :string 414 | :description "example persistent option" 415 | :long-name "persistent-opt" 416 | :persistent t 417 | :key :persistent-opt))) 418 | 419 | 420 | (defun top-level/command () 421 | "Our sample top-level command. 422 | The command we build here has the following usage spec: 423 | 424 | $ top-level [-v] [--same-opt=] [display [--no|progress] [--same-opt=] [status --real-time=[false|true] [--same-opt=]]]" 425 | (clingon:make-command :name "top-level" 426 | :description "top-level command" 427 | :options (top-level/options) 428 | :sub-commands (list (display/command)))) 429 | 430 | (deftest parse-command-line 431 | (testing "test with no arguments" 432 | (let* ((top-level (top-level/command)) 433 | (c (clingon:parse-command-line top-level nil))) 434 | (ok (string= "top-level" (clingon:command-name c)) "matches the top-level command") 435 | (ok (= 0 (clingon:getopt c :verbose)) "verbose is 0"))) 436 | 437 | (testing "test GETOPT with default values" 438 | (let* ((top-level (top-level/command)) 439 | (c (clingon:parse-command-line top-level nil))) 440 | (ok (string= "default-value" (clingon:getopt c :unknown-opt "default-value")) 441 | "default value matches"))) 442 | 443 | (testing "test GETOPT for most-specific command (opt is defined and is set)" 444 | (let* ((top-level (top-level/command)) 445 | (c (clingon:parse-command-line top-level '("--same-opt=global-val" "display" "--same-opt=display-val" "status" "--real-time=false" "--same-opt=status-val")))) 446 | (ok (string= "status-val" (clingon:getopt c :same-opt)) 447 | "most-specific option value matches"))) 448 | 449 | (testing "test GETOPT for most-specific command (opt is defined, but is not set)" 450 | (let* ((top-level (top-level/command)) 451 | (c (clingon:parse-command-line top-level '("--same-opt=global-val" "display" "--same-opt=display-val" "status" "--real-time=false")))) 452 | (ok (equal nil (clingon:getopt c :same-opt)) 453 | "most-specific option value matches") 454 | (ok (string= "default-val" (clingon:getopt c :same-opt "default-val")) 455 | "most-specific option returns default value"))) 456 | 457 | (testing "test GETOPT* (most-specific command option is defined, but is not set)" 458 | (let* ((top-level (top-level/command)) 459 | (c (clingon:parse-command-line top-level '("--same-opt=global-val" "display" "--same-opt=display-val" "status" "--real-time=false")))) 460 | (ok (string= "display-val" (clingon:getopt* c :same-opt)) 461 | "matches first parent command for which the option is defined and is set"))) 462 | 463 | (testing "top-level command with global flag" 464 | (let* ((top-level (top-level/command)) 465 | (c (clingon:parse-command-line top-level '("-vvv" "--verbose")))) 466 | (ok (string= "top-level" (clingon:command-name c)) "matches the top-level command") 467 | (ok (= 4 (clingon:getopt c :verbose)) "verbose is 4"))) 468 | 469 | (testing "top-level command with free arguments" 470 | (let* ((top-level (top-level/command)) 471 | (c (clingon:parse-command-line top-level '("-v" "foo" "bar" "baz")))) 472 | (ok (string= "top-level" (clingon:command-name c)) "matches the top-level command") 473 | (ok (= 1 (clingon:getopt c :verbose)) "verbose is 4") 474 | (ok (equal '("foo" "bar" "baz") (clingon:command-arguments c)) "free arguments match"))) 475 | 476 | (testing "top-level command with free args matching sub-command name" 477 | (let* ((top-level (top-level/command)) 478 | (c (clingon:parse-command-line top-level '("-v" "--" "display" "status" "-a" "-b" "-c")))) 479 | (ok (string= "top-level" (clingon:command-name c)) "matches the top-level command") 480 | (ok (= 1 (clingon:getopt c :verbose)) "verbose is 4") 481 | (ok (equal '("display" "status" "-a" "-b" "-c") (clingon:command-arguments c)) "free arguments match"))) 482 | 483 | (testing "first level sub-command" 484 | (let* ((top-level (top-level/command)) 485 | (c (clingon:parse-command-line top-level '("-vvv" "display" "--progress" "a" "b" "c")))) 486 | (ok (string= "display" (clingon:command-name c)) "matches first sub-command name") 487 | (ok (equal '("top-level" "display") (clingon:command-full-path c)) "command full path matches") 488 | (ok (= 3 (clingon:getopt c :verbose)) "global verbose option is 3") 489 | (ok (equal t (clingon:getopt c :progress)) "flag --progress is set") 490 | (ok (equal '("a" "b" "c") (clingon:command-arguments c)) "free arguments match"))) 491 | 492 | (testing "first level sub-command option being switched on/off" 493 | (let* ((top-level (top-level/command)) 494 | (c (clingon:parse-command-line top-level '("display" "--progress" "--no-progress")))) 495 | (ok (string= "display" (clingon:command-name c)) "matches first sub-command name") 496 | (ok (equal '("top-level" "display") (clingon:command-full-path c)) "command full path matches") 497 | (ok (equal t (clingon:opt-is-set-p c :progress)) "the --progress|--no-progress flag was set") 498 | (ok (equal nil (clingon:getopt c :progress)) "flag --progress is set to nil"))) 499 | 500 | (testing "second level sub-command with missing required option" 501 | (let ((top-level (top-level/command))) 502 | (ok (signals (clingon:parse-command-line top-level '("display" "status")) 'clingon:missing-required-option-value) 503 | "signals on missing required option value"))) 504 | 505 | (testing "second level sub-command with option set" 506 | (let* ((top-level (top-level/command)) 507 | (c (clingon:parse-command-line top-level 508 | '("-vvv" "display" "--progress" "status" "--real-time=false")))) 509 | (ok (string= "status" (clingon:command-name c)) "matches second sub-command name") 510 | (ok (equal '("top-level" "display" "status") (clingon:command-full-path c)) "command full path matches") 511 | (ok (= 3 (clingon:getopt c :verbose)) "global verbose flag is 3") 512 | (ok (equal t (clingon:opt-is-set-p c :progress)) "flag --progress is set") 513 | (ok (equal t (clingon:getopt c :progress)) "flag --progress is set to t") 514 | (ok (equal t (clingon:opt-is-set-p c :real-time)) "flag --real-time is set") 515 | (ok (equal nil (clingon:getopt c :real-time)) "flag --real-time value is nil"))) 516 | 517 | (testing "second level sub-command with free arguments" 518 | (let* ((top-level (top-level/command)) 519 | (c (clingon:parse-command-line top-level 520 | '("display" "status" "--real-time=true" "a" "b" "c")))) 521 | (ok (string= "status" (clingon:command-name c)) "matches second sub-command name") 522 | (ok (equal '("top-level" "display" "status") (clingon:command-full-path c)) "command full path matches") 523 | (ok (= 0 (clingon:getopt c :verbose)) "global verbose flag is 0") 524 | (ok (equal nil (clingon:opt-is-set-p c :progress)) "flag --progress is not set") 525 | (ok (equal t (clingon:opt-is-set-p c :real-time)) "flag --real-time is set") 526 | (ok (equal t (clingon:getopt c :real-time)) "flag --real-time value is t") 527 | (ok (equal '("a" "b" "c") (clingon:command-arguments c)) "free arguments match"))) 528 | 529 | (testing "test persistent option" 530 | (let ((top-level (top-level/command))) 531 | (let ((c (clingon:parse-command-line top-level '("--persistent-opt=foo")))) 532 | (ok (string= "foo" (clingon:getopt c :persistent-opt)) 533 | "value matches for top-level command")) 534 | 535 | (let ((c (clingon:parse-command-line top-level '("--persistent-opt=foo" "display" "--persistent-opt=bar")))) 536 | (ok (string= "bar" (clingon:getopt c :persistent-opt)) 537 | "value matches for first sub-command")) 538 | 539 | (let ((c (clingon:parse-command-line top-level '("--persistent-opt=foo" "display")))) 540 | (ok (equal nil (clingon:getopt c :persistent-opt)) 541 | "value matches for first sub-command (option is not set)") 542 | (ok (string= "foo" (clingon:getopt* c :persistent-opt)) 543 | "value matches for top-level (option is not set for sub-command)")) 544 | 545 | (let ((c (clingon:parse-command-line top-level '("--persistent-opt=foo" "display" "--persistent-opt=bar" "status" "--real-time=false" "--persistent-opt=baz")))) 546 | (ok (string= "baz" (clingon:getopt c :persistent-opt)) 547 | "value matches for last sub-command (option is set)")) 548 | 549 | (let ((c (clingon:parse-command-line top-level '("--persistent-opt=foo" "display" "--persistent-opt=bar" "status" "--real-time=false")))) 550 | (ok (equal nil (clingon:getopt c :persistent-opt)) 551 | "value matches for sub-command (option is not set)") 552 | (ok (string= "bar" (clingon:getopt* c :persistent-opt)) 553 | "value matches for parent command"))))) 554 | --------------------------------------------------------------------------------