patrick.sirref.org
Shells in OCaml
1module Variables = Map.Make (String)
2
3type attributes = { export : bool; readonly : bool }
4
5let default_attribute = { export = false; readonly = false }
6
7type t = {
8 cwd : Fpath.t;
9 functions : Merry.Function.t list;
10 root : int;
11 outermost : bool;
12 home : string;
13 variables : (attributes * string) Variables.t;
14}
15
16let update ?(export = false) ?(readonly = false) t ~param v =
17 match Variables.find_opt param t.variables with
18 | Some ({ readonly = true; _ }, _) ->
19 Error (Fmt.str "%s: readonly variable" param)
20 | _ ->
21 let attr = { export; readonly } in
22 let variables' = Variables.add param (attr, v) t.variables in
23 Ok { t with variables = variables' }
24
25let seed_env () =
26 let env = Merry.Eunix.env () in
27 List.fold_left
28 (fun vars (param, v) ->
29 Variables.add param ({ default_attribute with export = true }, v) vars)
30 Variables.empty env
31
32let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root")
33 ?variables cwd =
34 let variables = match variables with None -> seed_env () | Some v -> v in
35 { cwd; functions; root; outermost; home; variables }
36
37let cwd t = t.cwd
38let set_cwd t cwd = { t with cwd }
39let expand t = function `Tilde -> t.home
40let lookup t ~param = Variables.find_opt param t.variables |> Option.map snd
41
42let remove ~param t =
43 match Variables.find_opt param t.variables with
44 | None -> (false, t)
45 | Some _ -> (true, { t with variables = Variables.remove param t.variables })
46
47let exports t =
48 Variables.to_list t.variables
49 |> List.filter_map (function
50 | p, ({ export = true; _ }, v) -> Some (p, v)
51 | _ -> None)
52
53let readonly t =
54 Variables.to_list t.variables
55 |> List.filter_map (function
56 | p, ({ readonly = true; _ }, v) -> Some (p, v)
57 | _ -> None)
58
59let pp_readonly fmt t =
60 let rs = readonly t in
61 let rs = List.map (fun (p, cst) -> ("readonly " ^ p, cst)) rs in
62 Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string)))
63 fmt rs
64
65let pp_export fmt t =
66 let rs = exports t in
67 let rs = List.map (fun (p, cst) -> ("export " ^ p, cst)) rs in
68 Fmt.(list ~sep:(Fmt.any "\n") (pair ~sep:(Fmt.any "=") string (quote string)))
69 fmt rs
70
71let dump ppf s =
72 Fmt.pf ppf "Variables:[%a]"
73 Fmt.(list ~sep:Fmt.comma (pair string string))
74 (Variables.to_list s.variables |> List.map (fun (s, (_, v)) -> (s, v)))