ryan.freumh.org
forked from
patrick.sirref.org/merry
Shells in OCaml
1(* The shell exit applicative? This is very like the result monad,
2 except modelled around a shell's exit status codes *)
3
4type should_exit = {
5 interactive : [ `Yes | `No ];
6 non_interactive : [ `Yes | `No ];
7}
8
9let default_should_exit = { interactive = `No; non_interactive = `Yes }
10
11type 'a t =
12 | Zero of 'a
13 | Nonzero of {
14 value : 'a;
15 exit_code : int;
16 message : string option;
17 should_exit : should_exit;
18 }
19
20let ignore = function
21 | Zero _ -> Zero ()
22 | Nonzero v -> Nonzero { v with value = () }
23
24let value = function Zero v -> v | Nonzero { value; _ } -> value
25
26let not = function
27 | Zero value ->
28 Nonzero
29 {
30 value;
31 exit_code = 1;
32 message = None;
33 should_exit = default_should_exit;
34 }
35 | Nonzero { value; _ } -> Zero value
36
37let zero v = Zero v
38
39let nonzero ?message ?(should_exit = default_should_exit) value exit_code =
40 Nonzero { value; exit_code; message; should_exit }
41
42let code = function Zero _ -> 0 | Nonzero { exit_code; _ } -> exit_code
43
44let nonzero_msg ?(exit_code = 1) ?(should_exit = default_should_exit) value fmt
45 =
46 Fmt.kstr
47 (fun message ->
48 Nonzero { value; exit_code; message = Some message; should_exit })
49 fmt
50
51let map ~f = function
52 | Zero v -> Zero (f v)
53 | Nonzero ({ value; _ } as v) -> Nonzero { v with value = f value }
54
55let map_zero ~f = function Zero v -> f v | Nonzero x -> Nonzero x
56
57let map' ~zero ~nonzero = function
58 | Zero v -> Zero (zero v)
59 | Nonzero v -> Nonzero { v with value = nonzero v.value }
60
61let is_nonzero = function Zero _ -> false | Nonzero _ -> true
62let is_zero = function Zero _ -> true | Nonzero _ -> false
63
64let pp ppf = function
65 | Zero _ -> Fmt.string ppf "zero"
66 | Nonzero _ -> Fmt.string ppf "nonzero"
67
68module Syntax = struct
69 let ( >|= ) x f = map ~f x
70 let ( >>= ) x f = map_zero ~f x
71 let ( let+ ) = ( >|= )
72end