let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty module Make (S : Types.State) (E : Types.Exec) = struct module Eval = Eval.Make (S) (E) let pp_colored c pp fmt v = Fmt.pf fmt "%a" (Fmt.styled (`Fg c) pp) v let subst_tilde path = match Eunix.find_env "HOME" with | None -> path | Some home -> ( match Fpath.rem_prefix (Fpath.v home) path with | Some rel -> Fpath.(v "~" // rel) | None -> path) let default_prompt (ctx : Eval.ctx Exit.t) = let state = match ctx with | Exit.Zero ctx | Exit.Nonzero { value = ctx; _ } -> ctx.state in let pp_status ppf = function | Exit.Zero _ -> () | Exit.Nonzero { exit_code; _ } -> Fmt.pf ppf "[%a] " (pp_colored `Red Fmt.int) exit_code in Fmt.pf Format.str_formatter "%a%a:%s >\n%!" pp_status ctx Fmt.(pp_colored `Yellow string) (Eunix.get_user_and_host ()) (Fpath.normalize @@ S.cwd state |> subst_tilde |> Fpath.to_string); Format.flush_str_formatter () let complete path = let rest, last_arg = String.split_on_char ' ' path |> List.rev |> function | [] -> ([], None) | x :: rest -> (List.rev rest, Some 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.ENOENT, _, _) -> [] in match last_arg with | None -> [] | Some path -> ( match Unix.(stat path).st_kind with | exception Unix.Unix_error (Unix.ENOENT, _, _) -> 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 | _ -> []) (* For now a very simple, prefixed based history *) let h = ref [] let add_history c = let c = String.trim c in let new_h = List.filter (fun s -> not (String.equal c s)) !h in h := c :: new_h let history prefix = if prefix <> "" then List.filter (fun s -> String.starts_with ~prefix s) !h else !h let run ?(prompt = default_prompt) 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; let rec loop (ctx : Eval.ctx Exit.t) = Option.iter (Fmt.epr "%s%!") (S.lookup (Exit.value ctx).state ~param:"PS1" |> Option.map Ast.word_components_to_string); let p = prompt ctx in Fmt.pr "%s\r%!" p; match Bruit.bruit ~history ~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 ctx ast in add_history c; loop ctx' | Ctrl_c -> let c = Exit.value ctx in loop (Exit.nonzero c 130) in loop initial_ctx end