ryan.freumh.org
forked from
patrick.sirref.org/merry
Shells in OCaml
1let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty
2
3module Make (S : Types.State) (E : Types.Exec) (H : Types.History) = struct
4 module Eval = Eval.Make (S) (E)
5
6 let pp_colored c pp fmt v = Fmt.pf fmt "%a" (Fmt.styled (`Fg c) pp) v
7
8 let subst_tilde path =
9 match Eunix.find_env "HOME" with
10 | None -> path
11 | Some home -> (
12 match Fpath.rem_prefix (Fpath.v home) path with
13 | Some rel -> Fpath.(v "~" // rel)
14 | None -> path)
15
16 let default_prompt (ctx : Eval.ctx Exit.t) =
17 let state =
18 match ctx with
19 | Exit.Zero ctx | Exit.Nonzero { value = ctx; _ } -> Eval.state ctx
20 in
21 let pp_status ppf = function
22 | Exit.Zero _ -> ()
23 | Exit.Nonzero { exit_code; _ } ->
24 Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code
25 in
26 Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx
27 Fmt.(pp_colored `Yellow string)
28 (Eunix.get_user_and_host ())
29 (Fpath.normalize @@ S.cwd state |> subst_tilde |> Fpath.to_string);
30 Format.flush_str_formatter ()
31
32 let resolve_programs name =
33 if not (String.contains name '/') then begin
34 Eunix.find_env "PATH"
35 |> Option.value ~default:"/bin:/usr/bin"
36 |> String.split_on_char ':'
37 |> List.concat_map (fun dir ->
38 let files = try Sys.readdir dir |> Array.to_list with _ -> [] in
39 List.filter (fun f -> String.starts_with ~prefix:name f) files)
40 end
41 else if Sys.file_exists name then [ name ]
42 else []
43
44 let complete path =
45 let rest, last_arg =
46 String.split_on_char ' ' path |> List.rev |> function
47 | [] -> ([], `None)
48 | [ prog ] -> ([], `Prog prog)
49 | x :: rest -> (List.rev rest, `Path x)
50 in
51 let completions from_path basename =
52 match (Unix.stat from_path).st_kind with
53 | S_DIR ->
54 let entries = Sys.readdir from_path |> Array.to_list in
55 List.filter_map
56 (fun e ->
57 match basename with
58 | None -> Some e
59 | Some prefix ->
60 if String.starts_with ~prefix e then Some e else None)
61 entries
62 |> List.map (fun e -> Filename.concat from_path e)
63 |> List.map (fun p -> String.concat " " (rest @ [ p ]))
64 | S_REG -> [ String.concat " " (rest @ [ path ]) ]
65 | _ -> []
66 | exception Unix.Unix_error (Unix.ENOENT, _, _) -> []
67 in
68 match last_arg with
69 | `None -> []
70 | `Prog prog -> resolve_programs prog
71 | `Path path -> (
72 match Unix.(stat path).st_kind with
73 | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
74 let dirname = Filename.dirname path in
75 let basename =
76 match Filename.basename path with "." | "" -> None | p -> Some p
77 in
78 completions dirname basename
79 | S_DIR -> completions path None
80 | _ -> [])
81
82 let run ?(prompt = default_prompt) initial_ctx =
83 Sys.set_signal Sys.sigttou Sys.Signal_ignore;
84 Sys.set_signal Sys.sigttin Sys.Signal_ignore;
85 Sys.set_signal Sys.sigtstp Sys.Signal_ignore;
86 Sys.set_signal Sys.sigint Sys.Signal_ignore;
87 let xdg = Xdge.create (Eval.fs (Exit.value initial_ctx)) "merry" in
88 let history = Eio.Path.(Xdge.data_dir xdg / ".merry_history") in
89 let initial_history = try H.load history with _ -> H.empty in
90 let h = ref initial_history in
91 let add_history c =
92 let c = String.trim c in
93 h := H.add (H.make_entry c) !h
94 in
95 let rec loop (ctx : Eval.ctx Exit.t) =
96 Option.iter (Fmt.epr "%s%!")
97 (S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1"
98 |> Option.map Ast.word_components_to_string);
99 let p = prompt ctx in
100 Fmt.pr "%s\r%!" p;
101 match
102 Bruit.bruit
103 ~history:(fun command -> H.history ~command !h |> H.commands)
104 ~complete "% "
105 with
106 | String None ->
107 Fmt.pr "exit\n%!";
108 exit 0
109 | String (Some c) ->
110 let ast = Ast.of_string (String.trim c) in
111 Fmt.pr "\n%!";
112 let ctx', _ast = Eval.run ctx ast in
113 add_history c;
114 H.save !h history;
115 loop ctx'
116 | Ctrl_c ->
117 let c = Exit.value ctx in
118 Eunix.Signals.(raise Interrupt);
119 if Eval.sigint_set c then loop (Exit.zero c)
120 else begin
121 Fmt.pr "\n%!";
122 loop (Exit.nonzero c 130)
123 end
124 in
125 loop initial_ctx
126end