Source file config.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
(*********************************************************************************)
(*  Dunolint - A tool to lint and help manage files in dune projects             *)
(*  Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com>            *)
(*                                                                               *)
(*  This file is part of Dunolint.                                               *)
(*                                                                               *)
(*  Dunolint is free software; you can redistribute it and/or modify it          *)
(*  under the terms of the GNU Lesser General Public License as published by     *)
(*  the Free Software Foundation either version 3 of the License, or any later   *)
(*  version, with the LGPL-3.0 Linking Exception.                                *)
(*                                                                               *)
(*  Dunolint is distributed in the hope that it will be useful, but WITHOUT      *)
(*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        *)
(*  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License  *)
(*  and the file `NOTICE.md` at the root of this repository for more details.    *)
(*                                                                               *)
(*  You should have received a copy of the GNU Lesser General Public License     *)
(*  and the LGPL-3.0 Linking Exception along with this library. If not, see      *)
(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
(*********************************************************************************)

module Running_mode = struct
  type t =
    | Dry_run
    | Check
    | Force_yes
    | Interactive
  [@@deriving compare, equal, sexp_of]
end

type t = { running_mode : Running_mode.t }

let default = { running_mode = Interactive }
let running_mode t = t.running_mode
let create ~running_mode = { running_mode }

let arg =
  let open Command.Std in
  let running_mode
        ((switch :: _ : _ Command.Nonempty_list.t) as switches)
        ~(running_mode : Running_mode.t)
        ~doc
    =
    Arg.flag switches ~doc
    |> Arg.map ~f:(function
      | false -> None
      | true -> Some (switch, running_mode))
  in
  let+ dry_run =
    running_mode
      [ "dry-run" ]
      ~running_mode:Dry_run
      ~doc:"Print what linting actions would be done, but do not actually perform them"
  and+ interactive =
    running_mode
      [ "interactive"; "i" ]
      ~running_mode:Interactive
      ~doc:
        "Ask confirmation before applying each diff. This is the default when stdout is \
         a tty"
  and+ yes =
    running_mode
      [ "yes" ]
      ~running_mode:Force_yes
      ~doc:
        "Disable interactivity when stdout is a tty. Do not ask for confirmation and \
         apply all diffs. This is the default when stdout is *not* a tty"
  and+ check =
    running_mode
      [ "check" ]
      ~running_mode:Check
      ~doc:
        "Print what linting actions would be done, but do not actually perform them. \
         Exit with a non-zero exit code in case some linting changes are required. This \
         execution mode is meant for scripts and CI pipelines"
  in
  let running_mode : Running_mode.t =
    match List.filter_opt [ dry_run; interactive; yes; check ] with
    | [] -> if Unix.isatty Unix.stdout then Interactive else Force_yes
    | [ (_, mode) ] -> mode
    | _ :: _ :: _ as conflicts ->
      Err.raise
        ~exit_code:Err.Exit_code.cli_error
        Pp.O.
          [ Pp.text "Conflicting flags "
            ++ Pp.concat_map ~sep:(Pp.text ", ") conflicts ~f:(fun (flag, _) ->
              Pp_tty.kwd (module String) flag)
            ++ Pp.text ". Please choose one."
          ]
  in
  { running_mode }
;;