├── .gitignore
├── .gitattributes
├── shell.nix
├── tests
    ├── effects.t
    ├── usage-errors.t
    ├── optional.t
    ├── scaffold
    ├── compiled.t
    ├── meta.t
    ├── docstring.t
    ├── escapes.t
    ├── choice.t
    ├── group.t
    ├── types.t
    ├── positional.t
    ├── basic.t
    ├── spec-errors.t
    └── help.t
├── project.janet
├── LICENSE
├── src
    ├── util.janet
    ├── bridge.janet
    ├── init.janet
    ├── help.janet
    ├── arg-parser.janet
    └── param-parser.janet
└── README.md


/.gitignore:
--------------------------------------------------------------------------------
1 | diary.md
2 | 


--------------------------------------------------------------------------------
/.gitattributes:
--------------------------------------------------------------------------------
1 | *.t linguist-documentation
2 | 


--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
1 | with import <nixpkgs> {}; mkShell {
2 |   nativeBuildInputs = [ python310Packages.cram ];
3 | }
4 | 


--------------------------------------------------------------------------------
/tests/effects.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Effects:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/def
 7 |   >   --version (effect (fn [] (print "VERSION") (os/exit 0))))
 8 |   > (print "program")
 9 |   > EOF
10 | 
11 |   $ run
12 |   program
13 |   $ run --version
14 |   VERSION
15 | 


--------------------------------------------------------------------------------
/project.janet:
--------------------------------------------------------------------------------
 1 | (declare-project
 2 |   :name "cmd"
 3 |   :description "Command-line argument parser"
 4 |   :author "Ian Henry"
 5 |   :license "MIT"
 6 |   :url "https://github.com/ianthehenry/cmd"
 7 |   :repo "git+https://github.com/ianthehenry/cmd")
 8 | 
 9 | (declare-source
10 |   :prefix "cmd"
11 |   :source
12 |     ["src/arg-parser.janet"
13 |       "src/bridge.janet"
14 |       "src/help.janet"
15 |       "src/init.janet"
16 |       "src/param-parser.janet"
17 |       "src/util.janet"])
18 | 


--------------------------------------------------------------------------------
/tests/usage-errors.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Multiple errors:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/def
 7 |   >   --arg :number
 8 |   >   --bar :number)
 9 |   > (pp arg)
10 |   > EOF
11 | 
12 |   $ run
13 |   ! --bar: missing required argument
14 |   ! --arg: missing required argument
15 |   [1]
16 |   $ run --arg
17 |   ! --bar: missing required argument
18 |   ! --arg: no value for argument
19 |   [1]
20 |   $ run --arg foo
21 |   ! --bar: missing required argument
22 |   ! --arg: foo is not a number
23 |   [1]
24 | 


--------------------------------------------------------------------------------
/tests/optional.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Default value for optional flags is nil:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/def "doc"
 7 |   >   --arg (optional :string))
 8 |   > (pp arg)
 9 |   > EOF
10 | 
11 |   $ run
12 |   nil
13 |   $ run --arg
14 |   ! --arg: no value for argument
15 |   [1]
16 |   $ run --arg foo
17 |   "foo"
18 | 
19 | You can specify a custom default:
20 | 
21 |   $ use <<EOF
22 |   > (cmd/def "doc"
23 |   >   --arg (optional :string "foo"))
24 |   > (pp arg)
25 |   > EOF
26 | 
27 |   $ run
28 |   "foo"
29 |   $ run --arg
30 |   ! --arg: no value for argument
31 |   [1]
32 |   $ run --arg foo
33 |   "foo"
34 | 


--------------------------------------------------------------------------------
/tests/scaffold:
--------------------------------------------------------------------------------
 1 | set -uo pipefail
 2 | SOURCE=script.janet
 3 | 
 4 | use() {
 5 |  (echo "(import src :as cmd)"; cat) > "$SOURCE"
 6 | }
 7 | 
 8 | run() {
 9 |   if [[ ! -e "$SOURCE" ]]; then
10 |     echo "must call use before run"
11 |     exit 1
12 |   fi
13 |   root=$(dirname $TESTDIR)
14 |   # cram doesn't differentiate stderr and stdout, but
15 |   # it's important to test
16 |   janet -m "$root" "$SOURCE" "$@" 3>&1 1>&2 2>&3 3>&- \
17 |     | sed -e 's/^/! /' \
18 |     | sed -E -e "s|$root|\$root|g" #\
19 |     #| sed -E -e 's/on line [0-9]+, column [0-9]+/on line LINE, column COL/g'
20 | }
21 | 
22 | run_err() {
23 |   run "$@" | head -n1
24 | }
25 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright (c) 2023 Ian Henry
2 | 
3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
4 | 
5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
6 | 
7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
8 | 


--------------------------------------------------------------------------------
/tests/compiled.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 |   $ cat >project.janet <<EOF
 4 |   > (declare-project
 5 |   >   :name "hello")
 6 |   > (declare-executable
 7 |   >   :name "hello"
 8 |   >   :entry "main.janet")
 9 |   > EOF
10 | 
11 |   $ cat >main.janet <<EOF
12 |   > #!/usr/bin/env janet
13 |   > (import cmd)
14 |   > (cmd/main (cmd/fn [--name :string]
15 |   >   (print "Hello, " name "!")))
16 |   > EOF
17 |   $ mkdir -p jpm_tree/lib
18 |   $ ln -s $TESTDIR/../src jpm_tree/lib/cmd
19 | 
20 | As a normal script:
21 | 
22 |   $ jpm -l janet main.janet --name tester
23 |   Hello, tester!
24 |   $ jpm -l janet main.janet --help tester
25 |     main.janet
26 |   
27 |   === flags ===
28 |   
29 |     [--help]      : Print this help text and exit
30 |     --name STRING
31 | 
32 | As a shebanged script:
33 |   $ chmod +x main.janet
34 |   $ JANET_PATH=jpm_tree/lib ./main.janet --name tester
35 |   Hello, tester!
36 |   $ JANET_PATH=jpm_tree/lib ./main.janet --help
37 |     main.janet
38 |   
39 |   === flags ===
40 |   
41 |     [--help]      : Print this help text and exit
42 |     --name STRING
43 | 
44 | As a compiled executable:
45 | 
46 |   $ jpm -l build >/dev/null 2>/dev/null
47 |   $ build/hello --name tester
48 |   Hello, tester!
49 |   $ build/hello --help
50 |     hello
51 |   
52 |   === flags ===
53 |   
54 |     [--help]      : Print this help text and exit
55 |     --name STRING
56 | 


--------------------------------------------------------------------------------
/tests/meta.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Cmd shouldn't export too many symbols:
 4 | 
 5 |   $ use <<<'(loop [[sym val] :pairs (curenv) :when (symbol? sym)] (pp sym))'
 6 |   $ run
 7 |   cmd/defgroup
 8 |   cmd/group
 9 |   cmd/def
10 |   cmd/fn
11 |   cmd/parse
12 |   cmd/peg
13 |   cmd/defn
14 |   cmd/print-help
15 |   cmd/main
16 |   cmd/spec
17 |   cmd/args
18 |   cmd/run
19 | 
20 | cmd/spec and cmd/parse:
21 | 
22 |   $ use <<EOF
23 |   > (def spec (cmd/spec
24 |   >   foo :string
25 |   >   --bar (optional string)))
26 |   > (pp (cmd/parse spec ["hello"]))
27 |   > (pp (cmd/parse spec ["hello" "--bar" "world"]))
28 |   > EOF
29 |   $ run
30 |   @{:foo "hello"}
31 |   @{:bar "world" :foo "hello"}
32 | 
33 | cmd/parse raises errors:
34 | 
35 |   $ use <<EOF
36 |   > (def spec (cmd/spec
37 |   >   foo :number))
38 |   > (try (cmd/parse spec ["hello"])
39 |   >   ([e fib]
40 |   >     (print "parse error:")
41 |   >     (pp e)))
42 |   > EOF
43 |   $ run
44 |   parse error:
45 |   @{foo @["hello is not a number" "missing required argument"]}
46 | 
47 | cmd/args:
48 | 
49 |   $ use <<EOF
50 |   > (pp (cmd/args))
51 |   > EOF
52 |   $ run hello
53 |   @["hello"]
54 |   $ run --foo=bar
55 |   @["--foo" "bar"]
56 |   $ run --foo=bar=baz
57 |   @["--foo" "bar=baz"]
58 |   $ run -xyz
59 |   @["-x" "-y" "-z"]
60 |   $ run -xyz=foo
61 |   @["-x" "-y" "-z" "foo"]
62 |   $ run -x-yz
63 |   @["-x-yz"]
64 |   $ run "--x yz=foo"
65 |   @["--x yz=foo"]
66 |   $ run "-x y"
67 |   @["-x y"]
68 |   $ run --foo=-xyz
69 |   @["--foo" "-xyz"]
70 | 
71 | cmd/print-help:
72 | 
73 |   $ use <<EOF
74 |   > (cmd/print-help (cmd/spec --arg :string))
75 |   > EOF
76 |   $ run
77 |     script.janet
78 |   
79 |   === flags ===
80 |   
81 |     [--help]     : Print this help text and exit
82 |     --arg STRING
83 | 


--------------------------------------------------------------------------------
/tests/docstring.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Docstrings can be dynamic expressions in def:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/def (string/format "hi %s" "there")
 7 |   >   foo :string)
 8 |   > (pp foo)
 9 |   > EOF
10 | 
11 |   $ run --help
12 |   hi there
13 |   
14 |     script.janet STRING
15 |   
16 |   === flags ===
17 |   
18 |     [--help] : Print this help text and exit
19 | 
20 | Docstrings can be dynamic expressions in fn:
21 | 
22 |   $ use <<EOF
23 |   > (cmd/main (cmd/fn (string/format "hi %s" "there")
24 |   >   [foo :string]))
25 |   > EOF
26 | 
27 |   $ run --help
28 |   hi there
29 |   
30 |     script.janet STRING
31 |   
32 |   === flags ===
33 |   
34 |     [--help] : Print this help text and exit
35 | 
36 | Docstrings can be dynamic expressions in defn:
37 | 
38 |   $ use <<EOF
39 |   > (cmd/defn cmd (string/format "hi %s" "there")
40 |   >   [foo :string])
41 |   > (cmd/main cmd)
42 |   > EOF
43 | 
44 |   $ run --help
45 |   hi there
46 |   
47 |     script.janet STRING
48 |   
49 |   === flags ===
50 |   
51 |     [--help] : Print this help text and exit
52 | 
53 | Docstrings can be dynamic expressions in group:
54 | 
55 |   $ use <<EOF
56 |   > (cmd/main (cmd/group (string/format "hi %s" "there")
57 |   >   foo (cmd/fn "description" [])))
58 |   > EOF
59 | 
60 |   $ run --help
61 |   hi there
62 |   
63 |     foo  - description
64 |     help - explain a subcommand
65 |   ! unknown subcommand --help
66 |   [1]
67 | 
68 | Docstrings can be dynamic expressions in defgroup:
69 | 
70 |   $ use <<EOF
71 |   > (cmd/defgroup cmd (string/format "hi %s" "there")
72 |   >   foo (cmd/fn "description" []))
73 |   > (cmd/main cmd)
74 |   > EOF
75 | 
76 |   $ run --help
77 |   hi there
78 |   
79 |     foo  - description
80 |     help - explain a subcommand
81 |   ! unknown subcommand --help
82 |   [1]
83 | 


--------------------------------------------------------------------------------
/tests/escapes.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Soft escapes cause all arguments to be parsed positionally:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/def
 7 |   >   --arg (optional :string)
 8 |   >   name :string
 9 |   >   -- (escape))
10 |   > (pp [arg name])
11 |   > EOF
12 | 
13 |   $ run -- --arg
14 |   (nil "--arg")
15 | 
16 | Soft escapes do not create a binding:
17 | 
18 |   $ use <<EOF
19 |   > (cmd/def
20 |   >   --foo (escape))
21 |   > (pp foo)
22 |   > EOF
23 |   $ run_err
24 |   ! script.janet:4:1: compile error: unknown symbol foo
25 |   [1]
26 | 
27 | # TODO: this should probably be an error?
28 | Renamed soft escape are ignored:
29 | 
30 |   $ use <<EOF
31 |   > (cmd/def
32 |   >   foo :string
33 |   >   [foo --bar] (escape))
34 |   > (pp foo)
35 |   > EOF
36 |   $ run hello --bar
37 |   "hello"
38 | 
39 | You can have multiple soft escapes:
40 | 
41 |   $ use <<EOF
42 |   > (cmd/def
43 |   >   --arg (optional :string)
44 |   >   name :string
45 |   >   --foo (escape)
46 |   >   --bar (escape))
47 |   > (pp [arg name])
48 |   > EOF
49 |   $ run --foo --arg
50 |   (nil "--arg")
51 |   $ run --bar --arg
52 |   (nil "--arg")
53 | 
54 | Hard escapes stop all subsequent command-line handling:
55 | 
56 |   $ use <<EOF
57 |   > (cmd/def
58 |   >   foo (optional :string)
59 |   >   --arg (optional :string)
60 |   >   --esc (escape :string))
61 |   > (pp [foo arg esc])
62 |   > EOF
63 |   $ run --esc --arg hello
64 |   (nil nil ("--arg" "hello"))
65 |   $ run --arg hello --esc --arg hello
66 |   (nil "hello" ("--arg" "hello"))
67 |   $ run foo --arg hello --esc --arg hello
68 |   ("foo" "hello" ("--arg" "hello"))
69 | 
70 | Anonymous hard escapes:
71 | 
72 |   $ use <<EOF
73 |   > (cmd/def
74 |   >   foo (optional :string)
75 |   >   --arg (optional :string)
76 |   >   esc (escape :string))
77 |   > (pp [foo arg esc])
78 |   > EOF
79 |   $ run
80 |   (nil nil ())
81 |   $ run foo
82 |   ("foo" nil ())
83 |   $ run foo bar
84 |   ("foo" nil ("bar"))
85 |   $ run foo bar --arg hello
86 |   ("foo" nil ("bar" "--arg" "hello"))
87 |   $ run --arg hello foo bar --arg hello
88 |   ("foo" "hello" ("bar" "--arg" "hello"))
89 |   $ run foo --arg hello bar --arg hello
90 |   ("foo" "hello" ("bar" "--arg" "hello"))
91 | 


