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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
(*─────────────────────────────────────────────────────────────────────────────┐
│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/> │
│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
└─────────────────────────────────────────────────────────────────────────────*)
module Error = Error
module Name = Name
module Manifest = Manifest
module Lockfile = Lockfile
module Input = Input
module Input_foreman = Input_foreman
module Working_directory = Working_directory
module KDL = KDL
type error = Error.error
let meld_input_with_lock (input : Input.t) (lock : Lockfile.Input'.t) : Input.t = {input with
kind = (
match input.kind, lock.kind with
| `File file, `File _ ->
`File file
| `Archive archive, `Archive _ ->
`Archive archive
| `Git git, `Git({datetime; latest_revision; _}: Lockfile.Git.t) ->
`Git {git with datetime; latest_revision}
| `Darcs darcs, `Darcs({datetime; reference; latest_weak_hash; _}: Lockfile.Darcs.t) ->
`Darcs {darcs with
datetime;
latest_weak_hash;
reference = (
match darcs.reference, reference with
| `Context (`Assumed None), `Context (`Assumed Some _) -> reference
| _ -> darcs.reference
);
}
| `Pijul pijul, `Pijul({datetime; latest_state; _}: Lockfile.Pijul.t) ->
`Pijul {pijul with datetime; latest_state}
| _, _ -> failwith "Input kind mismatch."
);
hash = {input.hash with value = lock.hash.value};
latest = {input.latest with value = lock.latest_value}
}
let read_manifest_and_lockfile () : (Name.Name.t list, error) result =
let (let*) = Result.bind in
let* manifest =
Error.tag_manifest @@ begin
match Manifest.read () with
| Ok(kdl : KDL.t) ->
Manifest.document_to_t kdl
|> Result.map_error (fun err -> `Parsing err)
| Error(e : KDL.error) ->
let v_errs : KDL.Valid.err list = [`ParseError e] in
Error (`Parsing v_errs)
end
in
let* lockfile_opt =
Error.tag_lockfile @@ begin
Lockfile.read ()
|> Result.map_error (fun e -> `Parsing e)
end
in
match lockfile_opt with
| Some lock when not (String.equal manifest.version lock.version) ->
Error (`Version_mismatch (manifest.version, lock.version))
| _ ->
let to_input d =
let input = Manifest.Input'.of_manifest d in
let found_input =
Option.bind lockfile_opt (fun lock -> Name.NameMap.find_opt input.name lock.inputs)
in
match found_input with
| None -> input
| Some locked -> meld_input_with_lock input locked
in
Error.tag_input_foreman @@ begin
let rec set_input_htbl ret mnfsts =
match ret, mnfsts with
| Error err, _ -> Error err
| Ok names, [] -> Ok names
| Ok names, d :: ds ->
let input : Input.t = to_input d in
let res =
Input_foreman.add input.name input
|> Result.map (fun () -> input.name :: names)
in
set_input_htbl res ds
in
let* names = set_input_htbl (Ok []) manifest.inputs in
Logs.debug (fun m -> m "Names from reckoning manifest × lockfile: %a" Fmt.(brackets (list ~sep: semi Name.Name.pp)) names);
Ok names
end
let set_up ~env ?nixpkgs: nixpkgs_opt () : (unit, error) result =
let (let*) = Result.bind in
Eio.Switch.run @@ fun sw ->
let proc_mgr = Eio.Stdenv.process_mgr env in
Logs.app (fun m -> m "%t@." Banner.pp);
Working_directory.set_up_root ();
if Manifest.exists () then
begin
Logs.warn (fun m ->
m
"Found existing “%s” file, so project is already set up. Skipping."
Manifest.filename
);
Ok ()
end
else
(* TODO: returns a bool for success, so what to do? *)
let* () =
match nixpkgs_opt with
| None -> Ok ()
| Some npkgs ->
let* () =
Error.tag_input_foreman @@ begin
let* () = Input_foreman.add Input.Nixpkgs.name npkgs in
Input_foreman.lock_one ~env ~sw ~proc_mgr ~force: false ~name: Input.Nixpkgs.name
end
in
let _lockfile = Lockfile.make () in
Ok ()
in
let* () =
Error.tag_manifest @@ begin
let () = Manifest.make () in
Manifest.write ()
end
in
let* () =
Error.tag_lockfile @@ begin
Lockfile.write ~create: (`Exclusive 0o644) ()
end
in
Lock_loader.write ();
Ok ()
let check_soundness ~env: _ () : (unit, error) result =
let (let*) = Result.bind in
let* _all_names = read_manifest_and_lockfile () in
Logs.app (fun m -> m "All sound.");
Ok ()
let tweak ~env () : (unit, error) result =
let working_dir = Working_directory.get () in
let manifest_file : string =
let path = Eio.Path.(working_dir / Manifest.filename) in
Eio.Path.native_exn path
in
let () = Editor.run_on manifest_file in
check_soundness ~env ()
let show ~env: _ () : (unit, error) result =
let (let*) = Result.bind in
let* _all_names = read_manifest_and_lockfile () in
Logs.app (fun m -> m "%t" Input_foreman.pp_for_earthlings);
Ok ()
let lock ~env ~domain_count ?(force = false) ?names () : (unit, error) result =
Eio.Switch.run @@ fun sw ->
let (let*) = Result.bind in
let proc_mgr = Eio.Stdenv.process_mgr env in
let* all_names = read_manifest_and_lockfile () in
let* () =
Error.tag_input_foreman @@ begin
let names =
match names with
| None | Some [] -> all_names
| Some ns -> ns
in
Input_foreman.lock ~env ~sw ~proc_mgr ~domain_count ~force ~names ()
end
in
let* () = Error.tag_lockfile @@ Lockfile.write () in
Lock_loader.write ();
Input_foreman.clean_unlisted_from_silo ();
Ok ()
let list_stale ~env ~domain_count : (unit, error) result =
Eio.Switch.run @@ fun sw ->
let (let*) = Result.bind in
let proc_mgr = Eio.Stdenv.process_mgr env in
let* all_names = read_manifest_and_lockfile () in
Error.tag_input_foreman @@ begin
Input_foreman.list_stale ~env ~sw ~proc_mgr ~domain_count ~names: all_names
end
let refresh ~env ~domain_count ?names () : (unit, error) result =
Eio.Switch.run @@ fun sw ->
let (let*) = Result.bind in
let proc_mgr = Eio.Stdenv.process_mgr env in
let* all_names = read_manifest_and_lockfile () in
let* () =
Error.tag_input_foreman @@ begin
let names =
match names with
| None | Some [] -> all_names
| Some ns -> ns
in
Input_foreman.refresh ~env ~sw ~proc_mgr ~domain_count ~names ()
end
in
let* () = Error.tag_lockfile @@ Lockfile.write () in
Lock_loader.write ();
Input_foreman.clean_unlisted_from_silo ();
Ok ()
|
