ns/lib/cmd.ml at fd60abf62e4f1446378348367793745986024b98 · eureka-cpu/ns · GitHub

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
(** Functions and operators used in running commands *)
module Cmd = struct
  open Util.Util

  type strategy =
    { workdir : string
    ; primary : Bos.Cmd.t
    ; fallback : Bos.Cmd.t option
    }

  (** Pipe-arg operator, used in adding arguments to a command *)
  let ( |>+ ) cmd = function
    | [] -> cmd
    | [ arg ] -> Bos.Cmd.add_arg cmd arg
    | args -> List.fold_left (fun cmd arg -> Bos.Cmd.add_arg cmd arg) cmd args
  ;;

  (* TODO: nix develop --ignore-env behaves differently than nix-shell --pure
           which is causing none of the packages to show up. *)
  let nix_develop entrypoint attribute force_experimental_features sh =
    Bos.Cmd.v "nix"
    |>+ [ "develop" ] @ [ Uri.sprintf_uri_attr_opt entrypoint attribute ]
    |>+ Option.value ~default:[] force_experimental_features
    (* |>+ [ "--ignore-env"; "-k"; "TERM"; "-k"; "TERMINFO"; "-k"; "HOME"; "-k"; "USER"; "-k"; "DISPLAY" ] *)
    |>+ [ "--command"; sh ]
  ;;

  let legacy_nix_shell_from_entrypoint entrypoint attribute sh =
    Bos.Cmd.v "nix-shell"
    |>+ Option.value ~default:[] (Option.map (fun attr -> [ "--attr"; attr ]) attribute)
    |>+ [ entrypoint ]
    |>+ [ "--pure" ]
    |>+ [ "--command"; sh ]
  ;;

  let nix_shell installables force_experimental_features sh =
    Bos.Cmd.v "nix"
    |>+ [ "shell" ]
    |>+ installables
    |>+ Option.value ~default:[] force_experimental_features
    |>+ [ "--command"; sh ]
  ;;

  let legacy_nix_shell_from_installables installables sh =
    Bos.Cmd.v "nix-shell" |>+ [ "--packages" ] @ installables |>+ [ "--command"; sh ]
  ;;

  let print_strategy ({ workdir; primary; fallback } : strategy) =
    print_string
      (Printf.sprintf
         "'cd' '%s'\n%s\n%s"
         workdir
         (Bos.Cmd.to_string primary)
         (Option.value ~default:"" (Option.map Bos.Cmd.to_string fallback)))
  ;;

  let execute_strategy ({ workdir; primary; fallback } : strategy) =
    Unix.cd workdir;
    match Bos.OS.Cmd.run_status primary with
    | Ok (`Exited 0) -> () (* success, nothing else to do *)
    | Ok (`Exited code | `Signaled code) ->
      (* primary failed *)
      (match fallback with
       | Some fallback ->
         (* show primary error but don't exit *)
         Printf.eprintf "primary command failed (exit %d), trying fallback\n%!" code;
         (match Bos.OS.Cmd.run_status fallback with
          | Ok (`Exited 0) -> ()
          | Ok (`Exited code | `Signaled code) -> exit code
          | Error (`Msg msg) ->
            prerr_endline msg;
            exit 1)
       | None -> exit code)
    | Error (`Msg msg) ->
      (* primary couldn't even be spawned *)
      prerr_endline msg;
      (match fallback with
       | Some fallback ->
         (match Bos.OS.Cmd.run_status fallback with
          | Ok (`Exited 0) -> ()
          | Ok (`Exited code | `Signaled code) -> exit code
          | Error (`Msg msg) ->
            prerr_endline msg;
            exit 1)
       | None -> exit 1)
  ;;
end