--------------------------------------------------------------------------------
/tests/choice.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | Structs can be used as enums:
  4 | 
  5 |   $ use <<EOF
  6 |   > (cmd/def "doc"
  7 |   >   choice {--foo 1 --bar 2})
  8 |   > (pp choice)
  9 |   > EOF
 10 | 
 11 |   $ run
 12 |   ! --bar/--foo: missing required argument
 13 |   [1]
 14 |   $ run --foo
 15 |   1
 16 |   $ run --bar
 17 |   2
 18 |   $ run --foo --foo
 19 |   ! --foo: duplicate argument
 20 |   [1]
 21 |   $ run --foo --bar
 22 |   ! --bar: duplicate argument
 23 |   [1]
 24 | 
 25 | Tables can be used as enums with values:
 26 | 
 27 |   $ use <<EOF
 28 |   > (cmd/def "doc"
 29 |   >   choice @{--foo :string --bar :string})
 30 |   > (pp choice)
 31 |   > EOF
 32 | 
 33 |   $ run
 34 |   ! --bar/--foo: missing required argument
 35 |   [1]
 36 |   $ run --foo
 37 |   ! --bar/--foo: missing required argument
 38 |   ! --foo: no value for argument
 39 |   [1]
 40 |   $ run --foo hi
 41 |   (:foo "hi")
 42 |   $ run --bar bye
 43 |   (:bar "bye")
 44 |   $ run --foo hi --foo bye
 45 |   ! --foo: duplicate argument
 46 |   [1]
 47 |   $ run --foo hi --bar bye
 48 |   ! --bar: duplicate argument
 49 |   [1]
 50 | 
 51 | Variant tags:
 52 | 
 53 |   $ use <<EOF
 54 |   > (cmd/def "doc"
 55 |   >   choice @{--foo [:x :string] --bar [:y :string]})
 56 |   > (pp choice)
 57 |   > EOF
 58 | 
 59 |   $ run --foo hi
 60 |   (:x "hi")
 61 |   $ run --bar bye
 62 |   (:y "bye")
 63 | 
 64 | Dynamic tags:
 65 | 
 66 |   $ use <<EOF
 67 |   > (def x (+ 1 2))
 68 |   > (cmd/def "doc"
 69 |   >   choice @{--foo [x :string] --bar [:y :string]})
 70 |   > (pp choice)
 71 |   > EOF
 72 | 
 73 |   $ run --foo hi
 74 |   (3 "hi")
 75 | 
 76 | Aliases within structs:
 77 | 
 78 |   $ use <<EOF
 79 |   > (cmd/def "doc"
 80 |   >   choice (required {[--foo -f] 1 --bar 2}))
 81 |   > (pp choice)
 82 |   > EOF
 83 | 
 84 |   $ run
 85 |   ! --bar/--foo/-f: missing required argument
 86 |   [1]
 87 |   $ run --foo
 88 |   1
 89 |   $ run -f
 90 |   1
 91 | 
 92 | Toggle:
 93 | 
 94 |   $ use <<EOF
 95 |   > (cmd/def "doc"
 96 |   >   choice (last {--foo true --no-foo false} true))
 97 |   > (pp choice)
 98 |   > EOF
 99 | 
100 |   $ run
101 |   true
102 |   $ run --no-foo
103 |   false
104 |   $ run --foo
105 |   true
106 |   $ run --foo --no-foo
107 |   false
108 | 


--------------------------------------------------------------------------------
/tests/group.t:
--------------------------------------------------------------------------------
 1 |   $ source $TESTDIR/scaffold
 2 | 
 3 | Basic group:
 4 | 
 5 |   $ use <<EOF
 6 |   > (cmd/defgroup something
 7 |   >   foo (cmd/fn ["what foo does" args (escape :string)] (printf "foo called %q" args))
 8 |   >   bar (cmd/fn "what bar does" [args (escape :string)] (printf "bar called %q" args)))
 9 |   > (cmd/run something (cmd/args))
10 |   > EOF
11 | 
12 |   $ run
13 |     bar  - what bar does
14 |     foo  - what foo does
15 |     help - explain a subcommand
16 |   [1]
17 | 
18 |   $ run foo bar
19 |   foo called ("bar")
20 |   $ run bar some arguments
21 |   bar called ("some" "arguments")
22 |   $ run baz
23 |     bar  - what bar does
24 |     foo  - what foo does
25 |     help - explain a subcommand
26 |   ! unknown subcommand baz
27 |   [1]
28 | 
29 | Combining groups and functions:
30 | 
31 |   $ use <<EOF
32 |   > (cmd/defgroup something
33 |   >   foo (cmd/fn [--flag (flag)] (printf "foo called with %q" flag)))
34 |   > (cmd/run something (cmd/args))
35 |   > EOF
36 | 
37 |   $ run
38 |     foo
39 |     help - explain a subcommand
40 |   [1]
41 | 
42 |   $ run foo
43 |   foo called with false
44 | 
45 |   $ run foo --flag
46 |   foo called with true
47 | 
48 | Nesting groups:
49 | 
50 |   $ use <<EOF
51 |   > (cmd/defgroup something
52 |   >   advanced (cmd/group foo (cmd/fn [--arg :string] (print arg))
53 |   >                       bar (cmd/fn [--other :string] (print other)))
54 |   >   simple (cmd/fn [--easy :string] (print easy)))
55 |   > (cmd/run something (cmd/args))
56 |   > EOF
57 | 
58 |   $ run simple
59 |   ! --easy: missing required argument
60 |   [1]
61 |   $ run simple --easy hello
62 |   hello
63 | 
64 |   $ run advanced
65 |     bar
66 |     foo
67 |     help - explain a subcommand
68 |   [1]
69 |   $ run advanced foo
70 |   ! --arg: missing required argument
71 |   [1]
72 |   $ run advanced foo --arg hi
73 |   hi
74 |   $ run advanced bar --other bye
75 |   bye
76 | 
77 | Groups only show the summary line:
78 | 
79 |   $ use <<EOF
80 |   > (cmd/defgroup something
81 |   >   foo (cmd/fn "this is a long string\n\nhere are the details" [--arg :string] (print arg))
82 |   >   bar (cmd/fn "only a summary line" [--easy :string] (print easy)))
83 |   > (cmd/run something (cmd/args))
84 |   > EOF
85 | 
86 |   $ run
87 |     bar  - only a summary line
88 |     foo  - this is a long string
89 |     help - explain a subcommand
90 |   [1]
91 | 


--------------------------------------------------------------------------------
/tests/types.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | cmd/peg:
  4 | 
  5 |   $ use <<EOF
  6 |   > (def a "a")
  7 |   > (cmd/def "doc"
  8 |   >   --arg (required (cmd/peg "ab" ~(<- (* ,a "b")))))
  9 |   > (pp arg)
 10 |   > EOF
 11 | 
 12 |   $ run
 13 |   ! --arg: missing required argument
 14 |   [1]
 15 |   $ run --arg ab
 16 |   "ab"
 17 |   $ run --arg abc
 18 |   "ab"
 19 |   $ run --arg ba
 20 |   ! --arg: unable to parse "ba"
 21 |   [1]
 22 | 
 23 | cmd/peg works with precompiled pegs:
 24 | 
 25 |   $ use <<EOF
 26 |   > (def peg (peg/compile ~(<- "x")))
 27 |   > (cmd/def "doc"
 28 |   >   --arg (required (cmd/peg "<x>" peg)))
 29 |   > (pp arg)
 30 |   > EOF
 31 | 
 32 |   $ run --arg x
 33 |   "x"
 34 | 
 35 | Arbitrary functions:
 36 | 
 37 |   $ use <<EOF
 38 |   > (cmd/def "doc"
 39 |   >   --arg (required (fn [x] (string/ascii-upper x))))
 40 |   > (pp arg)
 41 |   > EOF
 42 |   $ run --arg hello
 43 |   "HELLO"
 44 | 
 45 | Number:
 46 | 
 47 |   $ use <<EOF
 48 |   > (cmd/def "doc"
 49 |   >   --arg :number)
 50 |   > (pp arg)
 51 |   > EOF
 52 |   $ run --arg 123
 53 |   123
 54 |   $ run --arg 123x
 55 |   ! --arg: 123x is not a number
 56 |   [1]
 57 | 
 58 | Int:
 59 | 
 60 |   $ use <<EOF
 61 |   > (cmd/def "doc"
 62 |   >   --int :int
 63 |   >   --non-neg :int+
 64 |   >   --pos :int++)
 65 |   > (pp [int non-neg pos])
 66 |   > EOF
 67 |   $ run --int 1 --non-neg 2 --pos 3
 68 |   (1 2 3)
 69 |   $ run --int -1 --non-neg 0 --pos 0
 70 |   ! --pos: 0 must not positive
 71 |   [1]
 72 |   $ run --int -1 --non-neg 0 --pos 1
 73 |   (-1 0 1)
 74 |   $ run --int x --non-neg 0 --pos 1
 75 |   ! --int: x is not a number
 76 |   [1]
 77 | 
 78 | File:
 79 | 
 80 |   $ use <<EOF
 81 |   > (cmd/def "doc"
 82 |   >   --arg :file)
 83 |   > (pp arg)
 84 |   > EOF
 85 |   $ run --help
 86 |   doc
 87 |   
 88 |     script.janet
 89 |   
 90 |   === flags ===
 91 |   
 92 |     [--help]   : Print this help text and exit
 93 |     --arg FILE
 94 |   $ run --arg filename
 95 |   "filename"
 96 | 
 97 | Custom renamed peg:
 98 | 
 99 |   $ use <<EOF
100 |   > (def host-and-port (cmd/peg "HOST:PORT" ~(group (* (<- (to ":")) ":" (number :d+)))))
101 |   > (cmd/def address (required host-and-port))
102 |   > (def [host port] address)
103 |   > (print "host = " host ", port = " port)
104 |   > EOF
105 |   $ run localhost:1234
106 |   host = localhost, port = 1234
107 |   $ run --help
108 |     script.janet HOST:PORT
109 |   
110 |   === flags ===
111 |   
112 |     [--help] : Print this help text and exit
113 | 


