diff --git a/master_changes.md b/master_changes.md index a6d2f57356b..b584dc8cf57 100644 --- a/master_changes.md +++ b/master_changes.md @@ -119,11 +119,16 @@ users) * Fix debian manual url fragment [#6231 @RyanGibb] * Change example of non-letter in version ordering [#6252 @gridbugs] * Remove redundant `+` in version BNF definition (it is already present in `identchar`) [#6252 @rjbou] + * mli documentation: fix code blocks [#6150 @rjbou] + * mli documentation: fix code blocks, references [#6150 @rjbou] + * mli documentation: fix code blocks, references, add `@raise` tags [#6150 @rjbou] + * Unhide `OpamProcess` functions [#6150 @rjbou] ## Security fixes # API updates ## opam-client + * `OpamArg.InvalidCLI`: export exception [#6150 @rjbou] ## opam-repository diff --git a/src/client/opamAction.mli b/src/client/opamAction.mli index f355859e18e..029f1b203b4 100644 --- a/src/client/opamAction.mli +++ b/src/client/opamAction.mli @@ -24,7 +24,7 @@ val download_package: rw switch_state -> package -> (string option * string) option OpamProcess.job (** [download_same_source_package t url packages] - As [download_package], download upstream shared source [url] between + As {!download_package}, download upstream shared source [url] between [packages]. *) val download_shared_source: rw switch_state -> OpamFile.URL.t option -> package list -> diff --git a/src/client/opamArg.mli b/src/client/opamArg.mli index 9b205ee31a2..2f1b6634c5a 100644 --- a/src/client/opamArg.mli +++ b/src/client/opamArg.mli @@ -90,7 +90,7 @@ val mk_vflag_all: (validity * 'a * string list * string) list -> 'a list Term.t -(* Escaped Windows directory separator. To use instead of [Filename.dir_sep] for +(* Escaped Windows directory separator. To use instead of {!Filename.dir_sep} for manpage strings *) val dir_sep: string @@ -318,7 +318,7 @@ val enum_with_default: (string * 'a default) list -> 'a Arg.converter val mk_subcommands_with_default: cli:OpamCLIVersion.Sourced.t -> 'a default subcommands -> 'a option Term.t * string list Term.t -(** Same as {!mk_subcommand} but use the default value if no +(** Same as {!mk_subcommands} but use the default value if no sub-command is selected. *) val bad_subcommand: diff --git a/src/client/opamArgTools.mli b/src/client/opamArgTools.mli index 6b8a093247f..1b875c67ea0 100644 --- a/src/client/opamArgTools.mli +++ b/src/client/opamArgTools.mli @@ -60,7 +60,7 @@ val mk_enum_opt: cli:OpamCLIVersion.Sourced.t -> validity -> section:string -> string list -> string -> (validity * string * 'a) list -> string -> 'a option Term.t -(** [opt_all] with enums. Check each flag content cli, purge non corresponding +(** {!mk_opt_all} with enums. Check each flag content cli, purge non corresponding ones from the final result. If after purge the resulting list is empty (all removed or newer flag contents), it raises an error ; otherwise only display warnings on wrong cli contents. *) diff --git a/src/client/opamAuxCommands.mli b/src/client/opamAuxCommands.mli index 3ef87a9feb3..167031c5ac4 100644 --- a/src/client/opamAuxCommands.mli +++ b/src/client/opamAuxCommands.mli @@ -20,8 +20,8 @@ open OpamStateTypes recorded package changes print warnings and aren't copied. *) val copy_files_to_destdir: 'a switch_state -> dirname -> package_set -> unit -(** Removes all files that may have been installed by [copy_files_to_destdir]; - it's more aggressive than [OpamDirTrack.revert] and doesn't check if the +(** Removes all files that may have been installed by {!copy_files_to_destdir}; + it's more aggressive than {!OpamDirTrack.revert} and doesn't check if the files are current. *) val remove_files_from_destdir: 'a switch_state -> dirname -> package_set -> unit @@ -39,7 +39,7 @@ val opams_of_dir: ?locked:string -> ?recurse:bool -> ?subpath:subpath -> OpamFilename.Dir.t -> name_and_file list -(** Like [opam_of_dirs], but changes the pinning_url if needed. If given [url] +(** Like {!opams_of_dir}, but changes the pinning_url if needed. If given [url] is local dir with vcs backend, and opam files not versioned, its pinning url is changed to rsync path-pin. If [ame_kind the_new_url] returns true, package information (name, opam file, new_url, subpath) are added to the @@ -107,7 +107,7 @@ val simulate_autopin: 'a switch_state * atom list (* Check sandboxing script call. If it errors or unattended output, disable - sandboxing by removing [OpamInitDefaults.sandbox_wrappers] commands in + sandboxing by removing {!OpamInitDefaults.sandbox_wrappers} commands in config file. Only one script is checked (init script default one), and tested on an `echo SUCCESS' call. *) diff --git a/src/client/opamCLIVersion.mli b/src/client/opamCLIVersion.mli index b00e3915e7c..94f55cfc54d 100644 --- a/src/client/opamCLIVersion.mli +++ b/src/client/opamCLIVersion.mli @@ -26,7 +26,7 @@ val is_supported : t -> bool val of_string_opt : string -> t option val of_string : string -> t -(** Comparison [>]] with [(major, minor)] *) +(** Comparison [>=] with [(major, minor)] *) val ( >= ) : t -> int * int -> bool (** Comparison [<] with [(major, minor)] *) diff --git a/src/client/opamCliMain.mli b/src/client/opamCliMain.mli index b0e965e828a..8384c1a6c4a 100644 --- a/src/client/opamCliMain.mli +++ b/src/client/opamCliMain.mli @@ -8,6 +8,8 @@ (* *) (**************************************************************************) +exception InvalidCLI of OpamCLIVersion.Sourced.t + (** Handles calling opam plugins (à la git). E.g. [opam publish] runs [opam-publish] from PATH, with specific addition of OpamPath.plugins_bin and the current switch bin directory). @@ -19,11 +21,11 @@ val check_and_run_external_commands: unit -> OpamCLIVersion.Sourced.t * string list (** Handles flushing buffers and catching exceptions from the main call, - including special cases like [OpamStd.Sys.Exec] that is expected to do a - [Unix.exec], but after all proper cleanup has been done. *) + including special cases like {!OpamStd.Sys.Exec} that is expected to do a + {!Unix.exec}, but after all proper cleanup has been done. *) val main_catch_all: (unit -> unit) -> unit -(** Handling of debug JSON output, according to [OpamClientConfig.json_out] *) +(** Handling of debug JSON output, according to {!OpamClientConfig.json_out} *) val json_out: unit -> unit (** [run default command_list] runs command-line argument parsing and processing diff --git a/src/client/opamClient.mli b/src/client/opamClient.mli index 9c2d8c59bd5..3e717dc8c0e 100644 --- a/src/client/opamClient.mli +++ b/src/client/opamClient.mli @@ -40,8 +40,8 @@ val init: * OpamFile.InitConfig.t *) (** Re-runs the extra tools checks, updates the configuration from [init_config] - (defaults to [OpamInitDefaults.init_config]) for the settings that are unset, - and updates all repositories *) + (defaults to {!OpamInitDefaults.init_config}) for the settings that are + unset, and updates all repositories *) val reinit: ?init_config:OpamFile.InitConfig.t -> interactive:bool -> ?dot_profile:filename -> ?update_config:bool -> ?env_hook:bool -> ?completion:bool -> ?inplace:bool -> @@ -62,7 +62,7 @@ val install: ?depext_only:bool -> atom list -> rw switch_state -(** Low-level version of [reinstall], bypassing the package name sanitization +(** Low-level version of {!reinstall}, bypassing the package name sanitization and dev package update, and offering more control *) val install_t: rw switch_state -> @@ -90,7 +90,7 @@ val check_installed: val reinstall: rw switch_state -> ?assume_built:bool -> atom list -> rw switch_state -(** Low-level version of [reinstall], bypassing the package name sanitization +(** Low-level version of {!reinstall}, bypassing the package name sanitization and dev package update, and offering more control *) val reinstall_t: rw switch_state -> ?ask:bool -> ?force:bool -> assume_built:bool -> atom list @@ -114,7 +114,7 @@ val upgrade: ?formula:formula -> ?check:bool -> ?only_installed:bool -> all:bool -> atom list -> rw switch_state -(** Low-level version of [upgrade], bypassing the package name sanitization and +(** Low-level version of {!upgrade}, bypassing the package name sanitization and dev package update, and offering more control. [terse] avoids the verbose message when we are at a local maximum, but there are possible upgrades *) val upgrade_t: diff --git a/src/client/opamConfigCommand.mli b/src/client/opamConfigCommand.mli index 6106e10fc47..a205bd376a5 100644 --- a/src/client/opamConfigCommand.mli +++ b/src/client/opamConfigCommand.mli @@ -70,7 +70,7 @@ type update_op = [ append_op | whole_op ] Raise [Invalid_argument] if the string is malformed *) val parse_update: string -> string * update_op -(** As [parse_update] but parse only overwrites and reverts. String is of the +(** As {!parse_update} but parse only overwrites and reverts. String is of the form [var=[value]]`. Raise [Invalid_argument] if the string is malformed *) val parse_whole: string -> string * whole_op @@ -79,31 +79,32 @@ val whole_of_update_op: update_op -> whole_op (** [set_opt_global gt field value] updates global config field with update value in /config file. Modifiable fields are a subset of all - defined fields in [OpamFile.Config.t]. On revert, field is reverted to its - initial value as defined in [OpamInitDefaults.init_config], to default - value otherwise ([OpamFile.Config.empty]). - May raise [OpamStd.Sys.Exit 2]. *) + defined fields in {!OpamFile.Config.t}. On revert, field is reverted to its + initial value as defined in {!OpamInitDefaults.init_config}, to default + value otherwise ({!OpamFile.Config.empty}). + @raise OpamStd.Sys.Exit ([`Bad_argument], [2]) if the field is not found or not + modifiable, or the value have a parse error. *) val set_opt_global: rw global_state -> string -> update_op -> rw global_state -(** As [set_opt_global], [set_opt_switch] updates switch config file in +(** As {!set_opt_global}, {!set_opt_switch} updates switch config file in //.opam-switch/switch-config. If switch state is given, uses its config and returns it with then new config. Otherwise, loads the raw switch state and returns [None]. - Raises [OpamStd.Sys.Exit 50] ([`Configuration_error]) if no switch is set *) + @raise OpamStd.Sys.Exit ([`Configuration_error], [50]) if no switch is set *) val set_opt_switch: 'a global_state -> ?st:rw switch_state -> string -> update_op -> rw switch_state option -(** [set_var_global] and [set_var_switch] update respectively `global-variables` +(** {!set_var_global} and {!set_var_switch} update respectively `global-variables` field in global config and `variables` field in switch config, by appending the new variables to current set. If switch state is given, uses its config and returns it with then new config. Otherwise, loads the raw switch state and returns [None]. - Raises [OpamStd.Sys.Exit 2] ([`Bad_argument]) if field is not modifiable *) + @raise OpamStd.Sys.Exit ([`Bad_argument], [2]) if field is not modifiable *) val set_var_global: rw global_state -> string -> whole_op -> rw global_state -(** Raises [OpamStd.Sys.Exit 50] ([`Configuration_error]) if no switch is set *) +(** @raise OpamStd.Sys.Exit ([`Configuration_error], [50]) if no switch is set *) val set_var_switch: 'a global_state -> ?st:rw switch_state -> string -> whole_op -> rw switch_state option @@ -118,7 +119,7 @@ val options_list: ?st:unlocked switch_state -> 'a global_state -> unit val options_list_global: 'a global_state -> unit -(** Raises [OpamStd.Sys.Exit 50] ([`Configuration_error]) if no switch is set *) +(** @raise OpamStd.Sys.Exit ([`Configuration_error], [50]) if no switch is set *) val options_list_switch: ?st:unlocked switch_state -> 'a global_state -> unit @@ -129,7 +130,7 @@ val vars_list: ?st:'a switch_state -> 'b global_state -> unit val vars_list_global: 'a global_state -> unit -(** Raises [OpamStd.Sys.Exit 50] ([`Configuration_error]) if no switch is set *) +(** @raise OpamStd.Sys.Exit ([`Configuration_error], [50]) if no switch is set *) val vars_list_switch: ?st:'a switch_state -> 'b global_state -> unit @@ -142,7 +143,7 @@ val vars_list_switch: val option_show_global: 'a global_state -> string -> unit -(** Raises [OpamStd.Sys.Exit 50] ([`Configuration_error]) if no switch is set *) +(** @raise OpamStd.Sys.Exit ([`Configuration_error], [50]) if no switch is set *) val option_show_switch: 'a global_state -> ?st:unlocked switch_state -> string -> unit diff --git a/src/client/opamPinCommand.mli b/src/client/opamPinCommand.mli index 514bf95561f..483cb25d752 100644 --- a/src/client/opamPinCommand.mli +++ b/src/client/opamPinCommand.mli @@ -15,7 +15,7 @@ open OpamTypes open OpamStateTypes (** Pins a package to the given version, and writes to disk. Returns the updated - state. The main difference with [source_pin] is that a definition overlay is + state. The main difference with {!source_pin} is that a definition overlay is not created. Therefore, the package must exist already. *) val version_pin: rw switch_state -> name -> version -> rw switch_state @@ -31,7 +31,8 @@ exception Nothing_to_do If [force], don't abort even if the source can't be fetched from [target] - May raise [Aborted] or [Nothing_to_do]. *) + @raise Aborted + @raise Nothing_to_do *) val source_pin: rw switch_state -> name -> ?version:version -> ?edit:bool -> ?opam:OpamFile.OPAM.t -> ?quiet:bool -> diff --git a/src/client/opamRepositoryCommand.mli b/src/client/opamRepositoryCommand.mli index 6b964e9881a..c0d14f51d54 100644 --- a/src/client/opamRepositoryCommand.mli +++ b/src/client/opamRepositoryCommand.mli @@ -50,7 +50,7 @@ val set_url: rw repos_state -> repository_name -> url -> trust_anchors option -> rw repos_state -(** Update the given repositories, as per [OpamUpdate.repositories], checks for +(** Update the given repositories, as per {!OpamUpdate.repositories}, checks for their version and runs the upgrade script locally if they are for an earlier opam. Returns list of repositories that failed and the new repository state. *) diff --git a/src/core/opamFilename.mli b/src/core/opamFilename.mli index f27f832360a..ba3763bb454 100644 --- a/src/core/opamFilename.mli +++ b/src/core/opamFilename.mli @@ -282,20 +282,22 @@ val find_in_parents: (Dir.t -> bool) -> Dir.t -> Dir.t option (** {2 Locking} *) -(** See [OpamSystem.flock]. Prefer the higher level [with_flock] functions when +(** See {!OpamSystem.flock}. Prefer the higher level [with_flock] functions when possible *) val flock: [< OpamSystem.lock_flag ] -> ?dontblock:bool -> t -> OpamSystem.lock (** Calls [f] while holding a lock file. Ensures the lock is properly released - on [f] exit. Raises [OpamSystem.Locked] if [dontblock] is set and the lock - can't be acquired. [f] is passed the file_descr of the lock. *) + on [f] exit. [f] is passed the file_descr of the lock. + @raise OpamSystem.Locked if [dontblock] is set and the lock + can't be acquired. *) val with_flock: [< OpamSystem.lock_flag ] -> ?dontblock:bool -> t -> (Unix.file_descr -> 'a) -> 'a (** Calls [f] with the file lock upgraded to at least [flag], then restores the previous lock level. Upgrade to [`Lock_write] should never be used in - blocking mode as it would deadlock. Raises [OpamSystem.Locked] (but keeps - the lock as is) if [dontblock] is set and the lock can't be upgraded. *) + blocking mode as it would deadlock. + @raise OpamSystem.Locked (but keeps the lock as is) if [dontblock] is set + and the lock can't be upgraded. *) val with_flock_upgrade: [< OpamSystem.actual_lock_flag ] -> ?dontblock:bool -> OpamSystem.lock -> (Unix.file_descr -> 'a) -> 'a diff --git a/src/core/opamHash.mli b/src/core/opamHash.mli index e4653537a8f..405f709f850 100644 --- a/src/core/opamHash.mli +++ b/src/core/opamHash.mli @@ -41,7 +41,7 @@ val sort : t list -> t list val check_file: string -> t -> bool -(** Like [check_file], but returns the actual mismatching hash of the file, or +(** Like {!check_file}, but returns the actual mismatching hash of the file, or [None] in case of match *) val mismatch: string -> t -> t option diff --git a/src/core/opamParallel.mli b/src/core/opamParallel.mli index 2c16ccb9ec6..aa89a13bf9f 100644 --- a/src/core/opamParallel.mli +++ b/src/core/opamParallel.mli @@ -35,8 +35,8 @@ exception Aborted (** Simply parallel execution of tasks *) (** In the simple iter, map and reduce cases, ints are the indexes of the jobs - in the list. First list is return code of sucessfull commands, second those - which raised expcetions, and third one those which were canceled. *) + in the list. First list is return code of successful commands, second those + which raised exceptions, and third one those which were canceled. *) exception Errors of int list * (int * exn) list * int list val iter: jobs:int -> command:('a -> unit OpamProcess.job) -> ?dry_run:bool -> diff --git a/src/core/opamProcess.mli b/src/core/opamProcess.mli index 9c73b166c23..8455369e534 100644 --- a/src/core/opamProcess.mli +++ b/src/core/opamProcess.mli @@ -98,12 +98,12 @@ type result = { Don't forget to call [cleanup result] afterwards *) val run : command -> result -(** Same as [run], but doesn't wait. Use wait_one to wait and collect +(** Same as {!run}, but doesn't wait. Use wait_one to wait and collect results; Don't forget to call [cleanup result] afterwards *) val run_background: command -> t -(** Similar to [run_background], except that no process is created, and a dummy +(** Similar to {!run_background}, except that no process is created, and a dummy process (suitable for dry_wait_one) is returned. *) val dry_run_background: command -> t @@ -111,15 +111,15 @@ val dry_run_background: command -> t careful to handle Sys.Break *) val wait: t -> result -(** Like [wait], but returns None immediately if the process hasn't ended *) +(** Like {!wait}, but returns None immediately if the process hasn't ended *) val dontwait: t -> result option (** Wait for the first of the listed processes to terminate, and return its termination status *) val wait_one: t list -> t * result -(** Similar to [wait_one] for simulations, to be used with - [dry_run_background] *) +(** Similar to {!wait_one} for simulations, to be used with + {!dry_run_background} *) val dry_wait_one: t list -> t * result (** Send SIGINT to a process (or SIGKILL on Windows) *) @@ -205,7 +205,7 @@ module Job: sig val of_list: ?keep_going:bool -> command list -> (command * result) option Op.job - (** As [of_list], but takes a list of functions that return the commands. The + (** As {!of_list}, but takes a list of functions that return the commands. The functions will only be evaluated when the command needs to be run. *) val of_fun_list: ?keep_going:bool -> (unit -> command) list -> (command * result) option Op.job @@ -222,7 +222,11 @@ end type 'a job = 'a Job.Op.job -(**/**) + +(** Current environment. On Windows, Cygwin installation binary path and git + location path may be added to PATH. **) +val default_env : unit -> string array + (** As {!OpamStd.Sys.resolve_command}, except the default for [~env] is {!default_env}. *) val resolve_command: ?env:string array -> ?dir:string -> string -> string option @@ -233,5 +237,3 @@ val create_process_env : string -> string array -> string array -> Unix.file_descr -> Unix.file_descr -> Unix.file_descr -> int - -val default_env : unit -> string array diff --git a/src/core/opamStd.mli b/src/core/opamStd.mli index b31145537bc..e3aea4ada7d 100644 --- a/src/core/opamStd.mli +++ b/src/core/opamStd.mli @@ -22,8 +22,9 @@ module type SET = sig val is_singleton: t -> bool - (** Returns one element, assuming the set is a singleton. Raises [Not_found] - on an empty set, [Failure] on a non-singleton. *) + (** Returns one element, assuming the set is a singleton. + @raise Not_found on an empty set + @raise Failure on a non-singleton *) val choose_one : t -> elt val choose_opt: t -> elt option @@ -36,7 +37,7 @@ module type SET = sig val find: (elt -> bool) -> t -> elt val find_opt: (elt -> bool) -> t -> elt option - (** Raises Failure in case the element is already present *) + (** @raise Failure in case the element is already present *) val safe_add: elt -> t -> t (** Accumulates the resulting sets of a function of elements until a fixpoint @@ -44,8 +45,8 @@ module type SET = sig val fixpoint: (elt -> t) -> t -> t (** [map_reduce f op t] applies [f] to every element of [t] and combines the - results using associative operator [op]. Raises [Invalid_argument] on an - empty set, or returns [default] if it is defined. *) + results using associative operator [op]. + @raise Invalid_argument on an empty set if [default] is not defined *) val map_reduce: ?default:'a -> (elt -> 'a) -> ('a -> 'a -> 'a) -> t -> 'a module Op : sig @@ -81,7 +82,7 @@ module type MAP = sig val of_list: (key * 'a) list -> 'a t - (** Raises Failure in case the element is already present *) + (** @raise Failure in case the element is already present *) val safe_add: key -> 'a -> 'a t -> 'a t (** [update k f zero map] updates the binding of [k] in [map] using function @@ -89,8 +90,8 @@ module type MAP = sig val update: key -> ('a -> 'a) -> 'a -> 'a t -> 'a t (** [map_reduce f op t] applies [f] to every binding of [t] and combines the - results using associative operator [op]. Raises [Invalid_argument] on an - empty map, or returns [default] if it is defined. *) + results using associative operator [op]. + @raise Invalid_argument on an empty map if [default] is not defined *) val map_reduce: ?default:'b -> (key -> 'a -> 'b) -> ('b -> 'b -> 'b) -> 'a t -> 'b @@ -186,13 +187,13 @@ module List : sig val cons: 'a -> 'a list -> 'a list - (** Convert list items to string and concat. [sconcat_map sep f x] is equivalent - to String.concat sep (List.map f x) but tail-rec. *) + (** Convert list items to string and concat. [concat_map sep f x] is equivalent + to [String.concat sep (List.map f x)] but tail-rec. *) val concat_map: ?left:string -> ?right:string -> ?nil:string -> ?last_sep:string -> string -> ('a -> string) -> 'a list -> string - (** Like [List.find], but returning option instead of raising *) + (** Like {!Stdlib.List.find}, but returning option instead of raising *) val find_opt: ('a -> bool) -> 'a list -> 'a option val to_string: ('a -> string) -> 'a list -> string @@ -214,7 +215,8 @@ module List : sig @raise Not_found if all of them yield [None] *) val find_map: ('a -> 'b option) -> 'a list -> 'b - (** Like [find_map], but returns [Some _] if succeeded and [None] if failed. *) + (** Like {!find_map}, + but returns [Some _] if succeeded and [None] if failed. *) val find_map_opt: ('a -> 'b option) -> 'a list -> 'b option (** Insert a value in an ordered list *) @@ -224,19 +226,19 @@ module List : sig end if index < 0 or > length respectively). Not tail-recursive *) val insert_at: int -> 'a -> 'a list -> 'a list - (** Like [List.assoc] with an equality function. *) + (** Like {!List.assoc} with an equality function. *) val assoc: ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b - (** Like [assoc], but returning option instead of raising [Not_found] *) + (** Like {!assoc}, but returning option instead of raising [Not_found] *) val assoc_opt: ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b option - (** Like [assoc], but as an option, and also returns the list with the + (** Like {!assoc}, but as an option, and also returns the list with the binding removed, e.g. equivalent to [(assoc_opt x l, remove_assoc x l)] (but tail-recursive and more efficient) *) val pick_assoc: ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> 'b option * ('a * 'b) list - (** Like [assoc], but returns a boolean instead of associated value *) + (** Like {!assoc}, but returns a boolean instead of associated value *) val mem_assoc: ('a -> 'a -> bool) -> 'a -> ('a * 'b) list -> bool (** [remove_assoc eq k l] removes first association of [k] from list [l] @@ -250,10 +252,11 @@ module List : sig val update_assoc: ('a -> 'a -> bool) -> 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list - (** Like [pick_assoc], but with a test function that takes a list element *) + (** Like {!pick_assoc}, but with a test function that takes a list element *) val pick: ('a -> bool) -> 'a list -> 'a option * 'a list - (** Like [List.fold_left], but also performs [List.map] at the same time *) + (** Like {!Stdlib.List.fold_left}, but also performs {!Stdlib.List.map} at + the same time *) val fold_left_map: ('s -> 'a -> ('s * 'b)) -> 's -> 'a list -> 's * 'b list end @@ -281,8 +284,8 @@ module String : sig val exact_match: Re.re -> string -> bool val find_from: (char -> bool) -> string -> int -> int - (** Like [String.compare], but with lowercase/uppercase variants ordered next - to each other (still considered not equal though) *) + (** Like {!Stdlib.String.compare}, but with lowercase/uppercase variants + ordered next to each other (still considered not equal though) *) val compare_case: string -> string -> int (** {3 Manipulation} *) @@ -303,14 +306,14 @@ module String : sig (** Cut a string at the first occurrence of the given char *) val cut_at: string -> char -> (string * string) option - (** Same as [cut_at], but starts from the right *) + (** Same as {!cut_at}, but starts from the right *) val rcut_at: string -> char -> (string * string) option (** Split a string at occurrences of a given characters. Empty strings are skipped. *) val split: string -> char -> string list - (** The same as [split], but keep empty strings (leading, trailing or between + (** The same as {!split}, but keep empty strings (leading, trailing or between contiguous delimiters) *) val split_delim: string -> char -> string list @@ -371,7 +374,7 @@ module Exn : sig (** To use when catching default exceptions: ensures we don't catch fatal errors like C-c. try-with should _always_ (by decreasing order of preference): - either catch specific exceptions - - or re-raise the same exception (preferably with [Exn.finalise]) + - or re-raise the same exception (preferably with {!Exn.finalise}) - or call this function on the caught exception *) val fatal: exn -> unit @@ -388,7 +391,7 @@ module Exn : sig val finalise: exn -> (unit -> unit) -> 'a (** Execute the given continuation, then run the finaliser before returning - the result. If an exception is raised, call [finalise] with the given + the result. If an exception is raised, call {!finalise} with the given finaliser. *) val finally: (unit -> unit) -> (unit -> 'a) -> 'a @@ -609,7 +612,7 @@ module Sys : sig [Unix.execvpe]. *) exception Exec of string * string array * string array - (** Raises [Exit i] *) + (** Raise exception {!Exit} [i] *) (* val exit: int -> 'a *) type exit_reason = @@ -622,7 +625,7 @@ module Sys : sig val get_exit_code : exit_reason -> int - (** Raises [Exit], with the code associated to the exit reason *) + (** Raise exception {!Exit}, with the code associated to the exit reason *) val exit_because: exit_reason -> 'a (**/**) @@ -642,7 +645,7 @@ module Win32 : sig val set_parent_pid : int32 -> unit (** Change which the pid written to by {!parent_putenv}. This function cannot - be called after [parent_putenv]. *) + be called after {!parent_putenv}. *) val parent_putenv : string -> string -> bool (** Update an environment variable in the parent (i.e. shell) process's @@ -693,7 +696,7 @@ module Config : sig val env_int: env_var -> int option type level = int - (* Like [env_int], but accept boolean values for 0 and 1 *) + (* Like {!env_int}, but accept boolean values for 0 and 1 *) val env_level: env_var -> level option type sections = int option String.Map.t diff --git a/src/core/opamStubs.mli b/src/core/opamStubs.mli index 53680b40b63..fd689608bf6 100644 --- a/src/core/opamStubs.mli +++ b/src/core/opamStubs.mli @@ -20,7 +20,7 @@ val getpid : unit -> int faked process ID returned by the Microsoft C Runtime (see https://caml.inria.fr/mantis/view.php?id=4034). - On all other platforms, this is just an alias for [Unix.getpid]. *) + On all other platforms, this is just an alias for {!Unix.getpid}. *) val getCurrentProcessID : unit -> int32 (** Windows only. As {!getpid}, but without the possibility of truncating the @@ -113,7 +113,7 @@ val getProcessArchitecture : int32 option -> windows_cpu_architecture val process_putenv : int32 -> string -> string -> bool (** Windows only. [process_putenv pid name value] sets the environment variable - [name] to [value] in given process ID ([Unix.putenv] must also be called to + [name] to [value] in given process ID ({!Unix.putenv} must also be called to update the value in the current process). This function must not be called if the target process is 32-bit and the current process is 64-bit or vice versa (outcomes vary from a no-op to a segfault). *) diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index ca6e9da7488..e015d23af5f 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -18,17 +18,18 @@ exception Command_not_found of string exception Permission_denied of string -(** raise [Process_error] *) +(** Raise exception {!Process_error} with the given [result] *) val process_error: OpamProcess.result -> 'a -(** raise [Process_error] if the process didn't return 0 *) +(** Raise exception {!Process_error} with the given [result] + if the process didn't return 0 *) val raise_on_process_error: OpamProcess.result -> unit (** Exception raised when a computation in the current process fails. *) exception Internal_error of string -(** Raise [Internal_error] *) +(** Raise exception {!Internal_error} with the given string format *) val internal_error: ('a, unit, string, 'b) format4 -> 'a (** [with_tmp_dir fn] executes [fn] creates a temporary directory and @@ -171,9 +172,10 @@ val directories_with_links: string -> string list command and output will be displayed (at command end for the latter, if concurrent commands are running). [name] is used for naming log files. [text] is what is displayed in the status line - for this command. May raise Command_not_found, unless - [resolve_path] is set to false (in which case you can end up - with a process error instead) *) + for this command. + + @raise Command_not_found, unless [resolve_path] is set to false (in which + case you can end up with a process error instead) *) val make_command: ?verbose:bool -> ?env:string array -> ?name:string -> ?text:string -> ?metadata:(string * string) list -> ?allow_stdin:bool -> ?stdout:string -> @@ -286,9 +288,10 @@ exception Locked val release_all_locks: unit -> unit (** Acquires a lock on the given file. - Raises [Locked] if the lock can't be acquired and [dontblock] is set. Raises - [OpamStd.Sys.Exit] if [safe_mode] is set and a write lock is required. Also - raises Unix errors if the lock file can't be opened. *) + + @raise Locked if the lock can't be acquired and [dontblock] is set + @raise OpamStd.Sys.Exit if [safe_mode] is set and a write lock is required. + @raise Unix.Unix_error if the lock file can't be opened. *) val flock: [< lock_flag ] -> ?dontblock:bool -> string -> lock (** Updates an existing lock to the given level. Raises the same exceptions as @@ -308,7 +311,8 @@ val lock_isatleast: [< lock_flag ] -> lock -> bool (** Returns the current kind of the lock *) val get_lock_flag: lock -> lock_flag -(** Returns the underlying fd for the lock or raises Not_found for `No_lock *) +(** Returns the underlying fd for the lock + @raise Not_found for [`No_lock] *) val get_lock_fd: lock -> Unix.file_descr (** {2 Misc} *) @@ -346,7 +350,7 @@ val print_stats: unit -> unit val register_printer: unit -> unit (** Initialises signal handlers, catch_break and some exception printers. The - lib may not perform properly without this if [Sys.catch_break] isn't set + lib may not perform properly without this if {!Sys.catch_break} isn't set and SIGPIPE isn't handled (with a no-op) *) val init: unit -> unit diff --git a/src/core/opamVersionCompare.mli b/src/core/opamVersionCompare.mli index 776e44a992f..00dbe13cad1 100644 --- a/src/core/opamVersionCompare.mli +++ b/src/core/opamVersionCompare.mli @@ -36,5 +36,5 @@ val equal : string -> string -> bool (** [compare x y] returns 0 if x is eqivalent to y, -1 if x is smaller than y, and 1 if x is greater than y. This is consistent with - [Stdlib.compare]. *) + {!Stdlib.compare}. *) val compare : string -> string -> int diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index 00d529c84a8..9ac19f15b87 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -41,7 +41,8 @@ module type IO_FILE = sig (** Write some contents to a file *) val write: t typed_file -> t -> unit - (** Read file contents. Raise an error if the file does not exist. *) + (** Read file contents. + @raise OpamSystem.Internal_error if the file does not exist. *) val read: t typed_file -> t (** Returns [None] on non-existing file *) @@ -60,7 +61,7 @@ module type IO_FILE = sig end -(* Error less [IO_FILE] read functions. *) +(* Error less {!IO_FILE} read functions. *) module type BestEffortRead = sig type t val read: t typed_file -> t diff --git a/src/format/opamFilter.mli b/src/format/opamFilter.mli index 989a37c812e..21ae2c36b9f 100644 --- a/src/format/opamFilter.mli +++ b/src/format/opamFilter.mli @@ -69,17 +69,18 @@ type env = full_variable -> variable_contents option self-reference [_] *) type fident = name option list * variable * (string * string) option -(** Maps on all variables appearing in a filter. The case where package - variables are renamed differently and appear in a filter ident of the form - [%{pkg1+pkg2:var}%] is not supported and raises [Invalid_argument]. *) +(** Maps on all variables appearing in a filter. + + @raise Invalid_argument when package variables are renamed differently and + appear in a filter ident of the form [%{pkg1+pkg2:var}%] *) val map_variables: (full_variable -> full_variable) -> filter -> filter (** Same limitation as [map_variables] *) val map_variables_in_string: (full_variable -> full_variable) -> string -> string -(** Does not handle rewriting the variables to different names (which can't be - expressed with a [fident] anymore), and raises [Invalid_argument] *) +(** @raise Invalid_argument when rewriting the variables to different names + (which can't be expressed with a {!fident} anymore) *) val map_variables_in_fident: (full_variable -> full_variable) -> fident -> fident @@ -88,12 +89,14 @@ val distribute_negations: ?neg:bool -> filter -> filter (** Rewrites string interpolations within a string. [default] is applied to the fident string (e.g. what's between [%{] and [}%]) when the expansion is - undefined. If unspecified, this raises [Failure]. + undefined. With [partial], [default] defaults to the identity, and is otherwise expected to return a fident. In this case, the returned string is supposed to be expanded again (expansion results are escaped, escapes are otherwise - kept). This makes the function idempotent *) + kept). This makes the function idempotent. + + @raise Failure if [default] is unspecified *) val expand_string: ?partial:bool -> ?default:(string -> string) -> env -> string -> string @@ -101,20 +104,20 @@ val expand_string: expansions *) val unclosed_expansions: string -> ((int * int) * string) list -(** Computes the value of a filter. May raise [Failure] if [default] isn't - provided *) +(** Computes the value of a filter. + @raise Failure if [default] isn't provided *) val eval: ?default:variable_contents -> env -> filter -> variable_contents -(** Like [eval] but casts the result to a bool. Raises [Invalid_argument] if - not a valid bool and no default supplied. *) +(** Like {!eval} but casts the result to a bool. + @raise Invalid_argument if not a valid bool and no [default] supplied *) val eval_to_bool: ?default:bool -> env -> filter -> bool -(** Same as [eval_to_bool], but takes an option as filter and returns always +(** Same as {!eval_to_bool}, but takes an option as filter and returns always [true] on [None], [false] when the filter is [Undefined]. This is the most common behaviour for using "filters" for filtering *) val opt_eval_to_bool: env -> filter option -> bool -(** Like [eval] but casts the result to a string *) +(** Like {!eval} but casts the result to a string *) val eval_to_string: ?default:string -> env -> filter -> string (** Reduces what can be, keeps the rest unchanged *) @@ -126,21 +129,21 @@ val ident_of_var: full_variable -> fident (** A fident accessor directly referring a variable with the given name *) val ident_of_string: string -> fident -(** Resolves a filter ident. Like [eval], may raise Failure if no default is - provided *) +(** Resolves a filter ident. + @raise Failure if no default is provided, like {!eval} *) val ident_value: ?default:variable_contents -> env -> fident -> variable_contents -(** Like [ident_value], but casts the result to a string *) +(** Like {!ident_value}, but casts the result to a string *) val ident_string: ?default:string -> env -> fident -> string -(** Like [ident_value], but casts the result to a bool *) +(** Like {!ident_value}, but casts the result to a bool *) val ident_bool: ?default:bool -> env -> fident -> bool val expand_interpolations_in_file_full: env -> src:filename -> dst:filename -> unit -(** Same as [expand_interpolations_in_file] but allows to set the source [src] and +(** Same as {!expand_interpolations_in_file} but allows to set the source [src] and destination [dst] files independently instead of implying [src] = [dst].in *) -(** Rewrites [basename].in to [basename], expanding interpolations. +(** Rewrites [basename.in] to [basename], expanding interpolations. If the first line begins ["opam-version:"], assumes that expansion of variables within strings should be properly escaped. In particular, this means that Windows paths should expand correctly when generating .config @@ -170,8 +173,8 @@ val of_formula: ('a -> filter) -> 'a generic_formula -> filter doesn't resolve to a valid version, the constraint is dropped unless [default_version] is specified. - May raise, as other filter functions, if [default] is not provided and - filters don't resolve. *) + @raise Invalid_argument as other filter functions, if [default] is not + provided and filters don't resolve *) val filter_formula: ?default_version:version -> ?default:bool -> env -> filtered_formula -> formula @@ -205,13 +208,13 @@ val filter_deps: formula (** The environment used in resolving the dependency filters, as per - [filter_deps]. *) + {!filter_deps}. *) val deps_var_env: build:bool -> post:bool -> ?test:bool -> ?doc:bool -> ?dev_setup:bool -> ?dev:bool -> env -(** Like [OpamFormula.simplify_version_formula], but on filtered formulas +(** Like {!OpamFormula.simplify_version_formula}, but on filtered formulas (filters are kept unchanged, but put in front) *) val simplify_extended_version_formula: condition -> condition option @@ -221,8 +224,8 @@ val atomise_extended: (OpamPackage.Name.t * (filter * (relop * filter) option)) OpamFormula.formula -(* Uses [OpamFormula.sort] to sort on names, and sort version formulas with - [simplify_extended_version_formula]. *) +(* Uses {!OpamFormula.sort} to sort on names, and sort version formulas with + {!simplify_extended_version_formula}. *) val sort_filtered_formula: ((name * condition) -> (name * condition) -> int) -> filtered_formula -> filtered_formula diff --git a/src/format/opamFormat.mli b/src/format/opamFormat.mli index f8a1776641e..302fb9f413f 100644 --- a/src/format/opamFormat.mli +++ b/src/format/opamFormat.mli @@ -45,8 +45,8 @@ val lines_map : (** {3 Pps for the type [value], used by opam-syntax files ([opamfile])} *) module V : sig - (** These base converters raise [Unexpected] when not run on the right input - (which is then converted to [Bad_format] by the parser. *) + (** These base converters raise {!Unexpected} when not run on the right input + (which is then converted to {!Bad_format} by the parser. *) val bool : (value, bool) t val int : (value, int) t diff --git a/src/format/opamFormula.mli b/src/format/opamFormula.mli index 6b5539eb093..ea27df83bd2 100644 --- a/src/format/opamFormula.mli +++ b/src/format/opamFormula.mli @@ -35,7 +35,7 @@ val string_of_atom: atom -> string val short_string_of_atom: atom -> string (** Parses a package or atom, in a format similar to [short_string_of_atom]. - @raise [Failure] if the format is incorrect *) + @raise Failure if the format is incorrect *) val atom_of_string: string -> atom (** Prints atoms as a conjunction ("&") using the short format *) @@ -242,7 +242,7 @@ val of_conjunction: atom conjunction -> t is not a disjunction, then fail. *) val to_disjunction: t -> atom disjunction -(** Like [to_disjunction], but accepts conjunctions within constraint formulas, +(** Like {!to_disjunction}, but accepts conjunctions within constraint formulas, resolving them using the provided package set. Conjunctions between packages still raise [Failure]. *) val set_to_disjunction: OpamPackage.Set.t -> t -> atom disjunction diff --git a/src/format/opamPackage.mli b/src/format/opamPackage.mli index 5c352c325fe..6c3a49e073d 100644 --- a/src/format/opamPackage.mli +++ b/src/format/opamPackage.mli @@ -116,7 +116,7 @@ val packages_of_names: Set.t -> Name.Set.t -> Set.t val filter_name_out: Set.t -> Name.t -> Set.t (** Return the maximal available version of a package name from a set. - Raises [Not_found] if no such package available. *) + @raise Not_found if no such package available. *) val max_version: Set.t -> Name.t -> t (** Compare two packages *) diff --git a/src/format/opamPath.mli b/src/format/opamPath.mli index 43a40e4862c..ecb2ae1d9a3 100644 --- a/src/format/opamPath.mli +++ b/src/format/opamPath.mli @@ -180,7 +180,7 @@ module Switch: sig (** Cached environment updates. *) val environment: t -> switch -> OpamFile.Environment.t OpamFile.t - (** Like [environment], but from the switch prefix dir *) + (** Like {!environment}, but from the switch prefix dir *) val env_relative_to_prefix: dirname -> OpamFile.Environment.t OpamFile.t (** Directory where the metadata of installed packages is mirrored. diff --git a/src/format/opamPp.mli b/src/format/opamPp.mli index 7123862b0b9..d6c0555af19 100644 --- a/src/format/opamPp.mli +++ b/src/format/opamPp.mli @@ -24,10 +24,10 @@ exception Bad_format of bad_format exception Bad_format_list of bad_format list exception Bad_version of bad_format * OpamVersion.t option -(** Raise [Bad_format]. *) +(** Raise exception {!Bad_format}. *) val bad_format: ?pos:pos -> ('a, unit, string, 'b) format4 -> 'a -(** Raise [Bad_version]. *) +(** Raise exception {!Bad_version}. *) val bad_version: OpamVersion.t option -> ?pos:pos -> ('a, unit, string, 'b) format4 -> 'a val string_of_bad_format: ?file:string -> exn -> string diff --git a/src/format/opamSwitch.mli b/src/format/opamSwitch.mli index f296a6cf912..da14a8d1097 100644 --- a/src/format/opamSwitch.mli +++ b/src/format/opamSwitch.mli @@ -30,6 +30,6 @@ val get_root: OpamFilename.Dir.t -> t -> OpamFilename.Dir.t val external_dirname: string (** Returns an external switch handle from a directory name. Resolves to the - destination if [external_dirname] at the given dir is a symlink to another - [external_dirname]. *) + destination if {!external_dirname} at the given dir is a symlink to another + {!external_dirname}. *) val of_dirname: OpamFilename.Dir.t -> t diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index ca3fb2ec855..e7bf8036128 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -430,8 +430,8 @@ type spf_resolved = [ `resolved ] type spf_unresolved = [ `unresolved ] (** Transformation for environment variables containing paths. They are either - unresolved at the beginning [SPF_Unresolved], then propagated as resolved - [SPF_Resolved]. *) + unresolved at the beginning {!SPF_Unresolved}, then propagated as resolved + {!SPF_Resolved}. *) type _ separator_path_format = | SPF_Resolved: (separator * path_format) option diff --git a/src/format/opamTypesBase.mli b/src/format/opamTypesBase.mli index 068ed269147..4985f0f3424 100644 --- a/src/format/opamTypesBase.mli +++ b/src/format/opamTypesBase.mli @@ -63,15 +63,17 @@ val env_array: env -> string array exception Parse_variable of string * string -(** Parses the data suitable for a filter.FIdent from a string. May raise - [Failure msg] on bad package names. A self-reference [_] parses to [None] *) +(** Parses the data suitable for a filter.FIdent from a string. A + self-reference [_] parses to [None]. + @raise Failure on bad package names.*) val filter_ident_of_string: string -> name option list * variable * (string * string) option -(** Like [Filter_ident_of_string] but parses also '%{?pkg+:var:}% syntax for - variables with package name that contains a '+'. if [accept] is [false], - [Parse_variable (pkg,var)] is raised when several '+' are encountered in - package name, i.e. 'pkg++:var'. *) +(** Like {!filter_ident_of_string} but parses also [%{?pkg+:var:}%] syntax for + variables with package name that contains a [+]. + + @raise {!Parse_variable} [(pkg,var)] if [accept] is [false] when several + [+] are encountered in package name, i.e. [pkg++:var]. *) val filter_ident_of_string_interp: ?accept:bool -> string -> name option list * variable * (string * string) option diff --git a/src/repository/opamDarcs.mli b/src/repository/opamDarcs.mli index 29c04891f71..2e853d7edf5 100644 --- a/src/repository/opamDarcs.mli +++ b/src/repository/opamDarcs.mli @@ -9,7 +9,7 @@ (* *) (**************************************************************************) -(** Darcs repository backend (based on OpamVCS) *) +(** Darcs repository backend (based on {!OpamVCS} *) module VCS: OpamVCS.VCS diff --git a/src/repository/opamDownload.mli b/src/repository/opamDownload.mli index 5d936039c90..859ab32e4b8 100644 --- a/src/repository/opamDownload.mli +++ b/src/repository/opamDownload.mli @@ -25,7 +25,7 @@ val download: OpamUrl.t -> OpamFilename.Dir.t -> OpamFilename.t OpamProcess.job -(** As [download], but with a specified output filename. *) +(** As {!download}, but with a specified output filename. *) val download_as: ?quiet:bool -> ?validate:bool -> overwrite:bool -> ?compress:bool -> ?checksum:OpamHash.t -> diff --git a/src/repository/opamGit.mli b/src/repository/opamGit.mli index b97937e827c..a17402bd59c 100644 --- a/src/repository/opamGit.mli +++ b/src/repository/opamGit.mli @@ -9,7 +9,7 @@ (* *) (**************************************************************************) -(** Git repository backend (based on OpamVCS) *) +(** Git repository backend (based on {!OpamVCS}) *) module VCS: OpamVCS.VCS diff --git a/src/repository/opamHg.mli b/src/repository/opamHg.mli index 44c512dbbc1..f00d193647a 100644 --- a/src/repository/opamHg.mli +++ b/src/repository/opamHg.mli @@ -9,7 +9,7 @@ (* *) (**************************************************************************) -(** Mercurial repository backend (based on OpamVCS) *) +(** Mercurial repository backend (based on {!OpamVCS}) *) module VCS: OpamVCS.VCS diff --git a/src/repository/opamRepository.mli b/src/repository/opamRepository.mli index babd92c3127..53a1b4bb055 100644 --- a/src/repository/opamRepository.mli +++ b/src/repository/opamRepository.mli @@ -22,9 +22,10 @@ val packages_with_prefixes: dirname -> string option package_map (** {2 Repository backends} *) -(** Update {i $opam/repo/$repo}. Raises [Failure] in case the update couldn't be - achieved. Returns [`No_changes] if the update did not bring any changes, and - [`Changes] otherwise. *) +(** Update {i $opam/repo/$repo}. Returns [`No_changes] if the update did not + bring any changes, and [`Changes] otherwise. + + @raise Failure in case the update couldn't be achieved. *) val update: repository -> dirname -> [`Changes | `No_changes] OpamProcess.job (** [pull_shared_tree ?cache_dir ?cache_url labels_dirnames checksums urls] @@ -42,7 +43,7 @@ val pull_shared_tree: (string * OpamFilename.Dir.t * subpath option) list -> OpamHash.t list -> url list -> string download OpamProcess.job -(* Same as [pull_shared_tree], but for a unique label/dirname. +(* Same as {!pull_shared_tree}, but for a unique label/dirname. If [full_fetch] is set to false, VCS repository is retrieved with shallow history (by default, full history). *) val pull_tree: diff --git a/src/repository/opamRepositoryBackend.mli b/src/repository/opamRepositoryBackend.mli index 7d51025a6f7..8b2dbabd05c 100644 --- a/src/repository/opamRepositoryBackend.mli +++ b/src/repository/opamRepositoryBackend.mli @@ -55,7 +55,7 @@ module type S = sig ?cache_dir:dirname -> ?subpath:subpath -> dirname -> OpamHash.t option -> url -> filename option download OpamProcess.job - (** [pull_repo_update] fetches the remote update from [url] to the local + (** [fetch_repo_update] fetches the remote update from [url] to the local repository at [dirname], but does not apply it, allowing for further verifications. The file or directory returned is always temporary and should be cleaned up by the caller. *) @@ -64,20 +64,20 @@ module type S = sig update OpamProcess.job (** [repo_update_complete dirname url] finalizes the update of the repository - after verification of the patch returned from [pull_repo_update] with + after verification of the patch returned from {!fetch_repo_update} with [Update_patch file] is applied. Version control systems, e.g. Mercurial, that track the state of the working directory automatically use this to update internal caches. *) val repo_update_complete: dirname -> url -> unit OpamProcess.job (** Return the (optional) revision of a given repository. Only useful for VCS - backends. Is not expected to work with [pull_repo_update], which doesn't + backends. Is not expected to work with [fetch_repo_update], which doesn't update the VCS commit information. *) val revision: dirname -> version option OpamProcess.job - (** Like [pull_url], except for locally-bound version control backends, where + (** Like {!pull_url}, except for locally-bound version control backends, where it should get the latest, uncommitted source. First, it performs a - [pull_url], then remove deleted files, and finally copy via rsync + {!pull_url}, then remove deleted files, and finally copy via rsync unversioned & modified-uncommitted files. *) val sync_dirty: ?subpath:subpath -> dirname -> url -> diff --git a/src/repository/opamVCS.mli b/src/repository/opamVCS.mli index d8fd5633dc8..8287b76f217 100644 --- a/src/repository/opamVCS.mli +++ b/src/repository/opamVCS.mli @@ -67,11 +67,11 @@ module type VCS = sig val vc_dir: dirname -> dirname (** Returns the currently selected branch handle. It should be valid as the - [hash] field of [OpamUrl.t]. *) + [hash] field of {!OpamUrl.t}. *) val current_branch: dirname -> string option OpamProcess.job (** Returns true if the working tree state is different from the state - recorded in the VCS as current. This differs from [is_up_to_date], which + recorded in the VCS as current. This differs from {!is_up_to_date}, which compares specifically to the last fetched state. This should always be [false] after [reset] has been called. *) val is_dirty: ?subpath:subpath -> dirname -> bool OpamProcess.job diff --git a/src/solver/opamCudf.mli b/src/solver/opamCudf.mli index 8547026aae1..ce67c312e52 100644 --- a/src/solver/opamCudf.mli +++ b/src/solver/opamCudf.mli @@ -84,7 +84,7 @@ val get_final_universe: (** Compute the list of actions to match the difference between two universe. Remark: the result order is unspecified, ie. need to use - [atomic_actions] to get a solution which respects the + {!atomic_actions} to get a solution which respects the topological order induced by dependencies. *) val actions_of_diff: (Set.t * Set.t) -> Cudf.package atomic_action list @@ -101,7 +101,7 @@ exception Cyclic_actions of Cudf.package action list list [reduce_actions] to reduce it to a graph including reinstall and up/down-grade actions. - May raise [Cyclic_actions]. *) + @raise Cyclic_actions *) val atomic_actions: simple_universe:Cudf.universe -> complete_universe:Cudf.universe -> @@ -138,7 +138,7 @@ val resolve: Cudf_types.vpkg request -> (Cudf.universe, conflict) result -(** Computes a list of actions to proceed from the result of [resolve]. +(** Computes a list of actions to proceed from the result of {!resolve}. Note however than the action list is not yet complete: the transitive closure of reinstallations is not yet completed, as it requires to fold over the dependency graph in considering the optional dependencies. *) @@ -248,8 +248,8 @@ val string_of_explanation: val conflict_explanations_raw: package_set -> conflict -> explanation list * Action.t list list -(** Properly concat a single conflict as returned by [conflict_explanations] for - display *) +(** Properly concat a single conflict as returned by {!conflict_explanations} + for display *) val string_of_conflict: ?start_column:int -> string * string list * string list -> string @@ -281,7 +281,7 @@ val packages: Cudf.universe -> Cudf.package list val to_cudf: Cudf.universe -> Cudf_types.vpkg request -> Cudf.preamble * Cudf.universe * Cudf.request -(** Like [OpamTypesBase.action_contents] but return the single package of +(** Like {!OpamTypesBase.action_contents} but return the single package of remove, install, reinstal, and change action *) val action_contents: 'a action -> 'a diff --git a/src/solver/opamCudfSolver.mli b/src/solver/opamCudfSolver.mli index e767b8b0624..cd2d1c395af 100644 --- a/src/solver/opamCudfSolver.mli +++ b/src/solver/opamCudfSolver.mli @@ -31,7 +31,7 @@ val default_solver_selection: (module S) list *) val custom_solver : OpamTypes.arg list -> (module S) -(** Like [custom_solver], but takes a simple command as a string *) +(** Like {!custom_solver}, but takes a simple command as a string *) val solver_of_string : string -> (module S) (** Gets the first present solver from the list. Exits with error if none was found. *) diff --git a/src/solver/opamSolver.mli b/src/solver/opamSolver.mli index 825727e84b7..a391cda8185 100644 --- a/src/solver/opamSolver.mli +++ b/src/solver/opamSolver.mli @@ -98,7 +98,7 @@ val get_atomic_action_graph : solution -> ActionGraph.t (** Keep only the packages that are installable. *) val installable: universe -> package_set -(** Like [installable], but within a subset and potentially much faster *) +(** Like {!installable}, but within a subset and potentially much faster *) val installable_subset: universe -> package_set -> package_set (** Sorts the given package set in topological order (as much as possible, diff --git a/src/state/opamEnv.mli b/src/state/opamEnv.mli index 98e0bcd3ee5..a0add3196ba 100644 --- a/src/state/opamEnv.mli +++ b/src/state/opamEnv.mli @@ -38,7 +38,7 @@ val get_opam: set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> 'a switch_state -> env -(** Like [get_opam], but reads the cache file from the given opam root and +(** Like {!get_opam}, but reads the cache file from the given opam root and switch instead of computing the environment from a switch state. With [base], apply the modifications to the specified base environment *) @@ -47,7 +47,7 @@ val get_opam_raw: force_path:bool -> dirname -> switch -> env -(** Like [get_opam_raw], but returns the list of updates instead of the new +(** Like {!get_opam_raw}, but returns the list of updates instead of the new environment. *) val get_opam_raw_updates: set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> @@ -69,10 +69,10 @@ val cygwin_non_shadowed_programs : string list (** Update an environment, including reverting opam changes that could have been previously applied (therefore, don't apply to an already updated env as - returned by e.g. [get_full]!) *) + returned by e.g. {!get_full}!) *) val add: env -> (spf_resolved, euok_internal) env_update list -> env -(** Like [get_opam] computes environment modification by OPAM , but returns +(** Like {!get_opam} computes environment modification by OPAM , but returns these [updates] instead of the new environment. *) val updates: set_opamroot:bool -> set_opamswitch:bool -> ?force_path:bool -> @@ -140,8 +140,8 @@ val update_user_setup: val write_static_init_scripts: dirname -> ?completion:bool -> ?env_hook:bool -> ?inplace:bool -> unit -> unit -(** Write into [OpamPath.hooks_dir] the given custom scripts (listed as - (filename, content)), normally provided by opamrc ([OpamFile.InitConfig]) *) +(** Write into {!OpamPath.hooks_dir} the given custom scripts (listed as + (filename, content)), normally provided by opamrc ({!OpamFile.InitConfig}) *) val write_custom_init_scripts: dirname -> (string * string) list -> unit diff --git a/src/state/opamFileTools.mli b/src/state/opamFileTools.mli index 744729da11f..b04018ee1a6 100644 --- a/src/state/opamFileTools.mli +++ b/src/state/opamFileTools.mli @@ -26,7 +26,7 @@ val lint: ?check_upstream:bool -> OpamFile.OPAM.t -> (int * [`Warning|`Error] * string) list -(** Same as [lint], but operates on a file, which allows catching parse errors +(** Same as {!lint}, but operates on a file, which allows catching parse errors too. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename]. [handle_dirname] is used for warning 4, and should be set when reading packages from a repository, so that package name @@ -38,7 +38,7 @@ val lint_file: OpamFile.OPAM.t OpamFile.typed_file -> (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option -(** Same as [lint_file], but taking input from a channel. [check_extra_files] +(** Same as {!lint_file}, but taking input from a channel. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename] *) val lint_channel: @@ -48,7 +48,7 @@ val lint_channel: OpamFile.OPAM.t OpamFile.typed_file -> in_channel -> (int * [`Warning|`Error] * string) list * OpamFile.OPAM.t option -(** Like [lint_file], but takes the file contents as a string. +(** Like {!lint_file}, but takes the file contents as a string. [check_extra_files] defaults to a function that will look for a [files/] directory besides [filename] *) val lint_string: @@ -65,6 +65,7 @@ val warns_to_string: (int * [`Warning|`Error] * string) list -> string (** Utility function to construct a json of validation results. The format is as follow: + {[ { "file" : string , "result" : string (passed | error | warning), "warnings" : @@ -78,17 +79,18 @@ val warns_to_string: (int * [`Warning|`Error] * string) list -> string ... ] } + ]} *) val warns_to_json: ?filename:string -> (int * [`Warning|`Error] * string) list -> OpamJson.t (** Read the opam metadata from a given directory (opam file, with possible overrides from url and descr files). - Warning: use [read_repo_opam] instead for correctly reading files from + Warning: use {!read_repo_opam} instead for correctly reading files from repositories!*) val read_opam: dirname -> OpamFile.OPAM.t option -(** Like [read_opam], but additionally fills in the [metadata_dir] info +(** Like {!read_opam}, but additionally fills in the [metadata_dir] info correctly for the given repository. *) val read_repo_opam: repo_name:repository_name -> repo_root:dirname -> @@ -101,7 +103,7 @@ val read_repo_opam: val add_aux_files: ?dir:dirname -> ?files_subdir_hashes:bool -> OpamFile.OPAM.t -> OpamFile.OPAM.t -(** {2 Tools to manipulate the [OpamFile.OPAM.t] contents} *) +(** {2 Tools to manipulate the {!OpamFile.OPAM.t} contents} *) val map_all_variables: (full_variable -> full_variable) -> OpamFile.OPAM.t -> OpamFile.OPAM.t diff --git a/src/state/opamFormatUpgrade.mli b/src/state/opamFormatUpgrade.mli index 299622ecbd1..05e469e589f 100644 --- a/src/state/opamFormatUpgrade.mli +++ b/src/state/opamFormatUpgrade.mli @@ -18,7 +18,7 @@ open OpamStateTypes (** Raised when the opam root has been updated to a newer format, and further action (opam init/update) is needed. [Upgrade_done conf reinit] specifies the new config file and a reinit - function to call instead of default (see [OpamCliMain.main_catch_all]). *) + function to call instead of default (see {!OpamCliMain.main_catch_all}). *) exception Upgrade_done of OpamFile.Config.t * (OpamFile.Config.t -> unit) option (** The latest version of the opam root format, that normal operation of this @@ -54,7 +54,7 @@ val as_necessary_repo_switch_light_upgrade: to 2.1~rc one. Raises [Upgrade_done] (catched by main function) if an upgrade is done, otherwise do nothing. It is intend to be called after a config file that error with - [OpamPp.Bad_version] *) + {!OpamPp.Bad_version} *) val hard_upgrade_from_2_1_intermediates: ?reinit:(OpamFile.Config.t -> unit) -> ?global_lock: OpamSystem.lock -> dirname -> unit @@ -71,7 +71,7 @@ val opam_file: ?quiet:bool -> ?filename:OpamFile.OPAM.t OpamFile.t -> OpamFile.OPAM.t -> OpamFile.OPAM.t -(** Convert the comp file to an opam one, using [OpamFile.Comp.to_package] and +(** Convert the comp file to an opam one, using {!OpamFile.Comp.to_package} and applying filter rewriting *) val comp_file: ?package:package -> ?descr:OpamFile.Descr.t -> OpamFile.Comp.t -> diff --git a/src/state/opamPackageVar.mli b/src/state/opamPackageVar.mli index 2e0725daaf7..4215057d6b0 100644 --- a/src/state/opamPackageVar.mli +++ b/src/state/opamPackageVar.mli @@ -23,7 +23,7 @@ val package_variable_names: (string * string) list (** Variables that are pre-defined in the dependency filtered-formula scope, and which resolution is delayed to after the universe is computed (these are the only ones allowed in the universe, and resolved by - [OpamFilter.filter_deps]) *) + {!OpamFilter.filter_deps}) *) val predefined_depends_variables: full_variable list (** Resolves globally available variables only *) @@ -45,7 +45,7 @@ val resolve: ?local:OpamVariable.variable_contents option OpamVariable.Map.t -> OpamFilter.env -(** Like [resolve_switch], but takes more specific parameters so that it can be +(** Like {!resolve_switch}, but takes more specific parameters so that it can be used before the switch state is fully loaded *) val resolve_switch_raw: ?package:package -> diff --git a/src/state/opamRepositoryState.mli b/src/state/opamRepositoryState.mli index d5e0c03bb14..3dc604b77ba 100644 --- a/src/state/opamRepositoryState.mli +++ b/src/state/opamRepositoryState.mli @@ -29,7 +29,7 @@ end val load: 'a lock -> [< unlocked ] global_state -> 'a repos_state -(** Loads the repository state as [load], and calls the given function while +(** Loads the repository state as {!load}, and calls the given function while keeping it locked (as per the [lock] argument), releasing the lock afterwards *) val with_: @@ -60,7 +60,7 @@ val load_repo: (** Get the (lazily extracted) repository root for the given repository *) val get_root: 'a repos_state -> repository_name -> OpamFilename.Dir.t -(** Same as [get_root], but with a repository rather than just a name as argument *) +(** Same as {!get_root}, but with a repository rather than just a name as argument *) val get_repo_root: 'a repos_state -> repository -> OpamFilename.Dir.t (* (\** Runs the given function with access to a (possibly temporary) directory @@ -70,7 +70,7 @@ val get_repo_root: 'a repos_state -> repository -> OpamFilename.Dir.t * val with_repo_root: * 'a global_state -> repository -> (OpamFilename.Dir.t -> 'b) -> 'b * - * (\** As [with_repo_root], but on jobs *\) + * (\** As {!with_repo_root}, but on jobs *\) * val with_repo_root_job: * 'a global_state -> repository -> * (OpamFilename.Dir.t -> 'b OpamProcess.job) -> 'b OpamProcess.job *) diff --git a/src/state/opamStateConfig.mli b/src/state/opamStateConfig.mli index 793c4e00ec8..c33379b6fa1 100644 --- a/src/state/opamStateConfig.mli +++ b/src/state/opamStateConfig.mli @@ -96,8 +96,8 @@ val load: ?lock_kind: 'a lock -> dirname -> OpamFile.Config.t option val safe_load: ?lock_kind: 'a lock -> dirname -> OpamFile.Config.t (** Loads the config file from the OPAM root and updates default values for all - related OpamXxxConfig modules. Doesn't read the env yet, the [init] - functions should still be called afterwards. OpamFormat should be + related OpamXxxConfig modules. Doesn't read the env yet, the {!init} + functions should still be called afterwards. {!OpamFormatConfig} should be initialised beforehand, as it may impact the config file loading. Returns the config file that was found, if any *) @@ -155,7 +155,7 @@ end It is necessary to handle opam root and switch upgrade from 2.1 intermediates roots to 2.1: this allows a workaround for a bug in versions 2.1~alpha which wrongly updated the declared switch versions, requiring that - we fix it during [OpamFormatUpgrade] from these specific intermediate + we fix it during {!OpamFormatUpgrade} from these specific intermediate versions, and at switch loading for that specific case. *) val downgrade_2_1_switch: OpamFile.Switch_config.t OpamFile.t -> OpamFile.Switch_config.t option diff --git a/src/state/opamStateTypes.mli b/src/state/opamStateTypes.mli index 3a00a5089d8..e49d9f255e5 100644 --- a/src/state/opamStateTypes.mli +++ b/src/state/opamStateTypes.mli @@ -54,7 +54,7 @@ type +'lock global_state = { root: OpamPath.t; (** The global opam root path (caution: this is stored here but some code may - rely on OpamStateConfig.root_dir ; in other words, multiple root handling + rely on {!OpamStateConfig.root_dir} ; in other words, multiple root handling isn't really supported at the moment) *) config: OpamFile.Config.t; @@ -140,18 +140,18 @@ type +'lock switch_state = { initialised for otherwise available packages *) available_packages: package_set Lazy.t; - (** The set of available packages, filtered by their [available:] field *) + (** The set of available packages, filtered by their [available] field *) pinned: package_set; (** The set of pinned packages (their metadata, including pinning target, is - in [opams]) *) + in {!field:opams}) *) installed: package_set; (** The set of all installed packages *) installed_opams: OpamFile.OPAM.t package_map; (** The cached metadata of installed packages (may differ from the metadata - that is in [opams] for updated packages) *) + that is in {!field:opams} for updated packages) *) installed_roots: package_set; (** The set of packages explicitly installed by the user. Some of them may @@ -164,7 +164,7 @@ type +'lock switch_state = { invalidated: package_set Lazy.t; (** The set of packages which are installed but no longer valid, e.g. because of removed system dependencies. Only packages which are unavailable end up - in this set, they are otherwise put in [reinstall]. *) + in this set, they are otherwise put in {!field:reinstall}. *) (* Missing: a cache for - switch-global and package variables @@ -179,8 +179,9 @@ type provenance = [ `Env (** Environment variable *) (** Pinned opam files informations *) +(**/**) (* Opam file to pin informations. - [_topin_opamfile] and _topin_name_and_opamfile] are not meant to be used + {!_topin_opamfile} and {!_topin_name_and_opamfile} are not meant to be used directly ; use rather below defined types ;*) type 'url _topin_opamfile = { pin_file: OpamFile.OPAM.t OpamFile.t; @@ -192,6 +193,8 @@ type ('name, 'url) _topin_name_and_opamfile = { pin_name: 'name; pin: 'url _topin_opamfile; } +(**/**) + type name_and_file = (name, unit) _topin_name_and_opamfile type name_and_file_w_url = (name, url) _topin_name_and_opamfile type nameopt_and_file = (name option, unit) _topin_name_and_opamfile diff --git a/src/state/opamSwitchState.mli b/src/state/opamSwitchState.mli index f0e4096c048..5212ee662f4 100644 --- a/src/state/opamSwitchState.mli +++ b/src/state/opamSwitchState.mli @@ -22,7 +22,7 @@ val load: The repository state is automatically loaded if not provided. - The switch is selected, if not set, using [OpamStateConfig.get_switch] -- + The switch is selected, if not set, using {!OpamStateConfig.get_switch} -- which can fail if no switch is configured. Additionally, in case of a write lock, a backup is saved and a message is @@ -150,12 +150,12 @@ val is_pinned: 'a switch_state -> name -> bool overlay metadata, and relying on the repo's data *) val is_version_pinned: 'a switch_state -> name -> bool -(** The set of all "dev packages" (see [is_dev_package] for a definition) *) +(** The set of all "dev packages" (see {!is_dev_package} for a definition) *) val dev_packages: 'a switch_state -> package_set (** Returns the local source mirror for the given package - ([OpamPath.Switch.sources] or [OpamPath.Switch.pinned_package], depending on - wether it's pinned). *) + ({!OpamPath.Switch.sources} or {!OpamPath.Switch.pinned_package}, depending + on wether it's pinned). *) val source_dir: 'a switch_state -> package -> dirname (** Returns the set of active external dependencies for the package, computed @@ -167,20 +167,20 @@ val depexts: 'a switch_state -> package -> OpamSysPkg.Set.t (** Return the transitive dependency closures of a collection of packages. - @param depopts include optional dependencies (depopts: foo) - @param build include build dependencies (depends: foo {build}) - @param post include post dependencies (depends: foo {post}) + @param depopts include optional dependencies ([depopts: foo]) + @param build include build dependencies ([depends: foo {build}]) + @param post include post dependencies ([depends: foo {post}]) @param installed only consider already-installed packages - @param unavaiable also consider unavailable packages. - If the availability of packages hasn't been computed yet, - setting this [false] can have a significant performance - impact depending on the platform. + @param unavailable also consider unavailable packages + If the availability of packages hasn't been computed yet, + setting this [false] can have a significant performance + impact depending on the platform. *) val dependencies: 'a switch_state -> build:bool -> post:bool -> depopts:bool -> installed:bool -> unavailable:bool -> package_set -> package_set -(** Same as [dependencies] but for reverse dependencies. *) +(** Same as {!dependencies} but for reverse dependencies. *) val reverse_dependencies: 'a switch_state -> build:bool -> post:bool -> depopts:bool -> installed:bool -> unavailable:bool -> package_set -> package_set @@ -202,7 +202,7 @@ val conflicts_with: 'a switch_state -> package_set -> package_set -> package_set (** Put the package data in a form suitable for the solver, pre-computing some maps and sets. Packages in the [requested] set are the ones that will get affected by the global [build_test] and [build_doc] flags. [test] and [doc], - if unspecified, are taken from [OpamStateConfig.r]. [reinstall] marks + if unspecified, are taken from {!OpamStateConfig.r}. [reinstall] marks package not considered current in the universe, and that should therefore be reinstalled. If unspecified, it is the packages marked in [switch_state.reinstall] that are present in [requested]. *) @@ -231,7 +231,7 @@ val update_package_metadata: packages and available sets. *) val remove_package_metadata: package -> 'a switch_state -> 'a switch_state -(** Like [update_package_metadata], but also ensures the package is pinned to +(** Like {!update_package_metadata}, but also ensures the package is pinned to the given version. The version specified in the opam file, if any, takes precedence over the version of [package]. Also marks it for reinstall if changed. *) diff --git a/src/state/opamSysInteract.mli b/src/state/opamSysInteract.mli index 9254c9a00f6..185bc876a25 100644 --- a/src/state/opamSysInteract.mli +++ b/src/state/opamSysInteract.mli @@ -11,7 +11,7 @@ open OpamStateTypes (* Given a list of system packages, retrieve their installation status from the - system and returns a pair of [sys_package] set: + system and returns a pair of {!sys_package} set: * first one is available set: package that exist on the default repositories, but not installed) * second one, not found set: packages not found on the defined repositories diff --git a/src/state/opamUpdate.mli b/src/state/opamUpdate.mli index f30e81a5484..5d101ef3a76 100644 --- a/src/state/opamUpdate.mli +++ b/src/state/opamUpdate.mli @@ -85,7 +85,7 @@ val pinned_package: known hash) into the cache. For non-VC remotes, verifies the checksum if any. If an archive is not found, it launches Software Heritage fallback (see - [OpamDownload.SWHID]). + {!OpamDownload.SWHID}). Stops on first error. The extra downloads list is reverted, so that the error is always first if any. @@ -95,7 +95,7 @@ val download_package_source: 'a switch_state -> package -> dirname -> (string download option * (string * string download) list) OpamProcess.job -(** As [download_package_source] but for several packages sharing the same +(** As {!download_package_source} but for several packages sharing the same source. If [url] is None, do nothing. Downloads and synchronise upstream source in their respective source directories. *) val download_shared_package_source: @@ -105,7 +105,7 @@ val download_shared_package_source: (** [cleanup_source old_opam_option new_opam] checks if the remote URL has changed between [old_opam_option] and [new_opam], and, depending on that, - cleans up the source directory of the package ([OpamPath.Switch.sources]) if + cleans up the source directory of the package ({!OpamPath.Switch.sources}) if needed. *) val cleanup_source: 'a switch_state -> OpamFile.OPAM.t option -> OpamFile.OPAM.t -> unit