package cmdlang-stdlib-runner

  1. Overview
  2. Docs
A basic execution runner for cmdlang based on stdlib.arg

Install

Dune Dependency

Authors

Maintainers

Sources

cmdlang-0.0.9.tbz
sha256=44fc0027cc27a8d6b511bbde81b0d31306ec1a3d599476d5bd058510f39e87ef
sha512=e1a18905ff6035eb4c44aed71df0e3d42b8277db9a6e98fe571a3b17428c9ef0a26006cb27b729a60208a8357398decc6a8601caca74dabd2e6de7636bc60b31

doc/src/cmdlang-stdlib-runner/cmdlang_stdlib_runner.ml.html

Source file cmdlang_stdlib_runner.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
module Arg_runner = Arg_runner
module Arg_state = Arg_state
module Command_selector = Command_selector
module Param_parser = Param_parser
module Parser_state = Parser_state
module Positional_state = Positional_state

let usage_msg
  ~argv
  ~resume_parsing_from_index
  ~summary
  ~readme
  ~subcommands
  ~positional_state
  =
  let usage_prefix =
    Array.sub argv 0 resume_parsing_from_index |> Array.to_list |> String.concat " "
  in
  let subcommands =
    match subcommands with
    | [] -> ""
    | _ :: _ as subcommands ->
      let subcommands =
        subcommands
        |> List.map (fun (name, command) ->
          let summary = Ast.Command.summary command in
          name, summary)
      in
      let padding =
        List.fold_left (fun acc (name, _) -> max acc (String.length name)) 0 subcommands
        + 2
      in
      let items =
        subcommands
        |> List.map (fun (name, summary) ->
          Printf.sprintf "  %-*s   %s" padding name summary)
        |> String.concat "\n"
      in
      "Subcommands:\n" ^ items ^ "\n\n"
  in
  let positional_suffix, positional_state =
    match
      match positional_state with
      | None -> None
      | Some positional_state -> Positional_state.usage_msg positional_state
    with
    | None -> "", ""
    | Some msg -> " [ARGUMENTS]", msg ^ "\n\n"
  in
  Printf.sprintf
    "Usage: %s [OPTIONS]%s\n\n%s\n\n%s%s%sOptions:"
    usage_prefix
    positional_suffix
    summary
    (match readme with
     | None -> ""
     | Some m -> m () ^ "\n\n")
    subcommands
    positional_state
;;

let eval_arg
  (type a)
  ~(arg : a Ast.Arg.t)
  ~summary
  ~readme
  ~subcommands
  ~argv
  ~resume_parsing_from_index
  =
  let state =
    match Parser_state.create arg with
    | Ok state -> state
    | Error (`Msg msg) ->
      let message = "Invalid command specification (programming error):\n\n" ^ msg in
      raise (Arg.Bad message)
  in
  let spec = Parser_state.spec state |> Arg.align in
  let positional_state = Parser_state.positional_state state in
  let anon_fun = Positional_state.anon_fun positional_state in
  let usage_msg ~readme =
    usage_msg
      ~argv
      ~resume_parsing_from_index
      ~summary
      ~readme
      ~subcommands
      ~positional_state:(Some positional_state)
  in
  let () =
    let current = ref (resume_parsing_from_index - 1) in
    try Arg.parse_argv ~current argv spec anon_fun (usage_msg ~readme:None) with
    | Arg.Help _ ->
      (* We rewrite the help in order to add the [readme] section. We do not
         want to add it by default in the [Arg.Bad] case. *)
      let message = Arg.usage_string spec (usage_msg ~readme) in
      raise (Arg.Help message)
  in
  match Parser_state.finalize state with
  | Ok runner -> Arg_runner.eval runner
  | Error parse_error ->
    (match parse_error with
     | Arg_state.Parse_error.Missing_argument
         { names = name :: _; param = _; docv = _; doc = _ } ->
       raise (Arg.Bad (Printf.sprintf "Missing required named argument: %S.\n" name))
     | Arg_state.Parse_error.Missing_positional_argument
         { pos; param = _; docv = _; doc = _ } ->
       raise
         (Arg.Bad
            (Printf.sprintf "Missing required positional argument at position %d.\n" pos)))
;;

let eval_internal (type a) (command : a Ast.Command.t) ~argv =
  let { Command_selector.Selected.command; resume_parsing_from_index } =
    Command_selector.select command ~argv
  in
  match command with
  | Make { arg; summary; readme } ->
    eval_arg ~arg ~summary ~readme ~subcommands:[] ~argv ~resume_parsing_from_index
  | Group { default; summary; readme; subcommands } ->
    (match default with
     | Some arg ->
       eval_arg ~arg ~summary ~readme ~subcommands ~argv ~resume_parsing_from_index
     | None ->
       let message =
         usage_msg
           ~argv
           ~resume_parsing_from_index
           ~summary
           ~readme
           ~subcommands
           ~positional_state:None
       in
       let arg =
         let message = Arg.usage_string [] message in
         Ast.Arg.(Map { x = Return (); f = (fun () -> raise (Arg.Bad message)) })
       in
       eval_arg ~arg ~summary ~readme ~subcommands ~argv ~resume_parsing_from_index)
;;

module To_ast = Cmdlang.Command.Private.To_ast

let eval a ~argv =
  let command = a |> To_ast.command in
  try Ok (eval_internal command ~argv) with
  | Arg.Help msg -> Error (`Help msg)
  | Arg.Bad msg -> Error (`Bad msg)
;;

let eval_exit_code a ~argv =
  match eval a ~argv with
  | Ok () -> 0
  | Error (`Bad msg) ->
    Printf.printf "%s" msg;
    2
  | Error (`Help msg) ->
    Printf.printf "%s" msg;
    0
;;

let run a =
  match eval a ~argv:Sys.argv with
  | Ok a -> a
  | Error (`Bad msg) ->
    Printf.printf "%s" msg;
    exit 2
  | Error (`Help msg) ->
    Printf.printf "%s" msg;
    exit 0
;;
OCaml

Innovation. Community. Security.