diff --git a/DESIGN_COMPLETE.md b/DESIGN_COMPLETE.md index 9267da0..8538e96 100644 --- a/DESIGN_COMPLETE.md +++ b/DESIGN_COMPLETE.md @@ -1,5 +1,13 @@ # odoc-switchdocs — `complete`: reference completion +> **Status: implemented** (`lib/complete.ml`, `switchdocs complete`). The shared +> resolve/load substrate was extracted into `Refs` (`lib/refs.ml`) rather than +> left in `show.ml`; `Show` and `Complete` are thin layers over it. Deviations +> from the design below: names containing `__` (wrapped internal modules) are +> filtered as odoc-hidden; section-label completion within signatures/pages is +> not yet implemented (`context_children` returns nothing for a page context); +> relative/current-package path forms remain out of scope. + A CLI subcommand that, given a *partial* odoc reference, prints the possible completions — one per line, each a full reference string the user could type next. diff --git a/README.md b/README.md index a9b2f9e..3517097 100644 --- a/README.md +++ b/README.md @@ -45,6 +45,11 @@ $ switchdocs setup --apply # add it to ~/.opam/config via `opam option` resolving an odoc reference against the whole switch. `Stdlib` is open, so bare names work (`List`, `print_endline`); references may also be qualified (`Astring.String`) or package-qualified (`/stdlib/Stdlib.List.map`). +- `switchdocs complete PARTIAL` — list the references `PARTIAL` could be + completed to, one per line: members of what it names so far (`List.m` → + `List.map`, …; kind tags filter, e.g. `module-List.type-` → `module-List.type-t`), + package/library names for a leading `/` (`/o` → `/odoc`, `/odoc.model`, …), or + the units under a `/pkg/` path. The engine for shell completion. ## Development diff --git a/bin/main.ml b/bin/main.ml index f2201c6..ea5b830 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -286,6 +286,42 @@ let show_cmd = (Cmd.info "show" ~doc ~man) Term.(ret (const run $ switch_t $ reference)) +(* complete — user-facing: emits candidates, always exits 0. *) +let complete_cmd = + let partial = + Arg.( + value & pos 0 string "" + & info [] ~docv:"PARTIAL" + ~doc: + "The start of an odoc reference, e.g. $(b,List.m), \ + $(b,module-List.type-), $(b,/o), or $(b,/odoc.model/). Defaults to \ + the empty string (all top-level names).") + in + let run switch partial = + match switch with + | Error (`Msg m) -> `Error (false, m) + | Ok sw -> + List.iter print_endline (Switchdocs.Complete.complete sw partial); + `Ok 0 + in + let doc = "List the possible completions of a partial reference" in + let man = + [ + `S Manpage.s_description; + `P + "Prints, one per line, the references $(i,PARTIAL) could be completed \ + to: members of the module/type/class it names so far (with $(b,Stdlib) \ + open, so bare names like $(b,List.m) work), package and library names \ + for a leading $(b,/), or the units under a $(b,/pkg/) path. A kind tag \ + in the final component (e.g. $(b,type-)) filters by kind. Intended as \ + the engine behind shell completion; prints nothing when there is no \ + match."; + ] + in + Cmd.v + (Cmd.info "complete" ~doc ~man) + Term.(ret (const run $ switch_t $ partial)) + (* setup *) let setup_cmd = let apply = @@ -348,6 +384,14 @@ let main_cmd = in Cmd.group (Cmd.info "switchdocs" ~version:"%%VERSION%%" ~doc ~man) - [ sync_cmd; rebuild_cmd; order_cmd; search_cmd; show_cmd; setup_cmd ] + [ + sync_cmd; + rebuild_cmd; + order_cmd; + search_cmd; + show_cmd; + complete_cmd; + setup_cmd; + ] let () = exit (Cmd.eval' main_cmd) diff --git a/lib/complete.ml b/lib/complete.ml new file mode 100644 index 0000000..16d7c45 --- /dev/null +++ b/lib/complete.ml @@ -0,0 +1,246 @@ +module Id = Refs.Id +module Lang = Refs.Lang + +let nm id = Id.name id + +let starts_with ~prefix s = + let lp = String.length prefix in + String.length s >= lp && String.sub s 0 lp = prefix + +(* Names containing [__] are the compiler/dune mangling for wrapped internal + modules; odoc treats them as hidden, so we don't offer them as completions. *) +let hidden s = + let n = String.length s in + let rec loop i = i + 1 < n && (s.[i] = '_' && s.[i + 1] = '_' || loop (i + 1)) in + loop 0 + +(* {1 Kind tags} *) + +(* Recognised reference kind tags -> the canonical kind we tag children with. + Mirrors odoc's [match_*_reference_kind] (including the deprecated aliases), + so [value-], [modtype-] &c. still filter. *) +let kind_table = + [ + ("module", "module"); + ("module-type", "module-type"); + ("modtype", "module-type"); + ("type", "type"); + ("val", "val"); + ("value", "val"); + ("exception", "exception"); + ("exn", "exception"); + ("constructor", "constructor"); + ("const", "constructor"); + ("field", "field"); + ("recfield", "field"); + ("extension", "extension"); + ("extension-decl", "extension-decl"); + ("class", "class"); + ("class-type", "class-type"); + ("classtype", "class-type"); + ("method", "method"); + ("instance-variable", "instance-variable"); + ("label", "label"); + ("section", "label"); + ("page", "page"); + ] + +(* Split a final component into (kind-prefix-verbatim, canonical-kind, name). + The kind is the recognised tag before the last [-]; otherwise the whole + component is the name (so operator-ish names aren't mis-split). *) +let split_kind comp = + match String.rindex_opt comp '-' with + | Some j -> ( + let k = String.sub comp 0 j in + match List.assoc_opt k kind_table with + | Some canon -> + let name = String.sub comp (j + 1) (String.length comp - j - 1) in + (k ^ "-", Some canon, name) + | None -> ("", None, comp)) + | None -> ("", None, comp) + +(* {1 Enumerating the children of a located item} *) + +let sig_children (sg : Lang.Signature.t) = + let rec items acc its = List.fold_left item acc its + and item acc (it : Lang.Signature.item) = + match it with + | Module (_, m) -> (nm (m.id :> Id.t), "module") :: acc + | ModuleType mt -> (nm (mt.id :> Id.t), "module-type") :: acc + | ModuleSubstitution ms -> (nm (ms.id :> Id.t), "module") :: acc + | ModuleTypeSubstitution mts -> (nm (mts.id :> Id.t), "module-type") :: acc + | Type (_, t) -> (nm (t.id :> Id.t), "type") :: acc + | TypeSubstitution t -> (nm (t.id :> Id.t), "type") :: acc + | TypExt te -> + List.fold_left + (fun acc (c : Lang.Extension.Constructor.t) -> + (nm (c.id :> Id.t), "extension") :: acc) + acc te.constructors + | Exception e -> (nm (e.id :> Id.t), "exception") :: acc + | Value v -> (nm (v.id :> Id.t), "val") :: acc + | Class (_, c) -> (nm (c.id :> Id.t), "class") :: acc + | ClassType (_, ct) -> (nm (ct.id :> Id.t), "class-type") :: acc + | Include i -> items acc i.expansion.content.items + | Open _ | Comment _ -> acc + in + List.rev (items [] sg.items) + +let class_children (cs : Lang.ClassSignature.t) = + List.filter_map + (fun (it : Lang.ClassSignature.item) -> + match it with + | Method m -> Some (nm (m.id :> Id.t), "method") + | InstanceVariable v -> Some (nm (v.id :> Id.t), "instance-variable") + | Constraint _ | Inherit _ | Comment _ -> None) + cs.items + +let type_children (t : Lang.TypeDecl.t) = + match t.representation with + | Some (Variant cs) -> + List.map (fun (c : Lang.TypeDecl.Constructor.t) -> + (nm (c.id :> Id.t), "constructor")) + cs + | Some (Record fs) -> + List.map (fun (f : Lang.TypeDecl.Field.t) -> (nm (f.id :> Id.t), "field")) + fs + | Some (Record_unboxed_product fs) -> + List.map + (fun (f : Lang.TypeDecl.UnboxedField.t) -> (nm (f.id :> Id.t), "field")) + fs + | Some Extensible | None -> [] + +let children_of : Refs.located -> (string * string) list = function + | Lmodule (_, Some sg) -> sig_children sg + | Lclass (_, Some cs) -> class_children cs + | Ltype (_, t) -> type_children t + | Lmodule (_, None) | Lclass (_, None) | Lleaf _ -> [] + +(* Filter children by name prefix (and kind, if a tag was given), dedup by name, + and re-attach the verbatim stem and kind prefix. *) +let format ~stem ~kindpfx ~name_prefix ~kind_filter children = + children + |> List.filter (fun (n, k) -> + starts_with ~prefix:name_prefix n + && match kind_filter with None -> true | Some kf -> kf = k) + |> List.map fst + |> List.sort_uniq compare + |> List.map (fun n -> stem ^ kindpfx ^ n) + +(* The children of the item named by a (complete) context reference. *) +let context_children scan ~context = + match Refs.resolve_to_id scan context with + | Error _ -> [] + | Ok id -> ( + match Refs.owning_content scan ~ref_str:context id with + | Ok (Unit_content cu) -> ( + match Refs.find id cu with + | Some loc -> children_of loc + | None -> []) + | Ok _ | Error _ -> []) + +(* {1 The three forms} *) + +let complete_dotted scan ~stem ~context ~comp = + let kindpfx, kind_filter, name_prefix = split_kind comp in + format ~stem ~kindpfx ~name_prefix ~kind_filter (context_children scan ~context) + +let complete_toplevel scan ~comp = + let kindpfx, kind_filter, name_prefix = split_kind comp in + (* Every compilation unit (a module), minus the page/impl/asset files. *) + let units = + Hashtbl.fold (fun k _ acc -> k :: acc) scan.Refs.odocl [] + |> List.filter (fun k -> + (not (hidden k)) + && not + (List.exists + (fun p -> starts_with ~prefix:p k) + [ "Page-"; "Impl-"; "Asset-" ])) + |> List.map (fun k -> (k, "module")) + in + (* Members of the open modules, so bare [List] / [print_endline] complete. *) + let opened = + List.concat_map + (fun m -> context_children scan ~context:m) + Refs.default_open + in + format ~stem:"" ~kindpfx ~name_prefix ~kind_filter (units @ opened) + +(* A path segment's name from a directory entry: a subdir is a sub-package / + sub-library / module; a [foo.odoc] is unit [Foo]; a [page-x.odoc] is page + [x]; implementations and assets are not referenceable here. *) +let entry_name p ~is_dir = + let base = Fpath.basename p in + if is_dir then Some base + else if Filename.extension base <> ".odoc" then None + else + let stem = Filename.remove_extension base in + if starts_with ~prefix:"page-" stem then + Some (String.sub stem 5 (String.length stem - 5)) + else if starts_with ~prefix:"impl-" stem || starts_with ~prefix:"asset-" stem + then None + else if stem = "" then None + else Some (String.capitalize_ascii stem) + +let complete_root_names scan ~stem ~comp = + List.map fst scan.Refs.page_roots @ List.map fst scan.Refs.lib_roots + |> List.filter (starts_with ~prefix:comp) + |> List.sort_uniq compare + |> List.map (fun n -> stem ^ n) + +let complete_in_root scan ~stem ~comp ~root = + match List.assoc_opt root (scan.Refs.page_roots @ scan.Refs.lib_roots) with + | None -> [] + | Some dir -> ( + match Bos.OS.Dir.contents dir with + | Error _ -> [] + | Ok entries -> + List.filter_map + (fun p -> + let is_dir = + match Bos.OS.Dir.exists p with Ok b -> b | _ -> false + in + entry_name p ~is_dir) + entries + |> List.filter (fun n -> (not (hidden n)) && starts_with ~prefix:comp n) + |> List.sort_uniq compare + |> List.map (fun n -> stem ^ n)) + +let complete_path scan ~stem ~comp = + match String.split_on_char '/' stem with + | [ ""; "" ] -> complete_root_names scan ~stem ~comp (* "/" *) + | [ ""; root; "" ] when root <> "" -> + complete_in_root scan ~stem ~comp ~root (* "/root/" *) + | _ -> [] (* "//", "./", deeper: out of scope *) + +(* {1 Splitting and dispatch} *) + +(* Index of the rightmost top-level [.] or [/] (outside parens/quotes, scanned + right-to-left as odoc's tokenizer does), or [None]. *) +let last_sep s = + let rec loop i depth in_quote = + if i < 0 then None + else + let c = s.[i] in + if in_quote then loop (i - 1) depth (c <> '"') + else + match c with + | '"' -> loop (i - 1) depth true + | ')' -> loop (i - 1) (depth + 1) false + | '(' -> loop (i - 1) (max 0 (depth - 1)) false + | ('.' | '/') when depth = 0 -> Some (i, c) + | _ -> loop (i - 1) depth false + in + loop (String.length s - 1) 0 false + +let complete sw input = + let scan = Refs.scan sw in + let n = String.length input in + let after i = String.sub input (i + 1) (n - i - 1) in + match last_sep input with + | None -> complete_toplevel scan ~comp:input + | Some (i, '.') -> + complete_dotted scan + ~stem:(String.sub input 0 (i + 1)) + ~context:(String.sub input 0 i) ~comp:(after i) + | Some (i, _ (* '/' *)) -> + complete_path scan ~stem:(String.sub input 0 (i + 1)) ~comp:(after i) diff --git a/lib/complete.mli b/lib/complete.mli new file mode 100644 index 0000000..e42df4d --- /dev/null +++ b/lib/complete.mli @@ -0,0 +1,14 @@ +(** Complete a partial odoc reference against the whole switch. + + Given the start of a reference, return the full reference strings it could + become — the reverse of {!Show}: rather than resolving a complete reference + and rendering it, resolve the reference's parent context and list the + children matching the final, incomplete component. Built on {!Refs}. *) + +val complete : Switch.t -> string -> string list +(** [complete sw partial] is the candidate completions of [partial], each a full + reference string (the verbatim stem the user typed plus a completed final + component), sorted and de-duplicated. Empty when nothing matches — an + unresolvable or dead-end input is not an error. Handles dotted member + references (incl. kind tags like [type-]), package-qualified path segments + ([/pkg], [/lib/Unit]), and bare top-level names (with [Stdlib] open). *) diff --git a/lib/refs.mli b/lib/refs.mli index eb7f310..400affb 100644 --- a/lib/refs.mli +++ b/lib/refs.mli @@ -24,6 +24,10 @@ val scan : Switch.t -> scan (** Scan the switch's [odoc/] tree: the include directories, the package/library roots, and the linked-unit index. *) +val default_open : string list +(** Modules resolution treats as open (currently [Stdlib]), mirroring the + compiler's default environment. *) + val resolve_to_id : scan -> string -> (Id.t, [> `Msg of string ]) result (** Parse and resolve a (complete) reference to its canonical identifier, using the same machinery as [odoc link]. Resolver ambiguity chatter on stderr is