Something went wrong. Try again.
Shells in OCaml
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty
module Make (S : Types.State) (F : Types.Fd) (E : Types.Exec) (H : Types.History) =struct module Eval = Eval.Make (S) (F) (E)
let pp_colored c pp fmt v = Fmt.pf fmt "%a" (Fmt.styled (`Fg c) pp) v
let subst_tilde ctx path = match S.lookup (Eval.state ctx) ~param:"HOME" with | None -> path | Some home -> ( let home = Ast.Fragment.join_list ~sep:"" home in match Fpath.rem_prefix (Fpath.v home) path with | Some rel -> Fpath.(v "~" // rel) | None -> path)
let default_prompt (ctx : Eval.t Exit.t) = let state = match ctx with | Exit.Zero ctx | Exit.Nonzero { value = ctx; _ } -> Eval.state ctx in let pp_status ppf = function | Exit.Zero _ -> () | Exit.Nonzero { exit_code; _ } -> Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code in let fs = Exit.value ctx |> Eval.env |> fun env -> env#fs in Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx Fmt.(pp_colored `Yellow string) (Eunix.get_user_and_host fs) (Fpath.normalize @@ S.cwd state |> subst_tilde (Exit.value ctx) |> Fpath.to_string); Format.flush_str_formatter ()
let resolve_programs ctx name = if not (String.contains name '/') then begin S.path (Eval.state ctx) |> Option.value ~default:[ "/bin"; "/usr/bin" ] |> List.concat_map (fun dir -> let files = try Sys.readdir dir |> Array.to_list with _ -> [] in List.filter (fun f -> String.starts_with ~prefix:name f) files) end else if Sys.file_exists name then [ name ] else []
let complete ctx ~home path = let rest, last_arg = String.split_on_char ' ' path |> List.rev |> function | [] -> ([], `None) | [ prog ] -> ([], `Prog prog) | x :: rest -> (List.rev rest, `Path x) in let completions from_path basename = match (Unix.stat from_path).st_kind with | S_DIR -> let entries = Sys.readdir from_path |> Array.to_list in List.filter_map (fun e -> match basename with | None -> Some e | Some prefix -> if String.starts_with ~prefix e then Some e else None) entries |> List.map (fun e -> Filename.concat from_path e) |> List.map (fun p -> String.concat " " (rest @ [ p ])) | S_REG -> [ String.concat " " (rest @ [ path ]) ] | _ -> [] | exception Unix.Unix_error (Unix.ENOTDIR, _, _) -> [] | exception Unix.Unix_error (Unix.ENOENT, _, _) -> [] in match last_arg with | `None -> [] | `Prog prog -> resolve_programs ctx prog | `Path path -> ( (* We should probably thread expansion logic from the evaluator back into this, but for now we manually, and crudely, expand the tilde if it is there. *) let path = match String.get path 0 with | '~' -> home ^ String.sub path 1 (String.length path - 1) | _ | (exception Invalid_argument _) -> path in match Unix.(stat path).st_kind with | exception Unix.Unix_error ((Unix.ENOENT | Unix.ENOTDIR), _, _) -> let dirname = Filename.dirname path in let basename = match Filename.basename path with "." | "" -> None | p -> Some p in completions dirname basename | S_DIR -> completions path None | _ -> [])
let fragments_to_string = function | None -> None | Some lst -> Some (Ast.Fragment.join_list ~sep:"" lst)
let run ?(prompt = default_prompt) bruit_ctx initial_ctx = Sys.set_signal Sys.sigttou Sys.Signal_ignore; Sys.set_signal Sys.sigttin Sys.Signal_ignore; Sys.set_signal Sys.sigtstp Sys.Signal_ignore; Sys.set_signal Sys.sigint Sys.Signal_ignore; let xdg = Xdge.create (Eval.env (Exit.value initial_ctx))#fs "merry" in let history = Eio.Path.(Xdge.data_dir xdg / ".merry_history") in let initial_history = try H.load history with _ -> H.empty in let h = ref initial_history in let add_history c = let c = String.trim c in h := H.add (H.make_entry c) !h in let rec loop (ctx : Eval.t Exit.t) = Option.iter (Fmt.epr "%s%!") (S.lookup (Exit.value ctx |> Eval.state) ~param:"PS1" |> fragments_to_string); let p = prompt ctx in Eio.Flow.copy_string p (Exit.value ctx |> Eval.env)#stdout; Eio.Flow.copy_string "\r" (Exit.value ctx |> Eval.env)#stdout; let hint command = if String.length command < 2 then None else match H.history ~command !h |> H.commands with | [] -> None | x :: _ -> ( match Astring.String.cut ~sep:command x with | Some ("", rest) -> Some (rest, `Fg (`Hi `Magenta)) | _ -> None) in let complete = let ctx = Exit.value ctx in match S.lookup (Eval.state ctx) ~param:"HOME" with | Some home -> complete ctx ~home:(Ast.Fragment.join_list ~sep:"" home) | None -> (* TODO: many shells implement a lookup of passwd to fill this in if no HOME is set. I believe the POSIX specification says "comme vous voulez" *) complete ctx ~home:"/" in match Bruit.bruit ~hint (bruit_ctx ~hint) ~history:(fun command -> H.history ~command !h |> H.commands) ~complete "% " with | String None -> Fmt.pr "exit\n%!"; exit 0 | String (Some c) -> let ast = Ast.of_string (String.trim c) in let ctx', _ast = Eval.run ~make_process_group:false ctx ast in add_history c; H.save !h history; loop ctx' | Ctrl_c -> let c = Exit.value ctx in Eunix.Signals.(raise Interrupt); if Eval.sigint_set c then loop (Exit.zero c) else begin loop (Exit.nonzero c 130) end in loop initial_ctxend