jon.recoil.org
Odoc docs
1module Id = Refs.Id
2module Lang = Refs.Lang
3
4let nm id = Id.name id
5
6let starts_with ~prefix s =
7 let lp = String.length prefix in
8 String.length s >= lp && String.sub s 0 lp = prefix
9
10(* Names containing [__] are the compiler/dune mangling for wrapped internal
11 modules; odoc treats them as hidden, so we don't offer them as completions. *)
12let hidden s =
13 let n = String.length s in
14 let rec loop i = i + 1 < n && (s.[i] = '_' && s.[i + 1] = '_' || loop (i + 1)) in
15 loop 0
16
17(* {1 Kind tags} *)
18
19(* Recognised reference kind tags -> the canonical kind we tag children with.
20 Mirrors odoc's [match_*_reference_kind] (including the deprecated aliases),
21 so [value-], [modtype-] &c. still filter. *)
22let kind_table =
23 [
24 ("module", "module");
25 ("module-type", "module-type");
26 ("modtype", "module-type");
27 ("type", "type");
28 ("val", "val");
29 ("value", "val");
30 ("exception", "exception");
31 ("exn", "exception");
32 ("constructor", "constructor");
33 ("const", "constructor");
34 ("field", "field");
35 ("recfield", "field");
36 ("extension", "extension");
37 ("extension-decl", "extension-decl");
38 ("class", "class");
39 ("class-type", "class-type");
40 ("classtype", "class-type");
41 ("method", "method");
42 ("instance-variable", "instance-variable");
43 ("label", "label");
44 ("section", "label");
45 ("page", "page");
46 ]
47
48(* Split a final component into (kind-prefix-verbatim, canonical-kind, name).
49 The kind is the recognised tag before the last [-]; otherwise the whole
50 component is the name (so operator-ish names aren't mis-split). *)
51let split_kind comp =
52 match String.rindex_opt comp '-' with
53 | Some j -> (
54 let k = String.sub comp 0 j in
55 match List.assoc_opt k kind_table with
56 | Some canon ->
57 let name = String.sub comp (j + 1) (String.length comp - j - 1) in
58 (k ^ "-", Some canon, name)
59 | None -> ("", None, comp))
60 | None -> ("", None, comp)
61
62(* {1 Enumerating the children of a located item} *)
63
64(* Section headings in a doc comment are referenceable as [label-]/[section-]
65 children of their enclosing module or page. Both explicit ([{1:foo …}]) and
66 auto-generated labels are offered — both resolve. *)
67let labels (docs : Odoc_model.Comment.docs) =
68 List.filter_map
69 (fun el ->
70 match el.Odoc_model.Location_.value with
71 | `Heading (_, label, _) -> Some (nm (label :> Id.t), "label")
72 | _ -> None)
73 docs.elements
74
75let sig_children (sg : Lang.Signature.t) =
76 let rec items acc its = List.fold_left item acc its
77 and item acc (it : Lang.Signature.item) =
78 match it with
79 | Module (_, m) -> (nm (m.id :> Id.t), "module") :: acc
80 | ModuleType mt -> (nm (mt.id :> Id.t), "module-type") :: acc
81 | ModuleSubstitution ms -> (nm (ms.id :> Id.t), "module") :: acc
82 | ModuleTypeSubstitution mts -> (nm (mts.id :> Id.t), "module-type") :: acc
83 | Type (_, t) -> (nm (t.id :> Id.t), "type") :: acc
84 | TypeSubstitution t -> (nm (t.id :> Id.t), "type") :: acc
85 | TypExt te ->
86 List.fold_left
87 (fun acc (c : Lang.Extension.Constructor.t) ->
88 (nm (c.id :> Id.t), "extension") :: acc)
89 acc te.constructors
90 | Exception e -> (nm (e.id :> Id.t), "exception") :: acc
91 | Value v -> (nm (v.id :> Id.t), "val") :: acc
92 | Class (_, c) -> (nm (c.id :> Id.t), "class") :: acc
93 | ClassType (_, ct) -> (nm (ct.id :> Id.t), "class-type") :: acc
94 | Include i -> items acc i.expansion.content.items
95 | Comment (`Docs d) -> List.rev_append (labels d) acc
96 | Open _ | Comment `Stop -> acc
97 in
98 (* Members and the section labels in the top-comment and standalone comments. *)
99 List.rev_append (labels sg.doc) (List.rev (items [] sg.items))
100
101let class_children (cs : Lang.ClassSignature.t) =
102 List.filter_map
103 (fun (it : Lang.ClassSignature.item) ->
104 match it with
105 | Method m -> Some (nm (m.id :> Id.t), "method")
106 | InstanceVariable v -> Some (nm (v.id :> Id.t), "instance-variable")
107 | Constraint _ | Inherit _ | Comment _ -> None)
108 cs.items
109
110let type_children (t : Lang.TypeDecl.t) =
111 match t.representation with
112 | Some (Variant cs) ->
113 List.map (fun (c : Lang.TypeDecl.Constructor.t) ->
114 (nm (c.id :> Id.t), "constructor"))
115 cs
116 | Some (Record fs) ->
117 List.map (fun (f : Lang.TypeDecl.Field.t) -> (nm (f.id :> Id.t), "field"))
118 fs
119 | Some (Record_unboxed_product fs) ->
120 List.map
121 (fun (f : Lang.TypeDecl.UnboxedField.t) -> (nm (f.id :> Id.t), "field"))
122 fs
123 | Some Extensible | None -> []
124
125let children_of : Refs.located -> (string * string) list = function
126 | Lmodule (_, Some sg) -> sig_children sg
127 | Lclass (_, Some cs) -> class_children cs
128 | Ltype (_, t) -> type_children t
129 | Lmodule (_, None) | Lclass (_, None) | Lleaf _ -> []
130
131(* Filter children by name prefix (and kind, if a tag was given), dedup by name,
132 and re-attach the verbatim stem and kind prefix. *)
133let format ~stem ~kindpfx ~name_prefix ~kind_filter children =
134 children
135 |> List.filter (fun (n, k) ->
136 starts_with ~prefix:name_prefix n
137 && match kind_filter with None -> true | Some kf -> kf = k)
138 |> List.map fst
139 |> List.sort_uniq compare
140 |> List.map (fun n -> stem ^ kindpfx ^ n)
141
142(* The children of the item named by a (complete) context reference. *)
143let context_children scan ~context =
144 match Refs.resolve_to_id scan context with
145 | Error _ -> []
146 | Ok id -> (
147 match Refs.owning_content scan ~ref_str:context id with
148 | Ok (Unit_content cu) -> (
149 match Refs.find id cu with
150 | Some loc -> children_of loc
151 | None -> [])
152 | Ok (Page_content page) -> labels page.Lang.Page.content
153 | Ok _ | Error _ -> [])
154
155(* {1 The three forms} *)
156
157let complete_dotted scan ~stem ~context ~comp =
158 let kindpfx, kind_filter, name_prefix = split_kind comp in
159 format ~stem ~kindpfx ~name_prefix ~kind_filter (context_children scan ~context)
160
161let complete_toplevel scan ~comp =
162 let kindpfx, kind_filter, name_prefix = split_kind comp in
163 (* Every compilation unit (a module), minus the page/impl/asset files. *)
164 let units =
165 Hashtbl.fold (fun k _ acc -> k :: acc) scan.Refs.odocl []
166 |> List.filter (fun k ->
167 (not (hidden k))
168 && not
169 (List.exists
170 (fun p -> starts_with ~prefix:p k)
171 [ "Page-"; "Impl-"; "Asset-" ]))
172 |> List.map (fun k -> (k, "module"))
173 in
174 (* Members of the open modules, so bare [List] / [print_endline] complete. *)
175 let opened =
176 List.concat_map
177 (fun m -> context_children scan ~context:m)
178 Refs.default_open
179 in
180 format ~stem:"" ~kindpfx ~name_prefix ~kind_filter (units @ opened)
181
182(* A path segment's name from a directory entry: a subdir is a sub-package /
183 sub-library / module; a [foo.odoc] is unit [Foo]; a [page-x.odoc] is page
184 [x]; implementations and assets are not referenceable here. *)
185let entry_name p ~is_dir =
186 let base = Fpath.basename p in
187 if is_dir then Some base
188 else if Filename.extension base <> ".odoc" then None
189 else
190 let stem = Filename.remove_extension base in
191 if starts_with ~prefix:"page-" stem then
192 Some (String.sub stem 5 (String.length stem - 5))
193 else if starts_with ~prefix:"impl-" stem || starts_with ~prefix:"asset-" stem
194 then None
195 else if stem = "" then None
196 else Some (String.capitalize_ascii stem)
197
198let complete_root_names scan ~stem ~comp =
199 List.map fst scan.Refs.page_roots @ List.map fst scan.Refs.lib_roots
200 |> List.filter (starts_with ~prefix:comp)
201 |> List.sort_uniq compare
202 |> List.map (fun n -> stem ^ n)
203
204(* List a directory's entries (units, pages, sub-dirs) as path segments. *)
205let complete_dir dir ~stem ~comp =
206 match Bos.OS.Dir.contents dir with
207 | Error _ -> []
208 | Ok entries ->
209 List.filter_map
210 (fun p ->
211 let is_dir =
212 match Bos.OS.Dir.exists p with Ok b -> b | _ -> false
213 in
214 entry_name p ~is_dir)
215 entries
216 |> List.filter (fun n -> (not (hidden n)) && starts_with ~prefix:comp n)
217 |> List.sort_uniq compare
218 |> List.map (fun n -> stem ^ n)
219
220let complete_path scan ~stem ~comp =
221 (* [stem] is the path up to and including the last [/]. The first segment is a
222 root name ([odoc], [odoc.model], …); any further segments are literal
223 sub-directories beneath it ([/odoc/deprecated/] -> odoc/odoc/deprecated). *)
224 match String.split_on_char '/' stem with
225 | [ ""; "" ] -> complete_root_names scan ~stem ~comp (* "/" *)
226 | "" :: "" :: _ -> [] (* "//…" current package: out of scope *)
227 | "" :: rest -> (
228 match List.filter (( <> ) "") rest with
229 | [] -> complete_root_names scan ~stem ~comp (* "/" *)
230 | root :: subs ->
231 (* A package and a library can share a name, with pages under the
232 odoc tree and module units in the library's physical directory:
233 offer the entries of every root going by that name. *)
234 let bases =
235 List.filter_map
236 (fun (name, dir) -> if name = root then Some dir else None)
237 (scan.Refs.page_roots @ scan.Refs.lib_roots)
238 in
239 if List.exists (fun s -> s = "." || s = "..") subs then []
240 else
241 List.concat_map
242 (fun base ->
243 let dir = List.fold_left (fun d s -> Fpath.(d / s)) base subs in
244 complete_dir dir ~stem ~comp)
245 bases
246 |> List.sort_uniq compare)
247 | _ -> [] (* "./…" relative, or no leading slash: out of scope *)
248
249(* {1 Splitting and dispatch} *)
250
251(* Index of the rightmost top-level [.] or [/] (outside parens/quotes, scanned
252 right-to-left as odoc's tokenizer does), or [None]. *)
253let last_sep s =
254 let rec loop i depth in_quote =
255 if i < 0 then None
256 else
257 let c = s.[i] in
258 if in_quote then loop (i - 1) depth (c <> '"')
259 else
260 match c with
261 | '"' -> loop (i - 1) depth true
262 | ')' -> loop (i - 1) (depth + 1) false
263 | '(' -> loop (i - 1) (max 0 (depth - 1)) false
264 | ('.' | '/') when depth = 0 -> Some (i, c)
265 | _ -> loop (i - 1) depth false
266 in
267 loop (String.length s - 1) 0 false
268
269let complete sw input =
270 let scan = Refs.scan sw in
271 let n = String.length input in
272 let after i = String.sub input (i + 1) (n - i - 1) in
273 match last_sep input with
274 | None -> complete_toplevel scan ~comp:input
275 | Some (i, '.') ->
276 complete_dotted scan
277 ~stem:(String.sub input 0 (i + 1))
278 ~context:(String.sub input 0 i) ~comp:(after i)
279 | Some (i, _ (* '/' *)) ->
280 complete_path scan ~stem:(String.sub input 0 (i + 1)) ~comp:(after i)