forked from
jonmsterling.com/ocaml-forester
ocaml
Rewrite the logic of "forester new" (details below)
This resolves two issues:
1. forester/135: the logic to choose the destination of the new tree
was borked in two ways: first, it was using the location of the last
tree without chopping off the filename, and second it was apparently
confusing the order of arguments to List.fold_left. (Very subtle, not
caught by types!)
2. forester/88: Prefixes ought to be optional.
NOTE FOR KENTO: the behaviour of the test changed in a subtle way that
seems to involve the cram test sandbox. I am not sure what to make of
this, but I promoted the test. Feel free to fix further if something is
broken.
References: https://todo.sr.ht/~jonsterling/forester/135
References: https://todo.sr.ht/~jonsterling/forester/88
+47
-26
+1
-1
bin/forester/main.ml
+1
-1
bin/forester/main.ml
+2
-2
lib/compiler/Eval.ml
+2
-2
lib/compiler/Eval.ml
···
656
656
let script = eval_pop_arg ~loc: node.loc |> extract_dx_sequent in
657
657
emit_content_node ~loc: node.loc @@ T.Datalog_script [script]
658
658
| Current_tree ->
659
-
let iri = match (Frontmatter.get ()).iri with
659
+
let iri =
660
+
match (Frontmatter.get ()).iri with
660
661
| Some iri -> iri
661
662
| None -> Reporter.fatalf ?loc: node.loc Internal_error "No iri for tree"
662
663
in
663
664
emit_content_node ~loc: node.loc @@ T.Iri iri
664
-
665
665
666
666
and eval_var ~loc x =
667
667
match Env.find_opt x @@ Lex_env.read () with
+16
-13
lib/compiler/Iri_util.ml
+16
-13
lib/compiler/Iri_util.ml
···
16
16
attempt
17
17
18
18
let next_iri
19
-
: prefix: string ->
19
+
: prefix: (string option) ->
20
20
mode: [< `Random | `Sequential] ->
21
21
config: Config.t ->
22
22
(iri * string) list ->
23
-
string * string
23
+
string * string option
24
24
= fun
25
25
~prefix
26
26
~mode
27
27
~(config : Config.t)
28
28
addrs
29
29
->
30
+
let default_dir = List.nth_opt config.trees 0 in
30
31
let keys =
31
32
let@ (addr, uri) = List.filter_map @~ addrs in
32
-
let prefix', key = Iri_scheme.split_addr addr in
33
+
let@ prefix', key = Option.bind @@ Iri_scheme.split_addr addr in
33
34
if prefix = prefix' then
34
-
Option.map (fun key -> (key, uri)) key
35
+
Some (key, Filename.dirname uri)
35
36
else None
36
37
in
38
+
let last_sequential, dir =
39
+
List.fold_left
40
+
(fun (acc_i, acc_uri) (i, uri) ->
41
+
if i > acc_i then (i, Some uri) else (acc_i, acc_uri)
42
+
)
43
+
(0, default_dir)
44
+
keys
45
+
in
37
46
let next, dest_dir =
38
47
match mode with
39
48
| `Sequential ->
40
-
let max, uri =
41
-
List.fold_left
42
-
(fun (i, uri) (acc_i, _) -> (max i acc_i, uri))
43
-
(0, List.hd config.trees)
44
-
keys
45
-
in
46
-
1 + max, uri
49
+
last_sequential + 1, dir
47
50
| `Random ->
48
51
random_not_in (List.map fst keys),
49
-
snd @@ List.hd keys
52
+
dir
50
53
in
51
-
prefix ^ "-" ^ BaseN.Base36.string_of_int next, dest_dir
54
+
(match prefix with None -> "" | Some prefix -> prefix ^ "-") ^ BaseN.Base36.string_of_int next, dir
52
55
53
56
(* Reporting diagnostics requires a document URI to publish *)
54
57
let guess_uri (d : Reporter.diagnostic) =
+5
lib/compiler/dune
+5
lib/compiler/dune
+7
-5
lib/core/Iri_scheme.ml
+7
-5
lib/core/Iri_scheme.ml
···
52
52
|> last_segment
53
53
54
54
let split_addr
55
-
: Iri.t -> string * int option
55
+
: Iri.t -> (string option * int) option
56
56
= fun iri ->
57
57
let name = last_segment @@ Iri.path_string iri in
58
58
(* primitively check for address of form YYYY-MM-DD *)
59
59
let date_regex = Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|} in
60
60
if Str.string_match date_regex name 0 then
61
-
(name, None)
61
+
None
62
62
else
63
63
match String.rindex_opt name '-' with
64
64
| Some i ->
···
67
67
in
68
68
begin
69
69
match BaseN.Base36.int_of_string suffix with
70
-
| Some key -> prefix, Some key
71
-
| None -> name, None
70
+
| Some key -> Some (Some prefix, key)
71
+
| None -> None
72
72
end
73
-
| _ -> name, None
73
+
| _ ->
74
+
let@ key = Option.map @~ BaseN.Base36.int_of_string name in
75
+
None, key
74
76
75
77
let path_to_iri ~host str =
76
78
str
+1
-1
lib/core/Iri_scheme.mli
+1
-1
lib/core/Iri_scheme.mli
+2
lib/core/Reporter.ml
+2
lib/core/Reporter.ml
···
28
28
| Broken_link
29
29
| IO_error
30
30
| Log
31
+
| Missing_argument
31
32
[@@deriving show]
32
33
33
34
let default_severity : t -> Asai.Diagnostic.severity = function
···
51
52
| Resource_not_found -> Error
52
53
| Broken_link -> Warning
53
54
| IO_error -> Error
55
+
| Missing_argument -> Error
54
56
55
57
let short_code : t -> string =
56
58
show
+2
lib/core/Reporter.mli
+2
lib/core/Reporter.mli
+8
-1
lib/frontend/Forester.ml
+8
-1
lib/frontend/Forester.ml
···
41
41
let body = Format.asprintf "\\date{%a}\n" Human_datetime.pp now in
42
42
let create = `Exclusive 0o644 in
43
43
(* If no dest_dir is passed, use the directory of the last previous tree *)
44
-
let dir = match dest_dir with Some dir -> dir | None -> next_dir in
44
+
let dir =
45
+
match dest_dir with
46
+
| Some dir -> dir
47
+
| None ->
48
+
match next_dir with
49
+
| Some next_dir -> next_dir
50
+
| None -> Reporter.fatalf Missing_argument "Unable to guess destination director for new tree; please supply one."
51
+
in
45
52
let path =
46
53
EP.(env#fs / dir / fname)
47
54
in
+1
-1
lib/frontend/Forester.mli
+1
-1
lib/frontend/Forester.mli
+1
-1
lib/language_server/Code_action.ml
+1
-1
lib/language_server/Code_action.ml
···
22
22
let prefix, mode =
23
23
match arguments with
24
24
| Some [json_stuff] ->
25
-
let prefix = json_stuff |> member "prefix" |> to_string in
25
+
let prefix = json_stuff |> member "prefix" |> to_string_option in
26
26
let mode =
27
27
json_stuff |> member "mode" |> to_string |> function
28
28
| "random" -> `Random