--------------------------------------------------------------------------------
/src/util.janet:
--------------------------------------------------------------------------------
 1 | (defn fold-map [f g init coll]
 2 |   (reduce (fn [acc x] (f acc (g x))) init coll))
 3 | 
 4 | (defn hasnt? [dict k]
 5 |   (nil? (dict k)))
 6 | 
 7 | (defn table/push [t k v]
 8 |   (when (hasnt? t k)
 9 |     (put t k @[]))
10 |   (array/push (t k) v))
11 | 
12 | (defn sum-by [f coll]
13 |   (fold-map + f 0 coll))
14 | 
15 | (defn max-by [f coll]
16 |   (fold-map max f 0 coll))
17 | 
18 | (defn transpose-dict [dict]
19 |   (def result @{})
20 |   (eachp [k v] dict
21 |     (when (nil? (result v))
22 |       (put result v @[]))
23 |     (array/push (result v) k))
24 |   result)
25 | 
26 | # TODO: you could imagine a debug mode
27 | # where we preserve the stack frames here...
28 | # actually maybe we should always preserve
29 | # the stack frames, and just throw them away
30 | # when we're using one of the user-facing macros?
31 | # hmm. hmm hmm hmm.
32 | (defmacro try-with-context [name errors & body]
33 |   (with-syms [$err]
34 |     ~(try (do ,;body)
35 |       ([,$err _] (,table/push ,errors ,name ,$err)))))
36 | 
37 | (defn table/union [left right]
38 |   (eachp [key right-values] right
39 |     (def left-values (left key))
40 |     (if left-values
41 |       (array/concat left-values right-values)
42 |       (put left key right-values))))
43 | 
44 | (defn has? [p x y]
45 |   (= (p x) y))
46 | 
47 | (defmacro catseq [& args]
48 |   ~(mapcat |$ (seq ,;args)))
49 | 
50 | (defn ^ [chars]
51 |   ~(* (not (set ,chars)) 1))
52 | 
53 | (defmacro pdb [& exprs]
54 |   ~(do
55 |     ,;(seq [expr :in exprs]
56 |         ~(eprintf "%s = %q" ,(string/format "%q" expr) ,expr))))
57 | 
58 | (defn assertf [pred str & args]
59 |   (assert pred (string/format str ;args)))
60 | 
61 | (defn type+ [form]
62 |   (let [t (type form)]
63 |     (case t
64 |       :tuple (case (tuple/type form)
65 |         :brackets :tuple-brackets
66 |         :parens :tuple-parens)
67 |       t)))
68 | 
69 | (defn putf! [table key value str & args]
70 |   (assertf (hasnt? table key) str ;args)
71 |   (put table key value))
72 | 
73 | (defn put! [table key value]
74 |   (assert (hasnt? table key))
75 |   (put table key value))
76 | 
77 | (defn set-ref [ref value]
78 |   ((ref :set) value))
79 | 
80 | (defn get-ref [ref]
81 |   ((ref :get)))
82 | 
83 | (defn quote-keys [dict]
84 |   ~(struct
85 |     ,;(catseq [[key val] :pairs dict]
86 |       [~',key val])))
87 | 
88 | (defn quote-values [struct]
89 |   ~(struct
90 |     ,;(catseq [[key val] :pairs struct]
91 |       [key ~',val])))
92 | 
93 | (defn quote-keys-and-values [struct]
94 |   ~(struct
95 |     ,;(catseq [[key val] :pairs struct]
96 |       [~',key ~',val])))
97 | 


--------------------------------------------------------------------------------
/src/bridge.janet:
--------------------------------------------------------------------------------
 1 | # values shared between the param parser and the arg parser
 2 | 
 3 | (use ./util)
 4 | 
 5 | (def *spec* (keyword (gensym)))
 6 | (def *subcommand-path* (keyword (gensym)))
 7 | 
 8 | (defn- parse-number [str]
 9 |   (if-let [num (scan-number str)]
10 |     num
11 |     (errorf "%s is not a number" str)))
12 | (defn- parse-int [str]
13 |   (def num (parse-number str))
14 |   (unless (int? num)
15 |     (errorf "%s is not an integer" str))
16 |   num)
17 | 
18 | (defn- builtin-type-parser [token]
19 |   (case token
20 |     :string ["STRING" |$]
21 |     :file ["FILE" |$]
22 |     :number ["NUM" parse-number]
23 |     :int ["INT" parse-int]
24 |     :int+ ["INT" (fn [str]
25 |       (def num (parse-int str))
26 |       (if (>= num 0)
27 |         num
28 |         (errorf "%s is negative" str)))]
29 |     :int++ ["INT" (fn [str]
30 |       (def num (parse-int str))
31 |       (if (> num 0)
32 |         num
33 |         (errorf "%s must not positive" str)))]
34 |     (errorf "unknown type %q" token)))
35 | 
36 | (defn- get-simple-type [parser]
37 |   (cond
38 |     (nil? parser) ["" nil]
39 |     (or (function? parser) (cfunction? parser)) ["_" parser]
40 |     (keyword? parser) (builtin-type-parser parser)
41 |     (and (tuple? parser) (has? length parser 2) (string? (first parser)))
42 |       (let [[arg-name parser] parser]
43 |         (def [_ parser] (get-simple-type parser))
44 |         [arg-name parser])
45 |     (errorf "illegal type declaration %q" parser)))
46 | 
47 | (defn- get-type [value-handling type]
48 |   (if (and (tuple? type) (all struct? type))
49 |     (if (= value-handling :none)
50 |       type
51 |       (let [[alias-remap type] type]
52 |         [alias-remap
53 |          (tabseq [[k v] :pairs type]
54 |            k
55 |            (if (tuple? v)
56 |              (let [[tag type] v]
57 |               [tag (get-simple-type type)])
58 |              (get-simple-type v)))]))
59 |   (get-simple-type type)))
60 | 
61 | (defn- quote-handler [handler]
62 |   (-> handler
63 |     (struct/with-proto :type ~(,get-type ,(handler :value) ,(handler :type)))
64 |     (struct/proto-flatten)))
65 | 
66 | # TODO: this needs a more clear name. what we're doing is
67 | # converting this into a format that can be interpreted.
68 | # as part of this, we'll need to evaluate the parser itself,
69 | # which we do not currently do.
70 | (defn- quote-named-params [params]
71 |   ~(struct
72 |     ,;(catseq [[sym {:handler handler :doc doc :names names}] :pairs params]
73 |       [~',sym {:handler (quote-handler handler)
74 |                :names (tuple/brackets ;names)
75 |                :doc doc}])))
76 | 
77 | (defn- quote-positional-params [params]
78 |   ~[,;(seq [{:sym sym :handler handler} :in params]
79 |       {:handler (quote-handler handler) :sym ~',sym})])
80 | 
81 | (def unset-sentinel (gensym))
82 | 
83 | (def unset ~',unset-sentinel)
84 | 
85 | (defn unset? [x]
86 |   (= x unset-sentinel))
87 | 
88 | (defn display-name [{:names names :sym sym}]
89 |   (if (or (nil? names) (empty? names))
90 |     (string sym)
91 |     (string/join (sorted names) "/")))
92 | 
93 | (defn bake-spec [ctx]
94 |   {:named (quote-named-params (ctx :named-params))
95 |    :names (quote-values (ctx :names))
96 |    :pos (quote-positional-params (ctx :positional-params))
97 |    :doc (ctx :doc)})
98 | 


--------------------------------------------------------------------------------
/tests/positional.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | Positional parameters are required by default:
  4 | 
  5 |   $ use <<EOF
  6 |   > (cmd/def
  7 |   >   arg :string)
  8 |   > (print arg)
  9 |   > EOF
 10 | 
 11 |   $ run
 12 |   ! not enough arguments
 13 |   [1]
 14 |   $ run foo
 15 |   foo
 16 |   $ run foo bar
 17 |   ! unexpected argument bar
 18 |   [1]
 19 | 
 20 | Multiple positional parameters:
 21 | 
 22 |   $ use <<EOF
 23 |   > (cmd/def
 24 |   >   first :string
 25 |   >   second :string)
 26 |   > (print first)
 27 |   > (print second)
 28 |   > EOF
 29 | 
 30 |   $ run
 31 |   ! not enough arguments
 32 |   [1]
 33 |   $ run foo
 34 |   ! not enough arguments
 35 |   [1]
 36 |   $ run foo bar
 37 |   foo
 38 |   bar
 39 | 
 40 | Optional positional parameters:
 41 | 
 42 |   $ use <<EOF
 43 |   > (cmd/def
 44 |   >   first :string
 45 |   >   second (optional :string "dflt"))
 46 |   > (pp [first second])
 47 |   > EOF
 48 | 
 49 |   $ run foo
 50 |   ("foo" "dflt")
 51 |   $ run foo bar
 52 |   ("foo" "bar")
 53 | 
 54 |   $ use <<EOF
 55 |   > (cmd/def
 56 |   >   first (optional :string "dflt")
 57 |   >   second :string)
 58 |   > (pp [first second])
 59 |   > EOF
 60 | 
 61 |   $ run foo
 62 |   ("dflt" "foo")
 63 |   $ run foo bar
 64 |   ("foo" "bar")
 65 | 
 66 | Optional and required positional parameters interspersed:
 67 | 
 68 |   $ use <<EOF
 69 |   > (cmd/def
 70 |   >   first :string
 71 |   >   second (optional :string)
 72 |   >   third (optional :string)
 73 |   >   fourth :string)
 74 |   > (pp [first second third fourth])
 75 |   > EOF
 76 | 
 77 |   $ run 1 2
 78 |   ("1" nil nil "2")
 79 |   $ run 1 2 3
 80 |   ("1" "2" nil "3")
 81 |   $ run 1 2 3 4
 82 |   ("1" "2" "3" "4")
 83 | 
 84 | Variadic positional parameters:
 85 | 
 86 |   $ use <<EOF
 87 |   > (cmd/def
 88 |   >   arg (tuple :string))
 89 |   > (pp arg)
 90 |   > EOF
 91 | 
 92 |   $ run
 93 |   ()
 94 |   $ run 1
 95 |   ("1")
 96 |   $ run 1 2
 97 |   ("1" "2")
 98 | 
 99 | Variadic non-empty positional parameters:
100 | 
101 |   $ use <<EOF
102 |   > (cmd/def
103 |   >   arg (tuple+ :string))
104 |   > (pp arg)
105 |   > EOF
106 | 
107 |   $ run
108 |   ! arg: missing required argument
109 |   [1]
110 |   $ run 1
111 |   ("1")
112 |   $ run 1 2
113 |   ("1" "2")
114 | 
115 | Variadic and required positional parameters:
116 | 
117 |   $ use <<EOF
118 |   > (cmd/def
119 |   >   first (tuple :string)
120 |   >   second :string)
121 |   > (pp [first second])
122 |   > EOF
123 | 
124 |   $ run 1
125 |   (() "1")
126 |   $ run 1 2
127 |   (("1") "2")
128 |   $ run 1 2 3
129 |   (("1" "2") "3")
130 | 
131 |   $ use <<EOF
132 |   > (cmd/def
133 |   >   first :string
134 |   >   second (tuple :string))
135 |   > (pp [first second])
136 |   > EOF
137 | 
138 |   $ run 1
139 |   ("1" ())
140 |   $ run 1 2
141 |   ("1" ("2"))
142 |   $ run 1 2 3
143 |   ("1" ("2" "3"))
144 | 
145 | Optional parameters take precedence over variadic parameters:
146 | 
147 |   $ use <<EOF
148 |   > (cmd/def
149 |   >   first (tuple :string)
150 |   >   second (optional :string))
151 |   > (pp [first second])
152 |   > EOF
153 | 
154 |   $ run
155 |   (() nil)
156 |   $ run 1
157 |   (() "1")
158 |   $ run 1 2
159 |   (("1") "2")
160 |   $ run 1 2 3
161 |   (("1" "2") "3")
162 | 
163 | Optional, required, and variadic parameters:
164 | 
165 |   $ use <<EOF
166 |   > (cmd/def
167 |   >   first (optional :string)
168 |   >   second (tuple :string)
169 |   >   third :string
170 |   >   fourth (optional :string)
171 |   >   fifth :string)
172 |   > (pp [first second third fourth fifth])
173 |   > EOF
174 | 
175 |   $ run 1 2
176 |   (nil () "1" nil "2")
177 |   $ run 1 2 3
178 |   ("1" () "2" nil "3")
179 |   $ run 1 2 3 4
180 |   ("1" () "2" "3" "4")
181 |   $ run 1 2 3 4 5
182 |   ("1" ("2") "3" "4" "5")
183 |   $ run 1 2 3 4 5 6
184 |   ("1" ("2" "3") "4" "5" "6")
185 | 


--------------------------------------------------------------------------------
/tests/basic.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | Parameters are required by default:
  4 | 
  5 |   $ use <<EOF
  6 |   > (cmd/def
  7 |   >   --arg :string)
  8 |   > (pp arg)
  9 |   > EOF
 10 | 
 11 |   $ run
 12 |   ! --arg: missing required argument
 13 |   [1]
 14 |   $ run --arg
 15 |   ! --arg: no value for argument
 16 |   [1]
 17 |   $ run --arg foo
 18 |   "foo"
 19 | 
 20 | Default value for optional flags is nil:
 21 | 
 22 |   $ use <<EOF
 23 |   > (cmd/def
 24 |   >   --arg (optional :string))
 25 |   > (pp arg)
 26 |   > EOF
 27 | 
 28 |   $ run
 29 |   nil
 30 |   $ run --arg
 31 |   ! --arg: no value for argument
 32 |   [1]
 33 |   $ run --arg foo
 34 |   "foo"
 35 | 
 36 | You can specify a custom default:
 37 | 
 38 |   $ use <<EOF
 39 |   > (cmd/def
 40 |   >   --arg (optional :string "foo"))
 41 |   > (pp arg)
 42 |   > EOF
 43 | 
 44 |   $ run
 45 |   "foo"
 46 |   $ run --arg
 47 |   ! --arg: no value for argument
 48 |   [1]
 49 |   $ run --arg foo
 50 |   "foo"
 51 | 
 52 | Explicit required arguments:
 53 | 
 54 |   $ use <<EOF
 55 |   > (cmd/def "doc"
 56 |   >   --arg (required :string))
 57 |   > (pp arg)
 58 |   > EOF
 59 | 
 60 |   $ run
 61 |   ! --arg: missing required argument
 62 |   [1]
 63 |   $ run --arg
 64 |   ! --arg: no value for argument
 65 |   [1]
 66 |   $ run --arg foo
 67 |   "foo"
 68 | 
 69 | Renamed flags:
 70 | 
 71 |   $ use <<EOF
 72 |   > (cmd/def "doc"
 73 |   >   [renamed --arg] :string)
 74 |   > (pp renamed)
 75 |   > EOF
 76 | 
 77 |   $ run --arg foo
 78 |   "foo"
 79 | 
 80 | Aliases:
 81 | 
 82 |   $ use <<EOF
 83 |   > (cmd/def "doc"
 84 |   >   [--arg -a --other] :string)
 85 |   > (pp arg)
 86 |   > EOF
 87 | 
 88 |   $ run --arg "foo"
 89 |   "foo"
 90 |   $ run -a foo
 91 |   "foo"
 92 |   $ run --other foo
 93 |   "foo"
 94 |   $ run --arg foo --other foo
 95 |   ! --other: duplicate argument
 96 |   [1]
 97 | 
 98 | Listed parameters, tuple:
 99 | 
100 |   $ use <<EOF
101 |   > (cmd/def "doc"
102 |   >   --arg (tuple :string))
103 |   > (pp arg)
104 |   > EOF
105 | 
106 |   $ run
107 |   ()
108 |   $ run --arg
109 |   ! --arg: no value for argument
110 |   [1]
111 |   $ run --arg foo
112 |   ("foo")
113 |   $ run --arg foo --arg bar
114 |   ("foo" "bar")
115 | 
116 | Listed array parameters, array:
117 | 
118 |   $ use <<EOF
119 |   > (cmd/def "doc"
120 |   >   --arg (array :string))
121 |   > (pp arg)
122 |   > EOF
123 | 
124 |   $ run
125 |   @[]
126 |   $ run --arg
127 |   ! --arg: no value for argument
128 |   [1]
129 |   $ run --arg foo
130 |   @["foo"]
131 |   $ run --arg foo --arg bar
132 |   @["foo" "bar"]
133 | 
134 | Count parameters:
135 | 
136 |   $ use <<EOF
137 |   > (cmd/def "doc"
138 |   >   -v (counted))
139 |   > (pp v)
140 |   > EOF
141 | 
142 |   $ run
143 |   0
144 |   $ run -v
145 |   1
146 |   $ run -v -v
147 |   2
148 |   $ run -vv
149 |   2
150 | 
151 | Flag parameters:
152 | 
153 |   $ use <<EOF
154 |   > (cmd/def "doc"
155 |   >   -v (flag))
156 |   > (pp v)
157 |   > EOF
158 | 
159 |   $ run
160 |   false
161 |   $ run -v
162 |   true
163 |   $ run -v -v
164 |   ! -v: duplicate argument
165 |   [1]
166 | 
167 | Docstring is optional:
168 | 
169 |   $ use <<EOF
170 |   > (cmd/def --arg :string)
171 |   > (pp arg)
172 |   > EOF
173 | 
174 |   $ run
175 |   ! --arg: missing required argument
176 |   [1]
177 |   $ run --arg hi
178 |   "hi"
179 | 
180 | Duplicates allowed, take last:
181 | 
182 |   $ use <<EOF
183 |   > (cmd/def "doc"
184 |   >   --arg (last+ :string))
185 |   > (pp arg)
186 |   > EOF
187 | 
188 |   $ run
189 |   ! --arg: missing required argument
190 |   [1]
191 |   $ run --arg
192 |   ! --arg: no value for argument
193 |   [1]
194 |   $ run --arg foo
195 |   "foo"
196 |   $ run --arg foo --arg bar
197 |   "bar"
198 |   $ run --arg foo --arg
199 |   ! --arg: no value for argument
200 |   [1]
201 | 
202 | Listed, non-empty:
203 | 
204 |   $ use <<EOF
205 |   > (cmd/def "doc"
206 |   >   --arg (tuple+ :string))
207 |   > (pp arg)
208 |   > EOF
209 | 
210 |   $ run
211 |   ! --arg: missing required argument
212 |   [1]
213 |   $ run --arg
214 |   ! --arg: no value for argument
215 |   [1]
216 |   $ run --arg foo
217 |   ("foo")
218 |   $ run --arg foo --arg bar
219 |   ("foo" "bar")
220 |   $ run --arg foo --arg
221 |   ! --arg: no value for argument
222 |   [1]
223 | 


--------------------------------------------------------------------------------
/src/init.janet:
--------------------------------------------------------------------------------
  1 | (use ./util)
  2 | (import ./help)
  3 | (use ./param-parser)
  4 | (use ./arg-parser)
  5 | (use ./bridge)
  6 | 
  7 | (defn print-help [spec]
  8 |   (if (spec :commands)
  9 |     (help/group spec)
 10 |     (help/simple spec)))
 11 | 
 12 | (defn- print-group-help-and-error [spec & messages]
 13 |   (unless (empty? messages)
 14 |     (eprintf ;messages))
 15 |   (help/group spec)
 16 |   (os/exit 1))
 17 | 
 18 | (defn- potential-docstring? [node]
 19 |   (case (type+ node)
 20 |     :tuple-parens true
 21 |     :string true
 22 |     false))
 23 | 
 24 | # TODO: the representation of having the :help
 25 | # function is a little odd. we could just represent
 26 | # the command as the fully-parsed spec, and have
 27 | # cmd/run do the same check as cmd/print-help
 28 | (defmacro- simple-command [& args]
 29 |   (def [spec body]
 30 |     (case (length args)
 31 |       0 (error "not enough arguments")
 32 |       1 [(first args) []]
 33 |       (let [[first second & rest] args]
 34 |         (if (potential-docstring? first)
 35 |           [(tuple/brackets first ;second) rest]
 36 |           [first [second ;rest]]))))
 37 | 
 38 |   (unless (has? type+ spec :tuple-brackets)
 39 |     (errorf "expected bracketed list of parameters, got %q" spec))
 40 |   (def spec (parse-specification spec))
 41 |   (with-syms [$args $spec]
 42 |     ~(let [,$spec ,(bake-spec spec)]
 43 |       {:fn (fn [,$args]
 44 |         ,(assignment spec $spec $args)
 45 |         ,;body)
 46 |        :doc (,$spec :doc)
 47 |        :help (fn [] (,help/simple ,$spec))})))
 48 | 
 49 | (defn- extend-subcommand-path [command]
 50 |   [;(dyn *subcommand-path* []) command])
 51 | 
 52 | (defn- rewrite-last-subcommand-entry [new]
 53 |   (def current-path (dyn *subcommand-path* []))
 54 |   (def but-last (tuple/slice current-path 0 (- (length current-path) 1)))
 55 |   [;but-last new])
 56 | 
 57 | (def- help-command (simple-command "explain a subcommand"
 58 |   [command (optional ["COMMAND" :string])]
 59 |   (def spec (dyn *spec*))
 60 |   (if command
 61 |     (if-let [subcommand ((spec :commands) command)]
 62 |       (with-dyns [*subcommand-path* (rewrite-last-subcommand-entry command)]
 63 |         ((subcommand :help)))
 64 |       (print-group-help-and-error spec "unknown subcommand %s" command))
 65 |     (help/group spec))))
 66 | 
 67 | (defmacro spec [& s]
 68 |   (bake-spec (parse-specification s)))
 69 | 
 70 | (def args args)
 71 | (def parse parse)
 72 | 
 73 | (defn run [command args]
 74 |   (def f (assertf (command :fn) "invalid command %q" command))
 75 |   (f args))
 76 | 
 77 | (defmacro group [& spec]
 78 |   (def [docstring spec]
 79 |     (if (potential-docstring? (first spec))
 80 |       [(first spec) (drop 1 spec)]
 81 |       [nil spec]))
 82 | 
 83 |   (if (odd? (length spec))
 84 |     (errorf "subcommand %q has no implementation" (last spec)))
 85 | 
 86 |   (def commands
 87 |     (tabseq [[name command] :in (partition 2 spec)]
 88 |       (string name) command))
 89 | 
 90 |   (unless (commands "help")
 91 |     (put commands "help" help-command))
 92 | 
 93 |   # TODO: we could also accumulate flag-looking arguments and pass
 94 |   # them to the command, so that `foo --verbose bar` meant the same
 95 |   # thing as `foo bar --verbose`.
 96 |   (with-syms [$commands $spec]
 97 |     ~(let [,$commands ,commands
 98 |            ,$spec {:doc ,docstring :commands ,$commands}]
 99 |       {:fn (fn [args]
100 |         (match args
101 |           [first & rest]
102 |             (if-let [command (,$commands first)]
103 |               (with-dyns [,*spec* ,$spec
104 |                           ,*subcommand-path* (,extend-subcommand-path first)]
105 |                 (,run command rest))
106 |               (,print-group-help-and-error ,$spec "unknown subcommand %s" first))
107 |           [] (,print-group-help-and-error ,$spec)))
108 |        :doc (,$spec :doc)
109 |        :help (fn [] (,help/group ,$spec))})))
110 | 
111 | (defmacro defgroup [name & s]
112 |   ~(def ,name (as-macro ,group ,;s)))
113 | 
114 | (defmacro main [command]
115 |   ~(defn main [&] (,run ,command (,args))))
116 | 
117 | (defn peg [name peg-dsl]
118 |   (def peg
119 |     (case (type peg-dsl)
120 |       :core/peg peg-dsl
121 |       (peg/compile peg-dsl)))
122 |   [name
123 |    (fn [str]
124 |      (def matches (peg/match peg str))
125 |      (if (and (not (nil? matches)) (has? length matches 1))
126 |        (first matches)
127 |        (errorf "unable to parse %q" str)))])
128 | 
129 | (def fn :macro simple-command)
130 | 
131 | (defmacro defn [name & args]
132 |   ~(def ,name (as-macro ,fn ,;args)))
133 | 
134 | (defmacro def [& spec]
135 |   (def spec (parse-specification spec))
136 |   (assignment spec nil ~(,args)))
137 | 


--------------------------------------------------------------------------------
/tests/spec-errors.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | Missing type:
  4 | 
  5 |   $ use <<<'(cmd/def --arg)'
  6 |   $ run_err
  7 |   ! script.janet:2:1: compile error: error: (macro) no handler for arg
  8 |   [1]
  9 | 
 10 | Duplicate type:
 11 | 
 12 |   $ use <<<'(cmd/def --arg :string :string)'
 13 |   $ run_err
 14 |   ! script.janet:2:1: compile error: error: (macro) multiple handlers specified for --arg (got :string, already have :string)
 15 |   [1]
 16 | 
 17 | Duplicate param docstring:
 18 | 
 19 |   $ use <<<'(cmd/def "doc" --arg :string "help" "help")'
 20 |   $ run_err
 21 |   ! script.janet:2:1: compile error: error: (macro) docstring already set
 22 |   [1]
 23 | 
 24 | Docstring before param:
 25 | 
 26 |   $ use <<<'(cmd/def "doc" "help" --arg :string)'
 27 |   $ run_err
 28 |   ! script.janet:2:1: compile error: error: (macro) unexpected token "help"
 29 |   [1]
 30 | 
 31 | Exact duplicate flags:
 32 | 
 33 |   $ use <<<'(cmd/def "doc" --arg :string --arg :string)'
 34 |   $ run_err
 35 |   ! script.janet:2:1: compile error: error: (macro) multiple parameters named --arg
 36 |   [1]
 37 | 
 38 | Different flags, same symbol:
 39 | 
 40 |   $ use <<<'(cmd/def "doc" --arg :string ---arg :string)'
 41 |   $ run_err
 42 |   ! script.janet:2:1: compile error: error: (macro) duplicate parameter arg
 43 |   [1]
 44 |   $ use <<<'(cmd/def "doc" [foo --arg] :string --foo :string)'
 45 |   $ run_err
 46 |   ! script.janet:2:1: compile error: error: (macro) duplicate parameter foo
 47 |   [1]
 48 |   $ use <<<'(cmd/def "doc" [foo --arg] :string [foo --bar] :string)'
 49 |   $ run_err
 50 |   ! script.janet:2:1: compile error: error: (macro) duplicate parameter foo
 51 |   [1]
 52 | 
 53 | Illegal alias:
 54 | 
 55 |   $ use <<<'(cmd/def "doc" [--arg arg] :string)'
 56 |   $ run_err
 57 |   ! script.janet:2:1: compile error: error: (macro) all aliases must start with - [--arg arg]
 58 |   [1]
 59 |   $ use <<<'(cmd/def "doc" [--arg "arg"] :string)'
 60 |   $ run_err
 61 |   ! script.janet:2:1: compile error: error: (macro) unexpected token [--arg "arg"]
 62 |   [1]
 63 |   $ use <<<'(cmd/def "doc" [])'
 64 |   $ run_err
 65 |   ! script.janet:2:1: compile error: error: (macro) unexpected token []
 66 |   [1]
 67 | 
 68 | Choice with named arg:
 69 | 
 70 |   $ use <<<'(cmd/def --something {--foo 1 --bar 2})'
 71 |   $ run_err
 72 |   ! script.janet:2:1: compile error: error: (macro) you must specify all aliases for something inside {}
 73 |   [1]
 74 | 
 75 | Choice with aliases:
 76 | 
 77 |   $ use <<<'(cmd/def [--a --b] {--foo 1 --bar 2})'
 78 |   $ run_err
 79 |   ! script.janet:2:1: compile error: error: (macro) you must specify all aliases for a inside {}
 80 |   [1]
 81 | 
 82 | Duplicate aliases in choice:
 83 | 
 84 |   $ use <<<'(cmd/def choice (required {[--foo --foo] 1 --bar 2}))'
 85 |   $ run_err
 86 |   ! script.janet:2:1: compile error: error: (macro) duplicate alias --foo
 87 |   [1]
 88 | 
 89 | Empty aliases:
 90 | 
 91 |   $ use <<<'(cmd/def [] :string)'
 92 |   $ run_err
 93 |   ! script.janet:2:1: compile error: error: (macro) unexpected token []
 94 |   [1]
 95 | 
 96 | Empty aliases in choice:
 97 | 
 98 |   $ use <<<'(cmd/def choice (required {[] 1 --bar 2}))'
 99 |   $ run_err
100 |   ! script.janet:2:1: compile error: error: (macro) unexpected token []
101 |   [1]
102 | 
103 | Illegal variant tagging:
104 | 
105 |   $ use <<<'(cmd/def choice (required @{--foo [] --bar :string}))'
106 |   $ run_err
107 |   ! script.janet:2:1: compile error: error: (macro) expected tuple of two elements, got []
108 |   [1]
109 |   $ use <<<'(cmd/def choice (required @{--foo [:string] --bar :string}))'
110 |   $ run_err
111 |   ! script.janet:2:1: compile error: error: (macro) expected tuple of two elements, got [:string]
112 |   [1]
113 |   $ use <<<'(cmd/def choice (required @{--foo [:tag :string foo] --bar :string}))'
114 |   $ run_err
115 |   ! script.janet:2:1: compile error: error: (macro) expected tuple of two elements, got [:tag :string foo]
116 |   [1]
117 | 
118 | Multiple listed positional parameters:
119 | 
120 |   $ use <<<'(cmd/def foo (tuple :string) bar (tuple :string))'
121 |   $ run_err
122 |   ! script.janet:2:1: compile error: error: (macro) you cannot specify specify multiple variadic positional parameters
123 |   [1]
124 | 
125 | Positional soft escape:
126 | 
127 |   $ use <<<'(cmd/def foo (escape))'
128 |   $ run_err
129 |   ! script.janet:2:1: compile error: error: (macro) positional argument needs a valid symbol
130 |   [1]
131 | 
132 | Positional argument after positional hard escape:
133 | 
134 |   $ use <<<'(cmd/def foo (escape :string) bar :string)'
135 |   $ run_err
136 |   ! script.janet:2:1: compile error: error: (macro) only the final positional parameter can have an escape handler
137 |   [1]
138 | 
139 | Positional effect:
140 | 
141 |   $ use <<<'(cmd/def foo (effect nil))'
142 |   $ run_err
143 |   ! script.janet:2:1: compile error: error: (macro) positional argument needs a valid symbol
144 |   [1]
145 | 
146 | Group without implementation:
147 | 
148 |   $ use <<<'(cmd/group foo)'
149 |   $ run_err
150 |   ! script.janet:2:1: compile error: error: (macro) subcommand foo has no implementation
151 |   [1]
152 | 


--------------------------------------------------------------------------------
/src/help.janet:
--------------------------------------------------------------------------------
  1 | (use ./util)
  2 | (use ./bridge)
  3 | 
  4 | # janet has no built-in way to detect the terminal width.
  5 | # might be nice to allow the user to set a dynamic variable,
  6 | # though...
  7 | (def- desired-width 80)
  8 | 
  9 | (defn- right-pad [str len]
 10 |   (string str (string/repeat " " (max 0 (- len (length str))))))
 11 | 
 12 | (defn- word-wrap-line [line len]
 13 |   (def lines @[])
 14 |   (var current-line @"")
 15 |   (each word (string/split " " line)
 16 |     (when (and (not (empty? current-line))
 17 |              (>= (+ (length current-line) 1 (length word)) len))
 18 |       (array/push lines current-line)
 19 |       (set current-line @""))
 20 |     (when (not (empty? current-line))
 21 |       (buffer/push-string current-line " "))
 22 |     (buffer/push-string current-line word))
 23 |   (array/push lines current-line)
 24 |   lines)
 25 | 
 26 | (defn- word-wrap [str len]
 27 |   (mapcat |(word-wrap-line $ len) (string/split "\n" str)))
 28 | 
 29 | (defn- zip-lines [lefts rights f]
 30 |   (def end (max (length lefts) (length rights)))
 31 |   (def last-i (- end 1))
 32 |   (for i 0 end
 33 |     (f (= i 0) (= i last-i) (get lefts i "") (get rights i ""))))
 34 | 
 35 | (defn- executable-name []
 36 |   (def executable-path (first (dyn *args*)))
 37 |   (last (string/split "/" executable-path)))
 38 | 
 39 | (defn wrap-handling [str value-handling]
 40 |   (case value-handling
 41 |     :required str
 42 |     :none (string "["str"]")
 43 |     :optional (string "["str"]")
 44 |     :variadic (string "["str"]...")
 45 |     :variadic+ (string str"...")
 46 |     :greedy (string "["str"...]")
 47 |     :soft-escape (string "["str"]")
 48 |     (errorf "BUG: unknown value handling %q" value-handling)))
 49 | 
 50 | (defn- format-arg-string [handler &opt str]
 51 |   (def {:value value-handling :type type} handler)
 52 |   (case value-handling
 53 |     :none nil
 54 |     :soft-escape nil
 55 |     (let [[first second] type]
 56 |       (if (string? first)
 57 |         first
 58 |         (let [sym (first str)
 59 |               # [tag [arg-name type]]
 60 |               [_ [arg _]] (second sym)]
 61 |           arg)))))
 62 | 
 63 | (defn- format-named-param [str handler]
 64 |   (def arg (format-arg-string handler str))
 65 |   (wrap-handling
 66 |     (if arg (string str " " arg) str)
 67 |     (handler :value)))
 68 | 
 69 | (defn- format-positional-param [handler]
 70 |   (wrap-handling
 71 |     (format-arg-string handler)
 72 |     (handler :value)))
 73 | 
 74 | (defn- print-wrapped [str len]
 75 |   (each line (word-wrap str len)
 76 |     (print line)))
 77 | 
 78 | (defn- lines [str]
 79 |   (string/split "\n" str))
 80 | 
 81 | (defn blank? [str]
 82 |   (all |(= (chr " ") $) str))
 83 | 
 84 | (defn parse-docstring [str]
 85 |   (if (nil? str)
 86 |     [nil nil]
 87 |     (let [[summary & detail] (lines str)]
 88 |       (def detail (drop-while blank? detail))
 89 |       [summary (if (not (empty? detail))
 90 |         (string/join detail "\n"))])))
 91 | 
 92 | (defn docstring-summary [{:doc str}]
 93 |   (or (first (parse-docstring str)) ""))
 94 | 
 95 | (defn print-columns [sep entries]
 96 |   (def left-column-width (max-by |(max-by length (0 $)) entries))
 97 |   (each [lefts docstring] entries
 98 |     (def rights (word-wrap docstring (max (/ desired-width 2) (- desired-width left-column-width))))
 99 | 
100 |     (zip-lines lefts rights (fn [first? last? left right]
101 |       (def sep (if (empty? right) "" (if first? sep "   ")))
102 |       (def pad-to (if (empty? right) 0 left-column-width))
103 |       (print "  " (right-pad left pad-to) sep right)
104 |       ))))
105 | 
106 | (defn group [spec]
107 |   # TODO: word wrap
108 |   (def {:doc docstring :commands commands} spec)
109 |   (when docstring
110 |     (print-wrapped docstring desired-width)
111 |     (print))
112 | 
113 |   (def commands (sorted-by 0 (pairs commands)))
114 | 
115 |   # TODO: bit of code duplication here
116 |   (print-columns " - " (seq [[name command] :in commands]
117 |     [[name] (docstring-summary command)])))
118 | 
119 | (defn- default-description [param]
120 |   (case ((param :handler) :value)
121 |     :soft-escape "Treat all subsequent arguments as positional"
122 |     ""
123 |     ))
124 | 
125 | (defn simple [spec]
126 |   (def {:named named-params
127 |         :names param-names
128 |         :pos positional-params
129 |         :doc docstring} spec)
130 | 
131 |   (def [summary details] (parse-docstring docstring))
132 |   (when summary
133 |     (print-wrapped summary desired-width)
134 |     (print))
135 | 
136 |   (prin "  " (executable-name))
137 |   (each subcommand (dyn *subcommand-path* [])
138 |     (print " " subcommand))
139 |   (each param positional-params
140 |     (prin " ")
141 |     (prin (format-positional-param (param :handler))))
142 |   (print "\n")
143 | 
144 |   (when details
145 |     (print-wrapped details desired-width)
146 |     (print))
147 | 
148 |   (def named-arg-entries
149 |     (seq [[_ param] :in (sorted-by 0 (pairs named-params))]
150 |       (def {:names names} param)
151 |       (def names (sorted-by |(string/triml $ "-") names))
152 |       (def formatted-names (map |(format-named-param $ (param :handler)) names))
153 |       # 2 is the length of the initial "  " and the separator ", "
154 |       (def total-length (sum-by |(+ (length $) 2) formatted-names))
155 |       (def lines (if (<= total-length (/ desired-width 3))
156 |         [(string/join formatted-names ", ")]
157 |         formatted-names))
158 |       [lines (or (param :doc) (default-description param))]))
159 | 
160 |   (unless (empty? named-arg-entries)
161 |     (print "=== flags ===\n")
162 | 
163 |     (print-columns " : " named-arg-entries)))
164 | 


--------------------------------------------------------------------------------
/src/arg-parser.janet:
--------------------------------------------------------------------------------
  1 | # runtime parser for actual arguments
  2 | 
  3 | (use ./util)
  4 | (use ./bridge)
  5 | (use ./help)
  6 | 
  7 | # param: {sym handler}
  8 | (defn- assign-positional-args [args params refs]
  9 |   (def num-args (length args))
 10 |   (def errors @{})
 11 | 
 12 |   (var num-required-params 0)
 13 |   (var num-optional-params 0)
 14 |   (each {:handler {:value value-handling}} params
 15 |     (case value-handling
 16 |       :required (++ num-required-params)
 17 |       :optional (++ num-optional-params)
 18 |       :variadic nil
 19 |       :variadic+ nil
 20 |       :greedy nil
 21 |       (errorf "BUG: unknown value handler %q" value-handling)))
 22 | 
 23 |   (var num-optional-args
 24 |     (min (- num-args num-required-params) num-optional-params))
 25 | 
 26 |   (var num-variadic-args
 27 |     (- num-args (+ num-required-params num-optional-args)))
 28 | 
 29 |   (defn assign [{:handler handler :sym sym} arg]
 30 |     (def ref (assert (refs sym)))
 31 |     (def {:update handle :type t} handler)
 32 |     (try-with-context sym errors
 33 |       (set-ref ref (handle t nil (get-ref ref) arg))))
 34 | 
 35 |   (var arg-index 0)
 36 |   (defn take-arg []
 37 |     (assert (< arg-index num-args))
 38 |     (def arg (args arg-index))
 39 |     (++ arg-index)
 40 |     arg)
 41 |   (each param params
 42 |     (match ((param :handler) :value)
 43 |       :required (do
 44 |         (if (< arg-index num-args)
 45 |           (assign param (take-arg))
 46 |           (do
 47 |             (table/push errors "" "not enough arguments")
 48 |             (break))))
 49 |       :optional
 50 |         (when (> num-optional-args 0)
 51 |           (assign param (take-arg))
 52 |           (-- num-optional-args))
 53 |       (handling (or (= handling :variadic) (= handling :variadic+)))
 54 |         (while (> num-variadic-args 0)
 55 |           (assign param (take-arg))
 56 |           (-- num-variadic-args))
 57 |       :greedy nil
 58 |       _ (assert false)))
 59 | 
 60 |   (when (< arg-index num-args)
 61 |     (table/push errors "" (string/format "unexpected argument %s" (args arg-index))))
 62 |   errors)
 63 | 
 64 | # this is the absolute worst kind of macro
 65 | (defmacro- consume [name expr]
 66 |   ~(let [{:update handle :type t} handler]
 67 |     (try-with-context ,name errors
 68 |       (set-ref ref (handle t (if (string? ,name) ,name) (get-ref ref) ,expr)))))
 69 | 
 70 | # args: [string]
 71 | # spec:
 72 | #   named: sym -> param
 73 | #   names: string -> sym
 74 | #   pos: [param]
 75 | # refs: sym -> ref
 76 | (defn- parse-args [args {:named named-params :names param-names :pos positional-params} refs]
 77 |   (var i 0)
 78 |   (def errors @{})
 79 |   (def positional-args @[])
 80 |   (var soft-escaped? false)
 81 | 
 82 |   (def positional-hard-escape-param
 83 |     (if-let [last-param (last positional-params)]
 84 |       (if (= ((last-param :handler) :value) :greedy) last-param)))
 85 | 
 86 |   (defn next-arg []
 87 |     (if (= i (length args))
 88 |       (errorf "no value for argument"))
 89 |     (def arg (args i))
 90 |     (++ i)
 91 |     arg)
 92 | 
 93 |   (defn positional? [arg]
 94 |     (or soft-escaped?
 95 |       (not (string/has-prefix? "-" arg))))
 96 | 
 97 |   (defn handle [sym param])
 98 | 
 99 |   (defn final-positional? []
100 |     (= (length positional-args)
101 |        (- (length positional-params) 1)))
102 | 
103 |   (while (< i (length args))
104 |     (def arg (args i))
105 |     (++ i)
106 |     (if (positional? arg)
107 |       (if (and positional-hard-escape-param (final-positional?))
108 |         (let [{:sym sym :handler handler} positional-hard-escape-param
109 |                ref (assert (refs sym))]
110 |           (consume sym arg)
111 |           (while (< i (length args)) (consume sym (next-arg))))
112 |         (array/push positional-args arg))
113 |       (let [sym (param-names arg)]
114 |         # TODO: nice error message for negative number
115 |         (if (nil? sym)
116 |           (table/push errors arg "unknown parameter")
117 |           (let [{:handler handler} (assert (named-params sym))
118 |                 {:value value-handling} handler]
119 |             (if (= value-handling :soft-escape)
120 |               (set soft-escaped? true)
121 |               (let [takes-value? (not= value-handling :none)
122 |                     ref (assert (refs sym))]
123 |                 (case value-handling
124 |                   :none (consume arg nil)
125 |                   :greedy (while (< i (length args)) (consume arg (next-arg)))
126 |                   (consume arg (next-arg))))))))))
127 |   (table/union errors (assign-positional-args positional-args positional-params refs))
128 |   errors)
129 | 
130 | (def- -foo=bar ~(* (<- (* "-" (some ,(^ "= ")))) "=" (<- (to -1))))
131 | (def- -xyz ~(* "-" (group (some (<- ,(^ "- ")))) -1))
132 | 
133 | (defn- split-short-flags [arg]
134 |   (if-let [[args] (peg/match -xyz arg)]
135 |     (map |(string "-" $) args)
136 |     [arg]))
137 | 
138 | (defn- normalize-args [args]
139 |   (def result @[])
140 |   (each arg args
141 |     (if-let [[arg val] (peg/match -foo=bar arg)]
142 |       (array/concat result (split-short-flags arg) [val])
143 |       (array/concat result (split-short-flags arg))))
144 |   result)
145 | 
146 | (defn args [] (normalize-args (drop 1 (dyn *args*))))
147 | 
148 | (defn- print-parse-errors [err-table]
149 |   (if-let [ctxless-errors (err-table "")]
150 |     (each err ctxless-errors
151 |       (eprint err))
152 |     (loop [[context errs] :pairs err-table :when (not= context "")]
153 |       (eprintf "%s: %s" context (first errs)))))
154 | 
155 | (defn assignment [spec baked-spec args]
156 |   (def params (spec :params))
157 |   (def all-syms (seq [sym :keys params :when (not= (((params sym) :handler) :value) :soft-escape)] sym))
158 |   (def {true private-syms false public-syms} (group-by |(truthy? (((params $) :handler) :symless)) all-syms))
159 |   (default private-syms [])
160 |   (default public-syms [])
161 |   (def gensyms (struct ;(catseq [sym :in all-syms] [sym (gensym)])))
162 | 
163 |   (def var-declarations
164 |     (seq [sym :in all-syms
165 |           :let [$sym (gensyms sym)
166 |                 param (params sym)
167 |                 handler (param :handler)]]
168 |       ~(var ,$sym ,(handler :init))))
169 | 
170 |   (def refs
171 |     (catseq [sym :in all-syms
172 |              :let [$sym (gensyms sym)]]
173 |       [~',sym
174 |         ~{:get (fn [] ,$sym)
175 |           :set (fn [x] (set ,$sym x))}]))
176 | 
177 |   (with-syms [$spec $errors $results]
178 |     (defn finalizations-of [syms]
179 |       (seq [sym :in syms
180 |             :let [$sym (gensyms sym)
181 |                   param (params sym)
182 |                   name (display-name param)
183 |                   handler (param :handler)]]
184 |         ~(as-macro
185 |           ,try-with-context ,name ,$errors
186 |           (,(handler :finish) ,$sym))))
187 |     ~(def [,;public-syms]
188 |       (let [,$spec ,(or baked-spec (bake-spec spec))] (with-dyns [,*spec* ,$spec]
189 |         ,;var-declarations
190 |         (def ,$errors (,parse-args
191 |           ,args
192 |           ,$spec
193 |           (,struct ,;refs)))
194 |         ,;(finalizations-of private-syms)
195 |         (def ,$results [,;(finalizations-of public-syms)])
196 |         (unless (,empty? ,$errors)
197 |           (,print-parse-errors ,$errors)
198 |           (,os/exit 1))
199 |         ,$results)))))
200 | 
201 | (defn parse [spec args]
202 |   (def handlers @{})
203 |   (eachp [sym {:handler handler}] (spec :named)
204 |     (put handlers sym handler))
205 |   (each {:sym sym :handler handler} (spec :pos)
206 |     (put handlers sym handler))
207 | 
208 |   (def scope (tabseq [[sym handler] :pairs handlers]
209 |     sym (handler :init)))
210 |   (def refs (tabseq [sym :keys handlers]
211 |     sym {:get (fn [] (scope sym)) :set (fn [x] (put scope sym x))}))
212 |   (with-dyns [*spec* spec]
213 |     (def errors (parse-args args spec refs))
214 |     (def result @{})
215 |     (eachp [sym val] scope
216 |       (def handler (assert (handlers sym)))
217 |       (try-with-context sym errors
218 |         (put result (keyword sym) ((handler :finish) val))))
219 |     (if (empty? errors)
220 |       result
221 |       (error errors))))
222 | 


--------------------------------------------------------------------------------
/tests/help.t:
--------------------------------------------------------------------------------
  1 |   $ source $TESTDIR/scaffold
  2 | 
  3 | Executable name prints the same regardless of how it's invoked:
  4 | 
  5 |   $ cat >script.janet <<EOF
  6 |   > #!/usr/bin/env janet
  7 |   > (import src :as cmd)
  8 |   > (cmd/def)
  9 |   > EOF
 10 |   $ chmod +x script.janet
 11 |   $ JANET_PATH="$TESTDIR/.." ./script.janet --help
 12 |     script.janet
 13 |   
 14 |   === flags ===
 15 |   
 16 |     [--help] : Print this help text and exit
 17 |   $ JANET_PATH="$TESTDIR/.." $PWD/script.janet --help
 18 |     script.janet
 19 |   
 20 |   === flags ===
 21 |   
 22 |     [--help] : Print this help text and exit
 23 | 
 24 | No docstring:
 25 | 
 26 |   $ use <<EOF
 27 |   > (cmd/def)
 28 |   > EOF
 29 |   $ run --help
 30 |     script.janet
 31 |   
 32 |   === flags ===
 33 |   
 34 |     [--help] : Print this help text and exit
 35 | 
 36 | Undocumented parameters:
 37 | 
 38 |   $ use <<EOF
 39 |   > (cmd/def --arg :string)
 40 |   > EOF
 41 |   $ run --help
 42 |     script.janet
 43 |   
 44 |   === flags ===
 45 |   
 46 |     [--help]     : Print this help text and exit
 47 |     --arg STRING
 48 | 
 49 | Hidden aliases:
 50 | 
 51 |   $ run -h
 52 |     script.janet
 53 |   
 54 |   === flags ===
 55 |   
 56 |     [--help]     : Print this help text and exit
 57 |     --arg STRING
 58 |   $ run -?
 59 |     script.janet
 60 |   
 61 |   === flags ===
 62 |   
 63 |     [--help]     : Print this help text and exit
 64 |     --arg STRING
 65 | 
 66 | Docstring:
 67 | 
 68 |   $ use <<EOF
 69 |   > (cmd/def "This is the docstring")
 70 |   > EOF
 71 |   $ run --help
 72 |   This is the docstring
 73 |   
 74 |     script.janet
 75 |   
 76 |   === flags ===
 77 |   
 78 |     [--help] : Print this help text and exit
 79 | 
 80 | Param docstring:
 81 | 
 82 |   $ use <<EOF
 83 |   > (cmd/def "doc" --arg :string "arg doc")
 84 |   > (pp arg)
 85 |   > EOF
 86 |   $ run --help
 87 |   doc
 88 |   
 89 |     script.janet
 90 |   
 91 |   === flags ===
 92 |   
 93 |     [--help]     : Print this help text and exit
 94 |     --arg STRING : arg doc
 95 | 
 96 | Complex help:
 97 | 
 98 |   $ use <<EOF
 99 |   > (cmd/def "This is the command description."
100 |   >   foo :string
101 |   >   bar (optional ["BAR" :string])
102 |   >   rest (tuple :string)
103 |   >   baz (optional ["BAZ" :string])
104 |   >   --arg (last+ :string) "arg help"
105 |   >   format {--text :plain --html :rich} "how to print results"
106 |   >   [arg-sym --alias -a --long-other-alias] :string "how to print results")
107 |   > EOF
108 | 
109 |   $ run --help
110 |   This is the command description.
111 |   
112 |     script.janet STRING [BAR] [STRING]... [BAZ]
113 |   
114 |   === flags ===
115 |   
116 |     [--help]                  : Print this help text and exit
117 |     --arg STRING...           : arg help
118 |     -a STRING                 : how to print results
119 |     --alias STRING
120 |     --long-other-alias STRING
121 |     [--html], [--text]        : how to print results
122 | 
123 | Word wrap:
124 | 
125 |   $ use <<EOF
126 |   > (cmd/print-help (cmd/spec "This is the command description."
127 |   >   --arg :string "this is a very long docstring to demonstrate the way that word wrap behaves in help text.\n\nit can span multiple paragraphs. long words are not broken:\n\nxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\nand so on"
128 |   > ))
129 |   > EOF
130 | 
131 |   $ run
132 |   This is the command description.
133 |   
134 |     script.janet
135 |   
136 |   === flags ===
137 |   
138 |     [--help]     : Print this help text and exit
139 |     --arg STRING : this is a very long docstring to demonstrate the way that word wrap
140 |                    behaves in help text.
141 |     
142 |                    it can span multiple paragraphs. long words are not broken:
143 |     
144 |                    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
145 |     
146 |                    and so on
147 | 
148 | Word wrap of argument names:
149 | 
150 |   $ use <<EOF
151 |   > (cmd/print-help (cmd/spec "This is the command description."
152 |   >   [--arg -a --bar --baz --qux] :string "this is a very long docstring to demonstrate the way that word wrap behaves in help text"
153 |   >   --b :string "very little doc"
154 |   > ))
155 |   > EOF
156 | 
157 |   $ run
158 |   This is the command description.
159 |   
160 |     script.janet
161 |   
162 |   === flags ===
163 |   
164 |     [--help]     : Print this help text and exit
165 |     -a STRING    : this is a very long docstring to demonstrate the way that word wrap
166 |     --arg STRING   behaves in help text
167 |     --bar STRING
168 |     --baz STRING
169 |     --qux STRING
170 |     --b STRING   : very little doc
171 | 
172 | Help for variants:
173 | 
174 |   $ use <<EOF
175 |   > (cmd/def "This is the command description."
176 |   >   foo (optional @{[--bar -b] [:bar ["HEY" :string]] --baz :string}) "something"
177 |   >   other {--foo 1} "something else"
178 |   >   something {[--arg -a] 1 [--other -o] 2} "another")
179 |   > EOF
180 | 
181 |   $ run --help
182 |   This is the command description.
183 |   
184 |     script.janet
185 |   
186 |   === flags ===
187 |   
188 |     [--help]       : Print this help text and exit
189 |     [-b HEY]       : something
190 |     [--bar HEY]
191 |     [--baz STRING]
192 |     [--foo]        : something else
193 |     [-a]           : another
194 |     [--arg]
195 |     [-o]
196 |     [--other]
197 | 
198 | Long description:
199 | 
200 |   $ use <<EOF
201 |   > (cmd/def "This is the command summary.\n\nThis is the detailed description.\n\nIt can be multiple paragraphs long, and it does wrap properly. It looks good, even. Look at that! It looks great." foo :string)
202 |   > EOF
203 | 
204 |   $ run --help
205 |   This is the command summary.
206 |   
207 |     script.janet STRING
208 |   
209 |   This is the detailed description.
210 |   
211 |   It can be multiple paragraphs long, and it does wrap properly. It looks good,
212 |   even. Look at that! It looks great.
213 |   
214 |   === flags ===
215 |   
216 |     [--help] : Print this help text and exit
217 | 
218 | Escapes:
219 | 
220 |   $ use <<EOF
221 |   > (cmd/def -- (escape))
222 |   > EOF
223 | 
224 |   $ run --help
225 |     script.janet
226 |   
227 |   === flags ===
228 |   
229 |     [--]     : Treat all subsequent arguments as positional
230 |     [--help] : Print this help text and exit
231 | 
232 | Examples from the readme:
233 | 
234 |   $ use <<EOF
235 |   > (def name ["NAME" :string])
236 |   > (cmd/def 
237 |   >   name (required name))
238 |   > (printf "Hello, %s!" name)
239 |   > EOF
240 | 
241 |   $ run --help
242 |     script.janet NAME
243 |   
244 |   === flags ===
245 |   
246 |     [--help] : Print this help text and exit
247 | 
248 | Every handler:
249 | 
250 |   $ use <<EOF
251 |   > (cmd/def 
252 |   >   --required (required :string)
253 |   >   --optional (optional :string)
254 |   >   --tuple (tuple :string)
255 |   >   --tuple+ (tuple+ :string)
256 |   >   --array (array :string)
257 |   >   --array+ (array+ :string)
258 |   >   --last (last :string)
259 |   >   --last+ (last+ :string)
260 |   >   --flag (flag)
261 |   >   --effect (effect (fn []))
262 |   >   --counted (counted)
263 |   >   --soft-escape (escape)
264 |   >   --hard-escape (escape :string)
265 |   > )
266 |   > EOF
267 | 
268 |   $ run --help
269 |     script.janet
270 |   
271 |   === flags ===
272 |   
273 |     [--effect]
274 |     [--soft-escape]           : Treat all subsequent arguments as positional
275 |     [--help]                  : Print this help text and exit
276 |     [--array STRING]...
277 |     --array+ STRING...
278 |     [--counted]
279 |     [--flag]
280 |     [--hard-escape STRING...]
281 |     [--last STRING]...
282 |     --last+ STRING...
283 |     [--optional STRING]
284 |     --required STRING
285 |     [--tuple STRING]...
286 |     --tuple+ STRING...
287 | 
288 | Word wrap in group help output:
289 | 
290 |   $ use <<EOF
291 |   > (cmd/main (cmd/group
292 |   >   foo (cmd/fn "this is a verbose description of the subcommand which will wrap and lay out nicely just like you'd expect it to" [] (print "foo"))
293 |   >   bar (cmd/fn "this one's simple" [] (print "bar"))
294 |   > ))
295 |   > EOF
296 | 
297 |   $ run help
298 |     bar  - this one's simple
299 |     foo  - this is a verbose description of the subcommand which will wrap and lay out
300 |            nicely just like you'd expect it to
301 |     help - explain a subcommand
302 | 
303 | Group help for unknown subcommand:
304 | 
305 |   $ use <<EOF
306 |   > (cmd/main (cmd/group
307 |   >   foo (cmd/fn "this is a verbose description of the subcommand which will wrap and lay out nicely just like you'd expect it to" [] (print "foo"))
308 |   >   bar (cmd/fn "this one's simple" [] (print "bar"))
309 |   > ))
310 |   > EOF
311 | 
312 |   $ run help baz
313 |     bar  - this one's simple
314 |     foo  - this is a verbose description of the subcommand which will wrap and lay out
315 |            nicely just like you'd expect it to
316 |     help - explain a subcommand
317 |   ! unknown subcommand baz
318 |   [1]
319 | 
320 | Subcommand --help includes the subcommand path in the usage line:
321 | 
322 |   $ use <<EOF
323 |   > (cmd/main (cmd/group
324 |   >   foo (cmd/fn [] (print "foo"))
325 |   >   bar (cmd/fn [] (print "bar"))
326 |   > ))
327 |   > EOF
328 | 
329 |   $ run help foo
330 |     script.janet foo
331 |   
332 |   
333 |   === flags ===
334 |   
335 |     [--help] : Print this help text and exit
336 | 
337 |   $ run foo --help
338 |     script.janet foo
339 |   
340 |   
341 |   === flags ===
342 |   
343 |     [--help] : Print this help text and exit
344 | 
345 | Positional arguments use the same format handlers as named arguments:
346 | 
347 |   $ use <<EOF
348 |   > (cmd/def
349 |   >   foo (optional :string)
350 |   >   bar (tuple :string))
351 |   > EOF
352 | 
353 |   $ run --help
354 |     script.janet [STRING] [STRING]...
355 |   
356 |   === flags ===
357 |   
358 |     [--help] : Print this help text and exit
359 | 
360 | Horizontal alignment in group:
361 | 
362 |   $ use <<EOF
363 |   > (cmd/main (cmd/group
364 |   >   short (cmd/fn [])
365 |   >   much-longer (cmd/fn [])))
366 |   > EOF
367 | 
368 |   $ run help
369 |     help        - explain a subcommand
370 |     much-longer
371 |     short
372 | 
373 | Horizontal alignment in simple:
374 | 
375 |   $ use <<EOF
376 |   > (cmd/def
377 |   >   --short :string ""
378 |   >   --much-longer :string "")
379 |   > EOF
380 | 
381 |   $ run --help
382 |     script.janet
383 |   
384 |   === flags ===
385 |   
386 |     [--help]             : Print this help text and exit
387 |     --much-longer STRING
388 |     --short STRING
389 | 


--------------------------------------------------------------------------------
/src/param-parser.janet:
--------------------------------------------------------------------------------
  1 | # compile-time parser for the [--foo (optional :string)] DSL
  2 | 
  3 | (use ./util)
  4 | (use ./bridge)
  5 | (import ./help)
  6 | 
  7 | (defn- named-param? [token]
  8 |   (and
  9 |     (= (type token) :symbol)
 10 |     (string/has-prefix? "-" token)))
 11 | 
 12 | (defn- goto-state [ctx next-state]
 13 |   (set (ctx :state) next-state))
 14 | 
 15 | (defn- assert-unset [val] (assert (unset? val) "duplicate argument"))
 16 | 
 17 | (defn- named-param-to-string [token]
 18 |   (if (named-param? token)
 19 |     (string token)
 20 |     (assertf "expected named parameter, got %q" token)))
 21 | 
 22 | (defn- named-params-from-keys [s]
 23 |   (catseq [key :keys s]
 24 |     (case (type+ key)
 25 |       :tuple-brackets (map named-param-to-string key)
 26 |       [(named-param-to-string key)])))
 27 | 
 28 | (defn- infer-tag [name-or-names]
 29 |   (def name
 30 |     (if (tuple? name-or-names)
 31 |       (first name-or-names)
 32 |       name-or-names))
 33 |   (keyword (string/triml name "-")))
 34 | 
 35 | (defn- tagged-variant-parser [name-or-names form]
 36 |   (def $tag-and-parser
 37 |     (if (has? type+ form :tuple-brackets)
 38 |       (do
 39 |         (assertf (has? length form 2)
 40 |           "expected tuple of two elements, got %q" form)
 41 |         (def [$tag $type] form)
 42 |         ~[,$tag ,$type])
 43 |       ~[,(infer-tag name-or-names) ,form]))
 44 |   $tag-and-parser)
 45 | 
 46 | (defn- get-dictionary-parser [dict]
 47 |   (def additional-names (named-params-from-keys dict))
 48 |   (def takes-value? (table? dict))
 49 | 
 50 |   # we only want to evaluate each type declaration once,
 51 |   # so we make two lookup tables: one from string name
 52 |   # to unique symbol, and one from unique symbol to
 53 |   # abstract syntax tree. we'll evaluate the latter table,
 54 |   # and use the former table to decide how to look up in it
 55 |   (def alias-remap @{})
 56 |   (def types-for-param @{})
 57 |   (eachp [name-or-names type-declaration] dict
 58 |     (def key (if (tuple? name-or-names)
 59 |       (do
 60 |         (assertf (not (empty? name-or-names)) "unexpected token %q" name-or-names)
 61 |         (def sym (gensym))
 62 |         (each name name-or-names
 63 |           (putf! alias-remap (string name) sym "duplicate alias %q" name))
 64 |         sym)
 65 |       (do
 66 |         (def name name-or-names)
 67 |         (putf! alias-remap (string name) name "duplicate alias %q" name)
 68 |         name)))
 69 |     (def $type
 70 |       (if takes-value?
 71 |         (tagged-variant-parser name-or-names type-declaration)
 72 |         type-declaration))
 73 |     (putf! types-for-param key $type "BUG: duplicate key %q" key))
 74 | 
 75 |   (defn parse-string [[alias-remap types-for-param] param-name value]
 76 |     (def key (alias-remap param-name))
 77 |     (def t (types-for-param key))
 78 |     (if takes-value?
 79 |       (do
 80 |         (assert (string? value))
 81 |         (def [tag [_ of-string]] t)
 82 |         [tag (of-string value)])
 83 |       (do (assert (nil? value)) t)))
 84 | 
 85 |   [additional-names
 86 |    takes-value?
 87 |    ~[,(quote-keys-and-values alias-remap) ,(quote-keys types-for-param)]
 88 |    parse-string])
 89 | 
 90 | # a type declaration can be an arbitrary expression. returns
 91 | # [additional-names takes-value? $type parse-string]
 92 | # $type is an abstract syntax tree that will be evaluated
 93 | # parse-string is a function from [type param-name arg-value] -> value
 94 | # parse-string takes the evaluated type
 95 | (defn- get-parser [type-declaration]
 96 |   (if (dictionary? type-declaration)
 97 |     (get-dictionary-parser type-declaration)
 98 |     [[]
 99 |      true
100 |      type-declaration
101 |      (fn [[_ parse-string] name value] (parse-string value))]))
102 | 
103 | (defn missing-required-argument []
104 |   (error "missing required argument"))
105 | 
106 | (defn- handle/required [type-declaration]
107 |   (def [additional-names takes-value? $type parse-string] (get-parser type-declaration))
108 |   [additional-names
109 |    {:init unset
110 |     :value (if takes-value? :required :none)
111 |     :type $type
112 |     :update (fn [t name old new]
113 |       (assert-unset old)
114 |       (parse-string t name new))
115 |     :finish (fn [val]
116 |      (when (unset? val)
117 |        (missing-required-argument))
118 |      val)}])
119 | 
120 | (defn- rewrite-value [handler new]
121 |   (if (not= (handler :value) :none) new))
122 | 
123 | (defn- handle/optional [type-declaration &opt default]
124 |   (def [additional-names handler] (handle/required type-declaration))
125 |   [additional-names (struct/with-proto handler
126 |     :value (rewrite-value handler :optional)
127 |     :finish (fn [val] (if (unset? val) default val)))])
128 | 
129 | (defn- handle/last+ [type-declaration]
130 |   (def [additional-names handler] (handle/required type-declaration))
131 |   [additional-names (struct/with-proto handler
132 |     :value (rewrite-value handler :variadic+)
133 |     :update (fn [t name _ new] ((handler :update) t name unset-sentinel new)))])
134 | 
135 | (defn- handle/last [type-declaration &opt default]
136 |   (def [additional-names handler] (handle/optional type-declaration default))
137 |   [additional-names (struct/with-proto handler
138 |     :value (rewrite-value handler :variadic)
139 |     :update (fn [t name _ new] ((handler :update) t name unset-sentinel new)))])
140 | 
141 | (defn- handle/flag []
142 |   [[]
143 |    {:init unset
144 |     :value :none
145 |     :type nil
146 |     :update (fn [_ _ old _] (assert-unset old) true)
147 |     :finish (fn [val]
148 |      (if (unset? val) false val))}])
149 | 
150 | (defn- handle/effect [f]
151 |   [[]
152 |   {:init unset
153 |    :value :none
154 |    :type f
155 |    :symless true
156 |    :update (fn [[_ t] _ old _] (assert-unset old) t)
157 |    :finish (fn [val] (if (unset? val) nil (val)))}])
158 | 
159 | (defn- handle/counted []
160 |   [[]
161 |    {:init 0
162 |     :value :none
163 |     :type nil
164 |     :update (fn [_ _ old _] (+ old 1))
165 |     :finish |$}])
166 | 
167 | (defn- handle/listed-array [type-declaration]
168 |   (def [additional-names takes-value? $type parse-string] (get-parser type-declaration))
169 |   [additional-names
170 |    {:init @[]
171 |     :value (if takes-value? :variadic :none)
172 |     :type $type
173 |     :update (fn [t name old new]
174 |      (array/push old (parse-string t name new))
175 |      old)
176 |     :finish |$}])
177 | 
178 | (defn- handle/listed-array+ [type-declaration]
179 |   (def [additional-names handler] (handle/listed-array type-declaration))
180 |   [additional-names (struct/with-proto handler
181 |     :value (rewrite-value handler :variadic+)
182 |     :finish (fn [arr]
183 |       (if (empty? arr)
184 |         (missing-required-argument))
185 |       arr))])
186 | 
187 | (defn- handle/listed-tuple [type-declaration]
188 |   (def [additional-names handler] (handle/listed-array type-declaration))
189 |   [additional-names (struct/with-proto handler :finish tuple/slice)])
190 | 
191 | (defn- handle/listed-tuple+ [type-declaration]
192 |   (def [additional-names handler] (handle/listed-array type-declaration))
193 |   [additional-names (struct/with-proto handler
194 |     :value (rewrite-value handler :variadic+)
195 |     :finish (fn [arr]
196 |       (if (empty? arr)
197 |         (missing-required-argument))
198 |       (tuple/slice arr)))])
199 | 
200 | (defn- handle/escape [&opt type-declaration]
201 |   (if (nil? type-declaration)
202 |     [[] {:symless true :value :soft-escape}]
203 |     (do
204 |       (def [additional-names handler] (handle/listed-tuple type-declaration))
205 |       [additional-names (struct/with-proto handler
206 |         :value (rewrite-value handler :greedy))])))
207 | 
208 | # returns a tuple of [additional-names handler]
209 | (defn- parse-form-handler [form]
210 |   (when (empty? form)
211 |     (errorf "unable to parse form %q" form))
212 | 
213 |   (defn arity [op args min max]
214 |     (when (< (length args) min)
215 |       (errorf "not enough arguments to %q" op))
216 |     (when (> (length args) max)
217 |       (errorf "too many arguments to %q" op))
218 |     args)
219 | 
220 |   (def [op & args] form)
221 |   (case op
222 |     'quasiquote (handle/required form)
223 |     'required (handle/required ;(arity op args 1 1))
224 |     'optional (handle/optional ;(arity op args 1 2))
225 |     'last (handle/last ;(arity op args 1 2))
226 |     'last+ (handle/last+ ;(arity op args 1 1))
227 |     'counted (handle/counted ;(arity op args 0 0))
228 |     'flag (handle/flag ;(arity op args 0 0))
229 |     'escape (handle/escape ;(arity op args 0 1))
230 |     'effect (handle/effect ;(arity op args 1 1))
231 |     'tuple (handle/listed-tuple ;(arity op args 1 1))
232 |     'tuple+ (handle/listed-tuple+ ;(arity op args 1 1))
233 |     'array (handle/listed-array ;(arity op args 1 1))
234 |     'array+ (handle/listed-array+ ;(arity op args 1 1))
235 |     (errorf "unknown operation %q" op)))
236 | 
237 | (defn- parse-handler [form]
238 |   (case (type+ form)
239 |     :tuple-parens (parse-form-handler form)
240 |     :keyword (handle/required form)
241 |     :struct (handle/required form)
242 |     :table (handle/required form)
243 |     (errorf "unknown handler %q" form)))
244 | 
245 | (defn- finish-param [ctx param next-state]
246 |   (def {:names names :sym sym :doc doc-string :handler handler} param)
247 | 
248 |   (when (nil? handler)
249 |     (errorf "no handler for %s" sym))
250 | 
251 |   (def [additional-names handler] (parse-handler handler))
252 |   (def names
253 |     (if (empty? additional-names)
254 |       names
255 |       (do
256 |         (assertf (empty? names) "you must specify all aliases for %s inside {}" sym)
257 |         additional-names)))
258 | 
259 |   (def symless? (handler :symless))
260 |   (def soft-escape? (= (handler :value) :soft-escape))
261 |   (assert (or sym symless?)
262 |     "only soft escapes and effects can be anonymous")
263 |   (def sym (if symless? (gensym) sym))
264 | 
265 |   (each name names
266 |     (when (in (ctx :names) name)
267 |       (errorf "multiple parameters named %s" name))
268 |     (put (ctx :names) name sym))
269 | 
270 |   (when ((ctx :params) sym)
271 |     (errorf "duplicate parameter %s" sym))
272 | 
273 |   (def positional? (empty? names))
274 | 
275 |   (when positional?
276 |     (assertf (not symless?)
277 |       "positional argument needs a valid symbol")
278 |     (assert (not= (ctx :variadic-positional) :greedy)
279 |       "only the final positional parameter can have an escape handler")
280 |     (def value-handling (handler :value))
281 |     (cond
282 |       (= value-handling :none) (errorf "illegal handler for positional argument %s" sym)
283 |       (or (= value-handling :variadic)
284 |           (= value-handling :variadic+)
285 |           (= value-handling :greedy))
286 |         (do
287 |           (assert (nil? (ctx :variadic-positional))
288 |             "you cannot specify specify multiple variadic positional parameters")
289 |           (put ctx :variadic-positional value-handling))))
290 | 
291 |   (def param (if positional?
292 |     {:doc doc-string
293 |      :handler handler
294 |      :sym sym}
295 |     {:doc doc-string
296 |      :names names
297 |      :handler handler}))
298 | 
299 |   (put (ctx :params) sym param)
300 | 
301 |   (if positional?
302 |     (array/push (ctx :positional-params) param)
303 |     (put (ctx :named-params) sym param))
304 | 
305 |   (goto-state ctx next-state))
306 | 
307 | (var- state/param nil)
308 | 
309 | (defn- symbol-of-name [name]
310 |   (def base (string/triml name "-"))
311 |   (if (empty? base) nil (symbol base)))
312 | 
313 | (defn- new-param-state [spec-names]
314 |   (assertf (not (empty? spec-names))
315 |     "unexpected token %q" spec-names)
316 |   (def first-name (first spec-names))
317 |   (assertf (all symbol? spec-names)
318 |     "unexpected token %q" spec-names)
319 | 
320 |   (def [sym param-names]
321 |     (if (named-param? first-name)
322 |       [(symbol-of-name first-name) spec-names]
323 |       [first-name (drop 1 spec-names)]))
324 | 
325 |   (each param param-names
326 |     (unless (named-param? param)
327 |       (errorf "all aliases must start with - %q" spec-names)))
328 | 
329 |   (def param-names (map string param-names))
330 | 
331 |   (table/setproto @{:names param-names :sym sym} state/param))
332 | 
333 | # TODO: there should probably be an escape hatch to declare a dynamic docstring.
334 | # Right now the doc string has to be a string literal, which is limiting.
335 | (set state/param
336 |   @{:on-string (fn [self ctx str]
337 |       (when (self :doc)
338 |         (error "docstring already set"))
339 |       (set (self :doc) str))
340 |     :on-param (fn [self ctx names]
341 |       (finish-param ctx self (new-param-state names)))
342 |     :on-other (fn [self ctx expr]
343 |       (when-let [handler (self :handler)]
344 |         (errorf "multiple handlers specified for %s (got %q, already have %q)"
345 |           (display-name self) expr handler))
346 |       (set (self :handler) expr))
347 |     :on-eof (fn [self ctx] (finish-param ctx self nil))})
348 | 
349 | (defn- set-ctx-doc [self ctx expr]
350 |   (assertf (nil? (ctx :doc)) "unexpected token %q" expr)
351 |   (set (ctx :doc) expr))
352 | 
353 | (def- state/pending
354 |   @{:on-string set-ctx-doc
355 |     :on-param (fn [self ctx names] (goto-state ctx (new-param-state names)))
356 |     :on-other set-ctx-doc
357 |     :on-eof (fn [_ _])})
358 | 
359 | (def- state/initial
360 |   (table/setproto
361 |     @{:on-other (fn [self ctx token]
362 |       (set-ctx-doc self ctx token)
363 |       (goto-state ctx state/pending))}
364 |     state/pending))
365 | 
366 | (defn- add-help [ctx]
367 |   # this could be cleaner... the whole ctx state parsing
368 |   # thing is a little janky
369 |   (def public-help-name "--help")
370 |   (unless (nil? ((ctx :names) public-help-name))
371 |     (break))
372 |   (def default-help-names [public-help-name "-h" "-?"])
373 |   (def help-names (seq [name :in default-help-names :when (hasnt? (ctx :names) name)] name))
374 |   (unless (empty? help-names)
375 |     (def [_ handler] (handle/effect (defn []
376 |       (help/simple (dyn *spec*))
377 |       (os/exit 0))))
378 |     (def help-param
379 |       {:names [public-help-name]
380 |        :doc "Print this help text and exit"
381 |        :handler handler})
382 |     (def help-sym (gensym))
383 |     (each name help-names
384 |       (put! (ctx :names) name help-sym))
385 |     (put! (ctx :named-params) help-sym help-param)
386 |     (put! (ctx :params) help-sym help-param)))
387 | 
388 | # Returns an abstract syntax tree
389 | # that can be evaluated to produce
390 | # a spec
391 | (defn parse-specification [spec]
392 |   (def ctx
393 |     @{:params @{} # symbol -> param
394 |       :named-params @{} # symbol -> param
395 |       :positional-params @[]
396 |       :names @{} # string -> symbol
397 |       :variadic-positional nil
398 |       :state state/initial
399 |       :doc nil
400 |       })
401 | 
402 |   (each token spec
403 |     (def state (ctx :state))
404 |     (case (type+ token)
405 |       :string (:on-string state ctx token)
406 |       :tuple-brackets (:on-param state ctx token)
407 |       :symbol (:on-param state ctx [token])
408 |       (:on-other state ctx token)))
409 |   (:on-eof (ctx :state) ctx)
410 |   (add-help ctx)
411 |   ctx)
412 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # `cmd`
  2 | 
  3 | `cmd` is a Janet library for parsing command-line arguments. It features:
  4 | 
  5 | - parsing named and positional arguments
  6 | - autogenerated `--help` text
  7 | - hierarchical subcommands
  8 | - custom type parsers
  9 | - two kinds of `--` escapes
 10 | - no dependencies
 11 | - pure Janet
 12 | 
 13 | If you want to use `cmd`, add it to the `dependencies` in your `project.janet` file like this:
 14 | 
 15 | ```janet
 16 | (declare-project
 17 |   :name "my-neat-command-line-app"
 18 |   :dependencies [
 19 |     {:url "https://github.com/ianthehenry/cmd.git"
 20 |      :tag "v1.1.0"}
 21 |   ])
 22 | ```
 23 | 
 24 | # Example
 25 | 
 26 | A minimal usage in a script looks like this:
 27 | 
 28 | ```janet
 29 | (import cmd)
 30 | 
 31 | (cmd/def
 32 |   --greeting (optional :string "Hello")
 33 |   name :string)
 34 | 
 35 | (printf "%s, %s!" greeting name)
 36 | ```
 37 | ```
 38 | $ greet Janet
 39 | Hello, Janet!
 40 | ```
 41 | ```
 42 | $ greet Janet --greeting "Howdy there"
 43 | Howdy there, Janet!
 44 | ```
 45 | 
 46 | While a compiled program looks like this:
 47 | 
 48 | ```janet
 49 | (import cmd)
 50 | 
 51 | (cmd/main (cmd/fn
 52 |   [--greeting (optional :string "Hello")
 53 |    name :string]
 54 |   (printf "%s, %s!" greeting name)))
 55 | ```
 56 | 
 57 | By adding a few more annotations, `cmd` will autogenerate nice `--help` output as well:
 58 | 
 59 | ```janet
 60 | (import cmd)
 61 | 
 62 | (cmd/def "Print a friendly greeting"
 63 |   --greeting (optional :string "Hello")
 64 |     "What to say. Defaults to hello."
 65 |   name ["NAME" :string])
 66 | 
 67 | (printf "%s, %s!" greeting name)
 68 | ```
 69 | 
 70 | ```
 71 | $ greet --help
 72 | Print a friendly greeting
 73 | 
 74 |   greet NAME
 75 | 
 76 | === flags ===
 77 | 
 78 |   [--greeting STRING] : What to say. Defaults to hello.
 79 |   [--help]            : Print this help text and exit
 80 | ```
 81 | 
 82 | # API
 83 | 
 84 | You will mostly use the following macros:
 85 | 
 86 | - `(cmd/def DSL)` parses `(cmd/args)` immediately and puts the results in the current scope. You can use this to quickly parse arguments in scripts.
 87 | - `(cmd/fn "docstring" [DSL] & body)` returns a simple command, which you can use in a `cmd/group`.
 88 | - `(cmd/group "docstring" & name command)` returns a command made up of subcommands created from `cmd/fn` or `cmd/group`.
 89 | - `(cmd/main command)` declares a function called `main` that ignores its arguments and then calls `(cmd/run command (cmd/args))`.
 90 | 
 91 | There are also some convenience helpers:
 92 | 
 93 | - `(cmd/peg name ~(<- (some :d)))` returns an argument parser that uses the provided PEG, raising if the PEG fails to parse or if it does not produce exactly one capture. You can use this to easily create custom types.
 94 | - `(cmd/defn name "docstring" [DSL] & body)` gives a name to a simple command.
 95 | - `(cmd/defgroup name "docstring" & name command)` gives a name to a command group.
 96 | 
 97 | You probably won't need to use any of these, but if you want to integrate `cmd` into an existing project you can use some lower level helpers:
 98 | 
 99 | - `(cmd/spec DSL)` returns a spec as a first-class value.
100 | - `(cmd/parse spec args)` parses the provided arguments according to the spec, and returns a table of *keywords*, not symbols. Note that this might have side effects if you supply an `(effect)` argument (like `--help`).
101 | - `(cmd/run command args)` runs a command returned by `(cmd/fn)` or `(cmd/group)` with the provided arguments.
102 | - `(cmd/print-help command)` prints the help for a command.
103 | - `(cmd/args)` returns `(dyn *args*)`, normalized according to the rules described below.
104 | 
105 | There is currently no way to produce a command-line spec except by using the DSL, so it's difficult to construct one dynamically.
106 | 
107 | # Aliases
108 | 
109 | You can specify multiple aliases for named parameters:
110 | 
111 | ```janet
112 | (cmd/def
113 |   [--foo -f] :string)
114 | (print foo)
115 | ```
116 | ```
117 | $ run -f hello
118 | hello
119 | ```
120 | 
121 | By default `cmd` will create a binding based on the first provided alias. If you want to change this, specify a symbol without any leading dashes:
122 | 
123 | ```janet
124 | (cmd/def
125 |   [custom-name --foo -f] :string)
126 | (print custom-name)
127 | ```
128 | ```
129 | $ run -f hello
130 | hello
131 | ```
132 | 
133 | # Handlers
134 | 
135 | Named parameters can have the following handlers:
136 | 
137 | | Count     | `--param`        | `--param value`            |
138 | | ----------|------------------|----------------------------|
139 | | 1         |                  | `required`                 |
140 | | 0 or 1    | `flag`, `effect` | `optional`                 |
141 | | 0 or more | `counted`        | `tuple`, `array`, `last`  |
142 | | 1 or more |                  | `tuple+`, `array+`, `last+` |
143 | 
144 | Positional parameters can only have the values in the rightmost column.
145 | 
146 | There is also a special handler called `(escape)`, described below.
147 | 
148 | ## `(required type)`
149 | 
150 | You can omit this handler if your type is a keyword, struct, table, or inline PEG. The following are equivalent:
151 | 
152 | ```janet
153 | (cmd/def
154 |   --foo :string)
155 | ```
156 | ```janet
157 | (cmd/def
158 |   --foo (required :string))
159 | ```
160 | 
161 | However, if you are providing a custom type parser, you need to explicitly specify the `required` handler.
162 | 
163 | ```janet
164 | (defn my-custom-parser [str] ...)
165 | (cmd/def
166 |   --foo (required my-custom-parser))
167 | ```
168 | 
169 | ## `(optional type &opt default)`
170 | 
171 | ```janet
172 | (cmd/def
173 |   --foo (optional :string "default value"))
174 | (print foo)
175 | ```
176 | ```
177 | $ run --foo hello
178 | hello
179 | 
180 | $ run
181 | default value
182 | ```
183 | 
184 | If left unspecified, the default default value is `nil`.
185 | 
186 | ## `(flag)`
187 | 
188 | ```janet
189 | (cmd/def
190 |   --dry-run (flag))
191 | (printf "dry run: %q" dry-run)
192 | ```
193 | ```
194 | $ run
195 | dry run: false
196 | 
197 | $ run --dry-run
198 | dry run: true
199 | ```
200 | 
201 | ## `(counted)`
202 | 
203 | ```janet
204 | (cmd/def
205 |   [verbosity -v] (counted))
206 | (printf "verbosity level: %q" verbosity)
207 | ```
208 | ```
209 | $ run
210 | verbosity: 0
211 | 
212 | $ run -vvv
213 | verbosity: 3
214 | ```
215 | 
216 | ## `({array,tuple}{,+} type)`
217 | 
218 | ```janet
219 | (cmd/def
220 |   [words --word] (tuple :string))
221 | (pp words)
222 | ```
223 | ```
224 | $ run --word hi --word bye
225 | ("hi" "bye")
226 | ```
227 | 
228 | `(tuple+)` and `(array+)` require that at least one argument is provided.
229 | 
230 | ## `(last type &opt default)` and `(last+ type)`
231 | 
232 | `last` is like `optional`, but the parameter can be specified multiple times, and only the last argument matters.
233 | 
234 | `last+` is like `required`, but the parameter can be specified multiple times, and only the last argument matters.
235 | 
236 | ```janet
237 | (cmd/def
238 |   --foo (last :string "default"))
239 | (print foo)
240 | ```
241 | ```
242 | $ run
243 | default
244 | 
245 | $ run --foo hi --foo bye
246 | bye
247 | ```
248 | 
249 | ## `(effect fn)`
250 | 
251 | `(effect)` allows you to create a flag that, when supplied, calls an arbitrary function.
252 | 
253 | ```janet
254 | (cmd/def
255 |   --version (effect (fn []
256 |     (print "1.0")
257 |     (os/exit 0))))
258 | ```
259 | ```
260 | $ run --version
261 | 1.0
262 | ```
263 | 
264 | You usually don't need to use the `(effect)` handler, because you can do something similar with a `(flag)`:
265 | 
266 | ```janet
267 | (cmd/def
268 |   --version (flag))
269 | (when version
270 |   (print "1.0")
271 |   (os/exit 0))
272 | ```
273 | ```
274 | $ run --version
275 | 1.0
276 | ```
277 | 
278 | There are three differences:
279 | 
280 | - `(effect)`s run even if there are other arguments that did not parse successfully (just as value parsers do).
281 | - `(effect)` handlers do not create bindings.
282 | - `(effect)` handlers run without any of the parsed command-line arguments in scope.
283 | 
284 | `(effect)` mostly exists to support the default `--help` handler, and is a convenient way to specify other "subcommand-like" flags.
285 | 
286 | ## `(escape &opt type)`
287 | 
288 | There are two kinds of escape: hard escape and soft escape.
289 | 
290 | A "soft escape" causes all subsequent arguments to be parsed as positional arguments. Soft escapes will not create a binding.
291 | 
292 | ```janet
293 | (cmd/def
294 |   name :string
295 |   -- (escape))
296 | (printf "Hello, %s!" name)
297 | ```
298 | ```
299 | $ run -- --bobby-tables
300 | Hello, --bobby-tables!
301 | ```
302 | 
303 | A hard escape stops all argument parsing, and creates a new binding that contains all subsequent arguments parsed according to their provided type.
304 | 
305 | ```janet
306 | (cmd/def
307 |   name (optional :string "anonymous")
308 |   --rest (escape :string))
309 | 
310 | (printf "Hello, %s!" name)
311 | (pp rest)
312 | ```
313 | ```
314 | $ run --rest Janet
315 | Hello, anonymous!
316 | ("Janet")
317 | ```
318 | 
319 | # Positional arguments
320 | 
321 | You can mix required, optional, and variadic positional parameters, although you cannot specify more than one variadic positional parameter.
322 | 
323 | ```janet
324 | (cmd/def
325 |   first (required :string)
326 |   second (optional :string)
327 |   third (required :string))
328 | (pp [first second third])
329 | ```
330 | ```
331 | $ run foo bar
332 | ("foo" nil "bar")
333 | 
334 | $ run foo bar baz
335 | ("foo" "bar" "baz")
336 | ```
337 | 
338 | The variadic positional parameter for a spec can be a hard escape, if it appears as the final positional parameter in your spec. The value of a hard positional escape is a tuple containing the value of that positional argument followed by all subsequent arguments (whether or not they would normally parse as `--params`).
339 | 
340 | Only the final positional argument can be an escape, and like normal variadic positional arguments, it will take lower priority than optional positional arguments.
341 | 
342 | ```
343 | (cmd/def
344 |   name (optional :string "anonymous")
345 |   rest (escape :string))
346 | 
347 | (printf "Hello, %s!" name)
348 | (pp rest)
349 | ```
350 | ```
351 | $ run Janet all the other args
352 | Hello, Janet!
353 | ("all" "the" "other" "args")
354 | ```
355 | 
356 | # Enums
357 | 
358 | If the type of a parameter is a struct, it should enumerate a list of named parameters:
359 | 
360 | ```janet
361 | (cmd/def
362 |   format {--text :plain
363 |           --html :rich})
364 | 
365 | (print format)
366 | ```
367 | ```
368 | $ script --text
369 | :plain
370 | ```
371 | 
372 | The keys of the struct are parameter names, and the values of the struct are literal Janet values.
373 | 
374 | You can use structs with the `last` handler to implement a toggleable flag:
375 | 
376 | ```janet
377 | (cmd/def
378 |   verbose (last {--verbose true --no-verbose :false} false)
379 | 
380 | (print verbose)
381 | ```
382 | ```
383 | $ run --verbose --verbose --no-verbose
384 | false
385 | ```
386 | 
387 | You can specify aliases inside a struct like this:
388 | 
389 | ```janet
390 | (cmd/def
391 |   format {[--text -t] :plain
392 |           --html :rich})
393 | 
394 | (print format)
395 | ```
396 | ```
397 | $ script -t
398 | :plain
399 | ```
400 | 
401 | # Variants
402 | 
403 | If the type of a parameter is a table, it's parsed similarly to an enum, but will result in a value of the form `[:tag arg]`.
404 | 
405 | ```janet
406 | (cmd/def
407 |   format @{--text :string
408 |            --html :string})
409 | (pp format)
410 | ```
411 | ```
412 | $ run --text ascii
413 | (:text "ascii")
414 | 
415 | $ run --html utf-8
416 | (:html "utf-8")
417 | ```
418 | 
419 | You can also specify an arbitrary expression to use as a custom tag, by making the values of the table bracketed tuples of the form `[tag type]`:
420 | 
421 | ```janet
422 | (cmd/def
423 |   format @{--text :string
424 |            --html [(+ 1 2) :string]})
425 | (pp format)
426 | ```
427 | ```
428 | $ run --text ascii
429 | (:text "ascii")
430 | 
431 | $ run --html utf-8
432 | (3 "utf-8")
433 | ```
434 | 
435 | # Argument types
436 | 
437 | There are a few built-in argument parsers:
438 | 
439 | - `:string`
440 | - `:file` - like `:string`, but prints differently in help output
441 | - `:number`
442 | - `:int` - any integer, positive or negative
443 | - `:int+` - non-negative integer (`>= 0`)
444 | - `:int++` - positive integer (`> 0`)
445 | 
446 | You can also use any function as an argument. It should take a single string, and return the parsed value or `error` if it could not parse the argument.
447 | 
448 | There is also a helper, `cmd/peg`, which you can use to create ad-hoc argument parsers:
449 | 
450 | ```janet
451 | (def host-and-port (cmd/peg "HOST:PORT" ~(group (* (<- (to ":")) ":" (number :d+)))))
452 | (cmd/def address (required host-and-port))
453 | (def [host port] address)
454 | (print "host = " host ", port = " port)
455 | ```
456 | 
457 | 
458 | # Help
459 | 
460 | `cmd` will automatically generate a `--help` flag that prints the full docstring for a command.
461 | 
462 | When printing the help for groups, `cmd` will only print the first line of each subcommand's docstring.
463 | 
464 | You can give useful names to arguments by replacing argument types with a tuple of `["ARG-NAME" type]`. For example:
465 | 
466 | ```janet
467 | (def name ["NAME" :string])
468 | (cmd/def 
469 |   name (required name))
470 | (printf "Hello, %s!" name)
471 | ```
472 | ```
473 | $ greet --help
474 |   script.janet NAME
475 | 
476 | === flags ===
477 | 
478 |   [--help] : Print this help text and exit
479 | ```
480 | 
481 | If you're supplying an argument name for a required parameter, you must use an explicit `(required)` clause: `--foo (required ["ARG" :string])`, not `--foo ["ARG" :string]`.
482 | 
483 | If you're writing a variant, the argument name must come after the tag:
484 | 
485 | ```janet
486 | (cmd/def 
487 |   variant @{--foo [:tag ["ARG" :string]]})
488 | ```
489 | 
490 | # Argument normalization
491 | 
492 | By default, `cmd` performs the following normalizations:
493 | 
494 | | Before       | After          |
495 | |--------------|----------------|
496 | | `-xyz`       | `-x -y -z`     |
497 | | `--foo=bar`  | `--foo bar`    |
498 | | `-xyz=bar`   | `-x -y -z bar` |
499 | 
500 | Additionally, `cmd` will detect when your script is run with the Janet interpreter (`janet foo.janet --flag`), and will automatically ignore the `foo.janet` argument.
501 | 
502 | You can bypass these normalizations by using `cmd/parse` or `cmd/run`, which will parse exactly the list of arguments you provide them.
503 | 
504 | # Missing features
505 | 
506 | These are not fundamental limitations of this library, but merely unimplemented features that you might wish for. If you wish for them, let me know!
507 | 
508 | - You cannot make "hidden" aliases. All aliases will appear in the help output.
509 | - You cannot specify separate docstrings for different enum or variant choices. All of the parameters will be grouped into a single entry in the help output, so the docstring has to describe all of the choices.
510 | - There is no good way to re-use common flags across multiple subcommands.
511 | - There is no auto-generated shell completion file, even though we have sufficient information to create one.
512 | 
513 | # Changelog
514 | 
515 | ## v1.1.0 - 2023-06-19
516 | 
517 | - Docstrings no longer have to be string literals, so you can construct a dynamic docstring with `(string/format ...)`. Note that the expression has to be a form to disambiguate it from a parameter name, so if you have the docstring in a variable already you have to write `(|docstring)` instead of `docstring` in order for the macro to parse it correctly.
518 | - `cmd/parse` now errors if there was a parse error, instead of returning just the arguments that parsed correctly
519 | 
520 | ## `v1.0.4` - 2023-04-12
521 | 
522 | - Fix `--help` output when used in a compiled executable.
523 | 
524 | ## `v1.0.3` - 2023-04-12
525 | 
526 | - Fix `cmd` when used in a compiled executable.
527 | 
528 | ## `v1.0.2` - 2023-04-02
529 | 
530 | - `--help` output only prints the basename of the executable in the usage line, regardless of the path that it was invoked with
531 | - `--help` output for `group`ed commands now includes the subcommand path in the usage line
532 | - positional arguments print more nicely in the usage line
533 | 
534 | ## `v1.0.1` - 2023-03-22
535 | 
536 | - improved error message for unknown subcommands when using `cmd/group`
537 | - `cmd/peg` can now take a pre-compiled PEG
538 | 
539 | ## `v1.0.0` - 2023-03-05
540 | 
541 | - Initial release.
542 | 


--------------------------------------------------------------------------------