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
open B0_std
open Result.Syntax
let driver =
let libs = [B0_ocaml.Libname.v "b0.tool"] in
B0_driver.make ~name:"b0" ~version:"v0.0.6" ~libs
let def_list : (module B0_def.S) list =
[(module B0_pack); (module B0_unit)]
let def_list_list def_list =
let add_values (type a) acc (module Def : B0_def.S) =
let vs = Def.list () in
let add_value acc v =
((Def.name v, Def.def_kind), B0_def.V ((module Def), v)) :: acc
in
List.fold_left add_value acc vs
in
let vs = List.fold_left add_values [] def_list in
List.map snd (List.sort compare vs)
let def_list_get_or_hint def_list name =
let rec loop vs suggs = function
| [] ->
let rev_compare a b = compare b a in
if vs <> []
then Ok (List.map snd (List.sort rev_compare vs))
else
let kind ppf () = Fmt.string ppf "definition" in
let hint = Fmt.did_you_mean in
let pp = Fmt.unknown' ~kind Fmt.code ~hint in
Fmt.error "@[%a@]" pp (name, String.Set.elements suggs)
| (module Def : B0_def.S) :: defs ->
let vs, suggs = match Def.get_or_suggest name with
| Ok v -> ((Def.def_kind, B0_def.V ((module Def), v)) :: vs), suggs
| Error sugg_vs ->
let add_sugg acc v = String.Set.add (Def.name v) acc in
let suggs = List.fold_left add_sugg suggs sugg_vs in
vs, suggs
in
loop vs suggs defs
in
loop [] String.Set.empty def_list
let def_list_get_list_or_hint def_list ~all_if_empty names =
if all_if_empty && names = [] then Ok (def_list_list def_list) else
let rec loop vs es = function
| [] ->
if es <> []
then Error (String.concat "\n" (List.rev es))
else Ok (List.rev vs)
| n :: ns ->
match def_list_get_or_hint def_list n with
| Ok values -> loop (List.rev_append values vs) es ns
| Error e -> loop vs (e :: es) ns
in
loop [] [] names
module Def = struct
let list (module Def : B0_def.S) c format ds =
let pp, sep = match format with
| `Short -> Def.pp_name, Fmt.cut
| `Normal -> Def.pp_synopsis, Fmt.cut
| `Long -> Def.pp, Fmt.(cut ++ cut)
in
Log.if_error ~use:Os.Exit.no_such_name @@
let* ds = Def.get_list_or_hint ~all_if_empty:true ds in
Log.if_error' ~use:Os.Exit.some_error @@
let = B0_driver.Conf.no_pager c in
let* = B0_pager.find ~no_pager () in
let* () = B0_pager.page_stdout pager in
if ds <> [] then Log.stdout (fun m -> m "@[<v>%a@]" Fmt.(list ~sep pp) ds);
Ok Os.Exit.ok
let edit (module Def : B0_def.S) _c ds =
let rec find_files not_found fs = function
| [] -> not_found, Fpath.distinct fs
| d :: ds ->
match B0_def.file (Def.def d) with
| None -> find_files (Def.Set.add d not_found) fs ds
| Some f -> find_files not_found (f :: fs) ds
in
let edit_all = ds = [] in
Log.if_error ~use:Os.Exit.no_such_name @@
let* ds = Def.get_list_or_hint ~all_if_empty:true ds in
let not_found, files = find_files Def.Set.empty [] ds in
Log.if_error' ~use:Os.Exit.some_error @@
match not edit_all && not (Def.Set.is_empty not_found) with
| true ->
let plural = if (Def.Set.cardinal not_found > 1) then "s" else "" in
let none = Def.Set.elements not_found in
Fmt.error "Could not find b0 file for %s%s: @[%a@]"
Def.def_kind plural Fmt.(list ~sep:sp Def.pp_name) none
| false ->
let* editor = B0_editor.find () in
Result.bind (B0_editor.edit_files editor files) @@ function
| `Exited 0 -> Ok Os.Exit.ok
| _ -> Ok Os.Exit.some_error
let get_meta_key (module Def : B0_def.S) c format key ds =
Log.if_error ~use:Os.Exit.no_such_name @@
let* B0_meta.Key.V key = B0_meta.Key.get_or_hint key in
let* ds = Def.get_list_or_hint ~all_if_empty:true ds in
let add_meta acc d = match B0_meta.find_binding key (Def.meta d) with
| None -> acc | Some v -> (d, v) :: acc
in
let bs = List.rev @@ List.fold_left add_meta [] ds in
begin match ds with
| [d] ->
begin match bs with
| [] -> ()
| [_, B0_meta.B (k, v)] ->
Log.stdout (fun m -> m "@[<h>%a@]" (B0_meta.Key.pp_value k) v)
| _ -> assert false
end
| _ ->
let pp_bindings ppf (d, B0_meta.B (k, v)) =
Fmt.pf ppf "@[<h>%a %a@]" Def.pp_name d (B0_meta.Key.pp_value k) v
in
Log.stdout (fun m -> m "@[<v>%a@]" Fmt.(list pp_bindings) bs)
end;
Ok Os.Exit.ok
end