Source file env.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
module Var = struct
  module T = struct
    type t = string
    let compare =
      if Sys.win32 then (
        fun a b -> String.compare (String.lowercase a) (String.lowercase b)
      ) else (
        String.compare
      )
  end
  module Set = Set.Make(T)
  include T
end

module Map = Map.Make(Var)

type t =
  { vars : string Map.t
  ; mutable unix : string array option
  }

let make vars =
  { vars
  ; unix = None
  }

let empty = make Map.empty

let vars t = Var.Set.of_list (Map.keys t.vars)

let get t k = Map.find t.vars k

let to_unix t =
  match t.unix with
  | Some v -> v
  | None ->
    let res =
      Map.foldi ~init:[] ~f:(fun k v acc ->
        (Printf.sprintf "%s=%s" k v)::acc
      ) t.vars
      |> Array.of_list in
    t.unix <- Some res;
    res

let of_unix arr =
  Array.to_list arr
  |> List.map ~f:(fun s ->
    match String.lsplit2 s ~on:'=' with
    | None ->
      Exn.code_error "Env.of_unix: entry without '=' found in the environ"
        ["var", Sexp.Encoder.string s]
    | Some (k, v) -> (k, v))
  |> Map.of_list_multi
  |> Map.map ~f:(function
    | [] -> assert false
    | x::_ -> x)

let initial = make (of_unix (Unix.environment ()))

let add t ~var ~value =
  make (Map.add t.vars var value)

let remove t ~var =
  make (Map.remove t.vars var)

let extend t ~vars =
  make (Map.union t.vars vars ~f:(fun _ _ v -> Some v))

let extend_env x y =
  extend x ~vars:y.vars

let to_sexp t =
  let open Sexp.Encoder in
  (list (pair string string)) (Map.to_list t.vars)

let diff x y =
  Map.merge x.vars y.vars ~f:(fun _k vx vy ->
    match vy with
    | Some _ -> None
    | None -> vx)
  |> make

let update t ~var ~f =
  make (Map.update t.vars var ~f)

let of_string_map m =
  make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m)

let iter t =
  Map.iteri t.vars

let pp fmt t = Sexp.pp fmt (to_sexp t)

let cons_path t ~dir =
  make (Map.update t.vars "PATH"
          ~f:(fun _PATH -> Some (Bin.cons_path dir ~_PATH)))

let path env =
  match get env "PATH" with
  | None   -> []
  | Some s -> Bin.parse_path s