this repo has no description
patrick.sirref.org
1open Eio
2
3type error = string
4
5let pp_error = Fmt.string
6
7type config = unit
8
9let config_term = Cmdliner.Term.const ()
10
11type action = Exec of string [@@deriving repr]
12
13let action = action_t
14let action_of_command cmd = Exec cmd
15
16type entry = string [@@derviving repr]
17
18let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty
19
20let prompt _ _ =
21 Fmt.(styled (`Fg `Red) string) Format.str_formatter "shelter-p> ";
22 Format.flush_str_formatter ()
23
24let history_key = [ "history" ]
25let key () = history_key @ [ string_of_float @@ Unix.gettimeofday () ]
26
27type ctx = unit
28
29let init _ _
30 (Shelter.History.Store ((module S), store) : entry Shelter.History.t) =
31 match S.list store history_key with
32 | [] -> ()
33 | xs ->
34 let rec loop acc = function
35 | `Contents (v, _meta) :: next -> loop (v :: acc) next
36 | _ :: next -> loop acc next
37 | [] -> List.rev acc
38 in
39 let entries =
40 loop [] (List.map (fun (_, tree) -> S.Tree.to_concrete tree) xs)
41 in
42 List.iter (fun v -> LNoise.history_add v |> ignore) entries
43
44let run (() : config) ~stdout:_ _fs clock proc
45 ( ((Shelter.History.Store ((module S), store) : entry Shelter.History.t) as
46 full_store),
47 () ) (Exec command) =
48 let info () =
49 S.Info.v ~message:"shelter" (Eio.Time.now clock |> Int64.of_float)
50 in
51 let cmd =
52 String.split_on_char ' ' command
53 |> List.filter (fun v -> not (String.equal "" v))
54 in
55 Switch.run @@ fun sw ->
56 try
57 let proc = Eio.Process.spawn ~sw proc cmd in
58 let res = Eio.Process.await proc in
59 if res = `Exited 0 then (
60 S.set_exn ~info store (key ()) command;
61 let _ : (unit, string) result = LNoise.history_add command in
62 Ok (full_store, ()))
63 else Shelter.process_error (Eio.Process.Child_error res)
64 with Eio.Exn.Io (Eio.Process.E e, _) -> Shelter.process_error e