this repo has no description
Remove dependency on the 'result' package
This package is no longer needed since our lower-bound is 4.08.
The Result prefix in Result.result and Result.Ok can be removed to make
the code nicer.
authored by
Jules Aguillon
and committed by
-1
odoc-parser.opam
-1
odoc-parser.opam
-1
odoc.opam
-1
odoc.opam
+1
-1
src/document/utils.ml
+1
-1
src/document/utils.ml
+1
-1
src/document/utils.mli
+1
-1
src/document/utils.mli
-1
src/loader/odoc_loader.mli
-1
src/loader/odoc_loader.mli
+1
-1
src/model/dune
+1
-1
src/model/dune
+1
-3
src/model/error.ml
+1
-3
src/model/error.ml
···
1
-
open Result
2
-
3
let enable_missing_root_warning = ref false
4
5
type full_location_payload = Odoc_parser.Warning.t = {
···
90
let warnings = List.rev !raised_warnings in
91
{ value; warnings })
92
93
-
type 'a with_errors_and_warnings = ('a, t) Result.result with_warnings
94
95
let raise_errors_and_warnings we =
96
match raise_warnings we with Ok x -> x | Error e -> raise_exception e
···
1
let enable_missing_root_warning = ref false
2
3
type full_location_payload = Odoc_parser.Warning.t = {
···
88
let warnings = List.rev !raised_warnings in
89
{ value; warnings })
90
91
+
type 'a with_errors_and_warnings = ('a, t) result with_warnings
92
93
let raise_errors_and_warnings we =
94
match raise_warnings we with Ok x -> x | Error e -> raise_exception e
+4
-4
src/model/error.mli
+4
-4
src/model/error.mli
···
16
(** Raise a {!t} as an exception. Can be caught with {!catch} or
17
{!catch_errors_and_warnings}. *)
18
19
-
val catch : (unit -> 'a) -> ('a, t) Result.result
20
21
type 'a with_warnings
22
···
30
val catch_warnings : (unit -> 'a) -> 'a with_warnings
31
(** Catch warnings accumulated by [raise_warning]. Safe to nest. *)
32
33
-
type 'a with_errors_and_warnings = ('a, t) Result.result with_warnings
34
(** Subtype of [with_warnings]. *)
35
36
val raise_errors_and_warnings : 'a with_errors_and_warnings -> 'a
···
48
val handle_warnings :
49
warnings_options:warnings_options ->
50
'a with_warnings ->
51
-
('a, [> `Msg of string ]) Result.result
52
(** Print warnings to stderr. If [warn_error] is [true] and there was warnings,
53
returns an [Error]. *)
54
55
val handle_errors_and_warnings :
56
warnings_options:warnings_options ->
57
'a with_errors_and_warnings ->
58
-
('a, [> `Msg of string ]) Result.result
59
(** Like [handle_warnings] but works on the output of
60
[catch_errors_and_warnings]. Error case is converted into a [`Msg]. *)
61
···
16
(** Raise a {!t} as an exception. Can be caught with {!catch} or
17
{!catch_errors_and_warnings}. *)
18
19
+
val catch : (unit -> 'a) -> ('a, t) result
20
21
type 'a with_warnings
22
···
30
val catch_warnings : (unit -> 'a) -> 'a with_warnings
31
(** Catch warnings accumulated by [raise_warning]. Safe to nest. *)
32
33
+
type 'a with_errors_and_warnings = ('a, t) result with_warnings
34
(** Subtype of [with_warnings]. *)
35
36
val raise_errors_and_warnings : 'a with_errors_and_warnings -> 'a
···
48
val handle_warnings :
49
warnings_options:warnings_options ->
50
'a with_warnings ->
51
+
('a, [> `Msg of string ]) result
52
(** Print warnings to stderr. If [warn_error] is [true] and there was warnings,
53
returns an [Error]. *)
54
55
val handle_errors_and_warnings :
56
warnings_options:warnings_options ->
57
'a with_errors_and_warnings ->
58
+
('a, [> `Msg of string ]) result
59
(** Like [handle_warnings] but works on the output of
60
[catch_errors_and_warnings]. Error case is converted into a [`Msg]. *)
61
+5
-5
src/model/frontmatter.ml
+5
-5
src/model/frontmatter.ml
···
74
let parse_children_order loc (co : tag_payload) =
75
let rec parse_words acc words =
76
match words with
77
-
| [] -> Result.Ok (Location_.at loc (Children_order (List.rev acc)))
78
| ({ Location_.value = `Word word; _ } as w) :: tl ->
79
parse_words ({ w with value = parse_child word } :: acc) tl
80
| { Location_.value = `Space; _ } :: tl -> parse_words acc tl
···
93
match t with
94
| [ { Location_.value = `Paragraph words; _ } ] ->
95
let short_title = Comment.link_content_of_inline_elements words in
96
-
Result.Ok (Location_.at loc (Short_title short_title))
97
| _ ->
98
Error
99
(Error.make
···
104
| [
105
{ Location_.value = `Paragraph [ { Location_.value = `Word "open"; _ } ]; _ };
106
] ->
107
-
Result.Ok (Location_.at loc (Toc_status `Open))
108
| [
109
{
110
Location_.value = `Paragraph [ { Location_.value = `Word "hidden"; _ } ];
111
_;
112
};
113
] ->
114
-
Result.Ok (Location_.at loc (Toc_status `Hidden))
115
| _ ->
116
Error
117
(Error.make "@toc_status can only take the 'open' and 'hidden' value"
···
121
match t with
122
| [ { Location_.value = `Paragraph [ { Location_.value = `Word w; _ } ]; _ } ]
123
->
124
-
Result.Ok (Location_.at loc (Order_category w))
125
| _ ->
126
Error
127
(Error.make "@order_category can only take a single word as value" loc)
···
74
let parse_children_order loc (co : tag_payload) =
75
let rec parse_words acc words =
76
match words with
77
+
| [] -> Ok (Location_.at loc (Children_order (List.rev acc)))
78
| ({ Location_.value = `Word word; _ } as w) :: tl ->
79
parse_words ({ w with value = parse_child word } :: acc) tl
80
| { Location_.value = `Space; _ } :: tl -> parse_words acc tl
···
93
match t with
94
| [ { Location_.value = `Paragraph words; _ } ] ->
95
let short_title = Comment.link_content_of_inline_elements words in
96
+
Ok (Location_.at loc (Short_title short_title))
97
| _ ->
98
Error
99
(Error.make
···
104
| [
105
{ Location_.value = `Paragraph [ { Location_.value = `Word "open"; _ } ]; _ };
106
] ->
107
+
Ok (Location_.at loc (Toc_status `Open))
108
| [
109
{
110
Location_.value = `Paragraph [ { Location_.value = `Word "hidden"; _ } ];
111
_;
112
};
113
] ->
114
+
Ok (Location_.at loc (Toc_status `Hidden))
115
| _ ->
116
Error
117
(Error.make "@toc_status can only take the 'open' and 'hidden' value"
···
121
match t with
122
| [ { Location_.value = `Paragraph [ { Location_.value = `Word w; _ } ]; _ } ]
123
->
124
+
Ok (Location_.at loc (Order_category w))
125
| _ ->
126
Error
127
(Error.make "@order_category can only take a single word as value" loc)
+4
-4
src/model/frontmatter.mli
+4
-4
src/model/frontmatter.mli
···
20
val parse_children_order :
21
Location_.span ->
22
tag_payload ->
23
-
(line Location_.with_location, Error.t) Result.result
24
25
val parse_short_title :
26
Location_.span ->
27
tag_payload ->
28
-
(line Location_.with_location, Error.t) Result.result
29
30
val parse_toc_status :
31
Location_.span ->
32
tag_payload ->
33
-
(line Location_.with_location, Error.t) Result.result
34
35
val parse_order_category :
36
Location_.span ->
37
tag_payload ->
38
-
(line Location_.with_location, Error.t) Result.result
39
40
val of_lines : line Location_.with_location list -> t Error.with_warnings
···
20
val parse_children_order :
21
Location_.span ->
22
tag_payload ->
23
+
(line Location_.with_location, Error.t) result
24
25
val parse_short_title :
26
Location_.span ->
27
tag_payload ->
28
+
(line Location_.with_location, Error.t) result
29
30
val parse_toc_status :
31
Location_.span ->
32
tag_payload ->
33
+
(line Location_.with_location, Error.t) result
34
35
val parse_order_category :
36
Location_.span ->
37
tag_payload ->
38
+
(line Location_.with_location, Error.t) result
39
40
val of_lines : line Location_.with_location list -> t Error.with_warnings
+4
-6
src/model/reference.ml
+4
-6
src/model/reference.ml
···
590
in
591
Error.catch_warnings (fun () ->
592
match loop s (String.length s - 1) with
593
-
| Some r -> Result.Ok (r :> path)
594
-
| None -> Result.Error (expected_err_str "a valid path" location))
595
596
let read_mod_longident location lid =
597
Error.catch_warnings (fun () ->
···
601
match p with
602
| (`Root (_, (`TUnknown | `TModule)) | `Dot (_, _) | `Module (_, _))
603
as r ->
604
-
Result.Ok r
605
-
| _ ->
606
-
Result.Error (expected_err_str "a reference to a module" location)
607
-
))
···
590
in
591
Error.catch_warnings (fun () ->
592
match loop s (String.length s - 1) with
593
+
| Some r -> Ok (r :> path)
594
+
| None -> Error (expected_err_str "a valid path" location))
595
596
let read_mod_longident location lid =
597
Error.catch_warnings (fun () ->
···
601
match p with
602
| (`Root (_, (`TUnknown | `TModule)) | `Dot (_, _) | `Module (_, _))
603
as r ->
604
+
Ok r
605
+
| _ -> Error (expected_err_str "a reference to a module" location)))
+14
-14
src/model/semantics.ml
+14
-14
src/model/semantics.ml
···
192
| { value = `Reference (kind, target, content) as value; location } -> (
193
let { Location.value = target; location = target_location } = target in
194
match Error.raise_warnings (Reference.parse target_location target) with
195
-
| Result.Ok target ->
196
let content = non_link_inline_elements ~surrounding:value content in
197
Location.at location (`Reference (target, content))
198
-
| Result.Error error ->
199
Error.raise_warning error;
200
let placeholder =
201
match kind with
···
248
match
249
Error.raise_warnings (Reference.read_mod_longident location value)
250
with
251
-
| Result.Ok r ->
252
{ Comment.module_reference = r; module_synopsis = None } :: acc
253
-
| Result.Error error ->
254
Error.raise_warning error;
255
acc)
256
[] modules
···
288
|> Location.at location
289
in
290
match Error.raise_warnings (Reference.parse_asset href_location href) with
291
-
| Result.Ok target ->
292
`Media (`Reference target, m, content) |> Location.at location
293
-
| Result.Error error -> fallback error)
294
295
and nestable_block_elements elements = List.map nestable_block_element elements
296
···
300
Ast.ocamldoc_tag ->
301
( Comment.block_element with_location,
302
internal_tags_removed with_location )
303
-
Result.result =
304
fun ~location status tag ->
305
if not status.tags_allowed then
306
(* Trigger a warning but do not remove the tag. Avoid turning tags into
307
text that would render the same. *)
308
Error.raise_warning (tags_not_allowed location);
309
-
let ok t = Result.Ok (Location.at location (`Tag t)) in
310
match tag with
311
| (`Author _ | `Since _ | `Version _) as tag -> ok tag
312
| `Deprecated content -> ok (`Deprecated (nestable_block_elements content))
···
315
| `Raise (name, content) -> (
316
match Error.raise_warnings (Reference.parse location name) with
317
(* TODO: location for just name *)
318
-
| Result.Ok target ->
319
ok (`Raise (`Reference (target, []), nestable_block_elements content))
320
-
| Result.Error error ->
321
Error.raise_warning error;
322
let placeholder = `Code_span name in
323
ok (`Raise (placeholder, nestable_block_elements content)))
···
465
ast_elements
466
| { value = `Tag the_tag; location } -> (
467
match tag ~location status the_tag with
468
-
| Result.Ok element ->
469
traverse ~top_heading_level
470
(element :: comment_elements_acc)
471
ast_elements
472
-
| Result.Error placeholder ->
473
traverse ~top_heading_level comment_elements_acc
474
(placeholder :: ast_elements))
475
| { value = `Heading _ as heading; _ } ->
···
510
match
511
Error.raise_warnings (Reference.read_path_longident r_location s)
512
with
513
-
| Result.Ok path -> next (`Canonical path)
514
-
| Result.Error e ->
515
Error.raise_warning e;
516
loop ~start tags ast' tl))
517
| ({
···
192
| { value = `Reference (kind, target, content) as value; location } -> (
193
let { Location.value = target; location = target_location } = target in
194
match Error.raise_warnings (Reference.parse target_location target) with
195
+
| Ok target ->
196
let content = non_link_inline_elements ~surrounding:value content in
197
Location.at location (`Reference (target, content))
198
+
| Error error ->
199
Error.raise_warning error;
200
let placeholder =
201
match kind with
···
248
match
249
Error.raise_warnings (Reference.read_mod_longident location value)
250
with
251
+
| Ok r ->
252
{ Comment.module_reference = r; module_synopsis = None } :: acc
253
+
| Error error ->
254
Error.raise_warning error;
255
acc)
256
[] modules
···
288
|> Location.at location
289
in
290
match Error.raise_warnings (Reference.parse_asset href_location href) with
291
+
| Ok target ->
292
`Media (`Reference target, m, content) |> Location.at location
293
+
| Error error -> fallback error)
294
295
and nestable_block_elements elements = List.map nestable_block_element elements
296
···
300
Ast.ocamldoc_tag ->
301
( Comment.block_element with_location,
302
internal_tags_removed with_location )
303
+
result =
304
fun ~location status tag ->
305
if not status.tags_allowed then
306
(* Trigger a warning but do not remove the tag. Avoid turning tags into
307
text that would render the same. *)
308
Error.raise_warning (tags_not_allowed location);
309
+
let ok t = Ok (Location.at location (`Tag t)) in
310
match tag with
311
| (`Author _ | `Since _ | `Version _) as tag -> ok tag
312
| `Deprecated content -> ok (`Deprecated (nestable_block_elements content))
···
315
| `Raise (name, content) -> (
316
match Error.raise_warnings (Reference.parse location name) with
317
(* TODO: location for just name *)
318
+
| Ok target ->
319
ok (`Raise (`Reference (target, []), nestable_block_elements content))
320
+
| Error error ->
321
Error.raise_warning error;
322
let placeholder = `Code_span name in
323
ok (`Raise (placeholder, nestable_block_elements content)))
···
465
ast_elements
466
| { value = `Tag the_tag; location } -> (
467
match tag ~location status the_tag with
468
+
| Ok element ->
469
traverse ~top_heading_level
470
(element :: comment_elements_acc)
471
ast_elements
472
+
| Error placeholder ->
473
traverse ~top_heading_level comment_elements_acc
474
(placeholder :: ast_elements))
475
| { value = `Heading _ as heading; _ } ->
···
510
match
511
Error.raise_warnings (Reference.read_path_longident r_location s)
512
with
513
+
| Ok path -> next (`Canonical path)
514
+
| Error e ->
515
Error.raise_warning e;
516
loop ~start tags ast' tl))
517
| ({
+5
-5
src/odoc/bin/main.ml
+5
-5
src/odoc/bin/main.ml
···
37
let convert_fpath =
38
let parse inp =
39
match Arg.(conv_parser file) inp with
40
-
| Ok s -> Result.Ok (Fs.File.of_string s)
41
| Error _ as e -> e
42
and print = Fpath.pp in
43
Arg.conv (parse, print)
···
45
let convert_named_root =
46
let parse inp =
47
match String.cuts inp ~sep:":" with
48
-
| [ s1; s2 ] -> Result.Ok (s1, Fs.Directory.of_string s2)
49
| _ -> Error (`Msg "")
50
in
51
let print ppf (s, t) =
···
54
Arg.conv (parse, print)
55
56
let handle_error = function
57
-
| Result.Ok () -> ()
58
| Error (`Cli_error msg) ->
59
Printf.eprintf "%s\n%!" msg;
60
exit 2
···
86
rest
87
&& check rest
88
in
89
-
if check l then Result.Ok ()
90
else
91
let msg =
92
Format.sprintf "Paths given to all %s options must be disjoint" opt
···
1273
let convert_remap =
1274
let parse inp =
1275
match String.cut ~sep:":" inp with
1276
-
| Some (orig, mapped) -> Result.Ok (orig, mapped)
1277
| _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
1278
and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
1279
Arg.conv (parse, print)
···
37
let convert_fpath =
38
let parse inp =
39
match Arg.(conv_parser file) inp with
40
+
| Ok s -> Ok (Fs.File.of_string s)
41
| Error _ as e -> e
42
and print = Fpath.pp in
43
Arg.conv (parse, print)
···
45
let convert_named_root =
46
let parse inp =
47
match String.cuts inp ~sep:":" with
48
+
| [ s1; s2 ] -> Ok (s1, Fs.Directory.of_string s2)
49
| _ -> Error (`Msg "")
50
in
51
let print ppf (s, t) =
···
54
Arg.conv (parse, print)
55
56
let handle_error = function
57
+
| Ok () -> ()
58
| Error (`Cli_error msg) ->
59
Printf.eprintf "%s\n%!" msg;
60
exit 2
···
86
rest
87
&& check rest
88
in
89
+
if check l then Ok ()
90
else
91
let msg =
92
Format.sprintf "Paths given to all %s options must be disjoint" opt
···
1273
let convert_remap =
1274
let parse inp =
1275
match String.cut ~sep:":" inp with
1276
+
| Some (orig, mapped) -> Ok (orig, mapped)
1277
| _ -> Error (`Msg "Map must be of the form '<orig>:https://...'")
1278
and print fmt (orig, mapped) = Format.fprintf fmt "%s:%s" orig mapped in
1279
Arg.conv (parse, print)
+16
-17
src/odoc/fs.ml
+16
-17
src/odoc/fs.ml
···
51
52
let create ~directory ~name =
53
match Fpath.of_string name with
54
-
| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.create: " ^ e)
55
-
| Result.Ok psuf -> Fpath.(normalize @@ (directory // psuf))
56
57
let to_string = Fpath.to_string
58
let segs = Fpath.segs
59
60
let of_string s =
61
match Fpath.of_string s with
62
-
| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.of_string: " ^ e)
63
-
| Result.Ok p -> p
64
65
let read file =
66
let input_one_shot len ic =
67
let buf = Bytes.create len in
68
really_input ic buf 0 len;
69
close_in ic;
70
-
Result.Ok (Bytes.unsafe_to_string buf)
71
in
72
let input_stream file ic =
73
let bsize =
···
78
let rec loop () =
79
match Buffer.add_channel buf ic bsize with
80
| () -> loop ()
81
-
| exception End_of_file -> Result.Ok (Buffer.contents buf)
82
| exception Failure _ ->
83
-
Result.Error (`Msg (Printf.sprintf "%s: input too large" file))
84
in
85
loop ()
86
in
···
95
| len when len <= Sys.max_string_length -> input_one_shot len ic
96
| len ->
97
let err = Printf.sprintf "%s: file too large (%d bytes)" file len in
98
-
Result.Error (`Msg err)
99
-
with Sys_error e -> Result.Error (`Msg e)
100
101
let copy ~src ~dst =
102
try
···
112
loop ())
113
in
114
Ok (loop ())))
115
-
with Sys_error e -> Result.Error (`Msg e)
116
117
let exists file = Sys.file_exists (Fpath.to_string file)
118
···
147
148
let make_path p name =
149
match Fpath.of_string name with
150
-
| Result.Error _ as e -> e
151
-
| Result.Ok psuf ->
152
-
Result.Ok Fpath.(normalize @@ to_dir_path @@ (p // psuf))
153
154
let reach_from ~dir path =
155
match make_path dir path with
156
-
| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.create: " ^ e)
157
-
| Result.Ok path ->
158
let pstr = Fpath.to_string path in
159
if Sys.file_exists pstr && not (Sys.is_directory pstr) then
160
invalid_arg "Odoc.Fs.Directory.create: not a directory";
···
172
173
let of_string s =
174
match Fpath.of_string s with
175
-
| Result.Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.of_string: " ^ e)
176
-
| Result.Ok p -> Fpath.to_dir_path p
177
178
let of_file f = Fpath.to_dir_path f
179
···
51
52
let create ~directory ~name =
53
match Fpath.of_string name with
54
+
| Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.create: " ^ e)
55
+
| Ok psuf -> Fpath.(normalize @@ (directory // psuf))
56
57
let to_string = Fpath.to_string
58
let segs = Fpath.segs
59
60
let of_string s =
61
match Fpath.of_string s with
62
+
| Error (`Msg e) -> invalid_arg ("Odoc.Fs.File.of_string: " ^ e)
63
+
| Ok p -> p
64
65
let read file =
66
let input_one_shot len ic =
67
let buf = Bytes.create len in
68
really_input ic buf 0 len;
69
close_in ic;
70
+
Ok (Bytes.unsafe_to_string buf)
71
in
72
let input_stream file ic =
73
let bsize =
···
78
let rec loop () =
79
match Buffer.add_channel buf ic bsize with
80
| () -> loop ()
81
+
| exception End_of_file -> Ok (Buffer.contents buf)
82
| exception Failure _ ->
83
+
Error (`Msg (Printf.sprintf "%s: input too large" file))
84
in
85
loop ()
86
in
···
95
| len when len <= Sys.max_string_length -> input_one_shot len ic
96
| len ->
97
let err = Printf.sprintf "%s: file too large (%d bytes)" file len in
98
+
Error (`Msg err)
99
+
with Sys_error e -> Error (`Msg e)
100
101
let copy ~src ~dst =
102
try
···
112
loop ())
113
in
114
Ok (loop ())))
115
+
with Sys_error e -> Error (`Msg e)
116
117
let exists file = Sys.file_exists (Fpath.to_string file)
118
···
147
148
let make_path p name =
149
match Fpath.of_string name with
150
+
| Error _ as e -> e
151
+
| Ok psuf -> Ok Fpath.(normalize @@ to_dir_path @@ (p // psuf))
152
153
let reach_from ~dir path =
154
match make_path dir path with
155
+
| Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.create: " ^ e)
156
+
| Ok path ->
157
let pstr = Fpath.to_string path in
158
if Sys.file_exists pstr && not (Sys.is_directory pstr) then
159
invalid_arg "Odoc.Fs.Directory.create: not a directory";
···
171
172
let of_string s =
173
match Fpath.of_string s with
174
+
| Error (`Msg e) -> invalid_arg ("Odoc.Fs.Directory.of_string: " ^ e)
175
+
| Ok p -> Fpath.to_dir_path p
176
177
let of_file f = Fpath.to_dir_path f
178
+1
-3
src/odoc/or_error.ml
+1
-3
src/odoc/or_error.ml
-3
src/odoc/or_error.mli
-3
src/odoc/or_error.mli
+1
-1
src/parser/dune
+1
-1
src/parser/dune
+1
-1
src/utils/dune
+1
-1
src/utils/dune
+2
-7
src/utils/odoc_utils.ml
+2
-7
src/utils/odoc_utils.ml
···
1
(** The [result] type and a bind operator. This module is meant to be opened. *)
2
module ResultMonad = struct
3
-
(** Re-export for compat *)
4
-
type ('a, 'b) result = ('a, 'b) Result.result = Ok of 'a | Error of 'b
5
-
6
let map_error f = function Ok _ as ok -> ok | Error e -> Error (f e)
7
8
let of_option ~error = function Some x -> Ok x | None -> Error error
9
10
-
let bind m f = match m with Ok x -> f x | Error _ as e -> e
11
-
12
-
let ( >>= ) = bind
13
end
14
15
(** A bind operator for the [option] type. This module is meant to be opened. *)
16
module OptionMonad = struct
17
(* The error case become [None], the error value is ignored. *)
18
-
let of_result = function Result.Ok x -> Some x | Error _ -> None
19
20
let ( >>= ) = Option.bind
21
end
···
1
(** The [result] type and a bind operator. This module is meant to be opened. *)
2
module ResultMonad = struct
3
let map_error f = function Ok _ as ok -> ok | Error e -> Error (f e)
4
5
let of_option ~error = function Some x -> Ok x | None -> Error error
6
7
+
let ( >>= ) = Result.bind
8
end
9
10
(** A bind operator for the [option] type. This module is meant to be opened. *)
11
module OptionMonad = struct
12
(* The error case become [None], the error value is ignored. *)
13
+
let of_result = function Ok x -> Some x | Error _ -> None
14
15
let ( >>= ) = Option.bind
16
end
+3
-5
src/xref2/env.ml
+3
-5
src/xref2/env.ml
···
479
root : string -> t -> 'a option;
480
}
481
482
-
type 'a maybe_ambiguous = ('a, [ 'a amb_err | `Not_found ]) Result.result
483
484
let make_scope ?(root = fun _ _ -> None) ?check
485
(filter : _ -> ([< Component.Element.any ] as 'a) option) : 'a scope =
···
503
with
504
| ([ x ] as results), Some c -> (
505
record_lookup_results env results;
506
-
match c env x with
507
-
| Some (`Ambiguous _ as e) -> Result.Error e
508
-
| None -> Result.Ok x)
509
| ([ x ] as results), None ->
510
record_lookup_results env results;
511
-
Result.Ok x
512
| (x :: tl as results), _ ->
513
record_lookup_results env results;
514
Error (`Ambiguous (x, tl))
···
479
root : string -> t -> 'a option;
480
}
481
482
+
type 'a maybe_ambiguous = ('a, [ 'a amb_err | `Not_found ]) result
483
484
let make_scope ?(root = fun _ _ -> None) ?check
485
(filter : _ -> ([< Component.Element.any ] as 'a) option) : 'a scope =
···
503
with
504
| ([ x ] as results), Some c -> (
505
record_lookup_results env results;
506
+
match c env x with Some (`Ambiguous _ as e) -> Error e | None -> Ok x)
507
| ([ x ] as results), None ->
508
record_lookup_results env results;
509
+
Ok x
510
| (x :: tl as results), _ ->
511
record_lookup_results env results;
512
Error (`Ambiguous (x, tl))
+1
-1
src/xref2/env.mli
+1
-1
src/xref2/env.mli
+1
-1
src/xref2/expand_tools.ml
+1
-1
src/xref2/expand_tools.ml
+1
-1
src/xref2/link.ml
+1
-1
src/xref2/link.ml
+1
-2
src/xref2/ref_tools.ml
+1
-2
src/xref2/ref_tools.ml
···
39
type fragment_type_parent_lookup_result =
40
[ `S of signature_lookup_result | `T of datatype_lookup_result ]
41
42
-
type 'a ref_result =
43
-
('a, Errors.Tools_error.reference_lookup_error) Result.result
44
(** The result type for every functions in this module. *)
45
46
let kind_of_find_result = function
···
39
type fragment_type_parent_lookup_result =
40
[ `S of signature_lookup_result | `T of datatype_lookup_result ]
41
42
+
type 'a ref_result = ('a, Errors.Tools_error.reference_lookup_error) result
43
(** The result type for every functions in this module. *)
44
45
let kind_of_find_result = function
+1
-2
src/xref2/ref_tools.mli
+1
-2
src/xref2/ref_tools.mli
+41
-51
src/xref2/tools.ml
+41
-51
src/xref2/tools.ml
···
214
type resolve_module_result =
215
( Cpath.Resolved.module_ * Component.Module.t Component.Delayed.t,
216
simple_module_lookup_error )
217
-
Result.result
218
219
type resolve_module_type_result =
220
( Cpath.Resolved.module_type * Component.ModuleType.t,
221
simple_module_type_lookup_error )
222
-
Result.result
223
224
type resolve_type_result =
225
-
( Cpath.Resolved.type_ * Find.careful_type,
226
-
simple_type_lookup_error )
227
-
Result.result
228
229
type resolve_value_result =
230
-
(Cpath.Resolved.value * Find.value, simple_value_lookup_error) Result.result
231
232
type resolve_class_type_result =
233
( Cpath.Resolved.class_type * Find.careful_class,
234
simple_type_lookup_error )
235
-
Result.result
236
237
type ('a, 'b, 'c) sig_map = { type_ : 'a; module_ : 'b; module_type : 'c }
238
···
285
type result =
286
( Component.Module.t Component.Delayed.t,
287
simple_module_lookup_error )
288
-
Result.result
289
290
let equal = ( = )
291
···
298
type result =
299
( Component.Signature.t * Component.Substitution.t,
300
[ `Parent of parent_lookup_error ] )
301
-
Result.result
302
303
let equal = ( = )
304
···
328
module ExpansionOfModuleMemo = MakeMemo (struct
329
type t = Cpath.Resolved.module_
330
331
-
type result = (expansion, expansion_of_module_error) Result.result
332
333
let equal = ( = )
334
···
552
and lookup_module_gpath :
553
Env.t ->
554
Odoc_model.Paths.Path.Resolved.Module.t ->
555
-
( Component.Module.t Component.Delayed.t,
556
-
simple_module_lookup_error )
557
-
Result.result =
558
fun env path ->
559
match path with
560
| `Identifier i ->
···
589
and lookup_module :
590
Env.t ->
591
Cpath.Resolved.module_ ->
592
-
( Component.Module.t Component.Delayed.t,
593
-
simple_module_lookup_error )
594
-
Result.result =
595
fun env' path' ->
596
let lookup env (path : ExpansionOfModuleMemo.M.key) =
597
match path with
···
630
and lookup_module_type_gpath :
631
Env.t ->
632
Odoc_model.Paths.Path.Resolved.ModuleType.t ->
633
-
(Component.ModuleType.t, simple_module_type_lookup_error) Result.result =
634
fun env path ->
635
match path with
636
| `Identifier i ->
···
655
and lookup_module_type :
656
Env.t ->
657
Cpath.Resolved.module_type ->
658
-
(Component.ModuleType.t, simple_module_type_lookup_error) Result.result =
659
fun env path ->
660
let lookup env =
661
match path with
···
682
Cpath.Resolved.parent ->
683
( Component.Signature.t * Component.Substitution.t,
684
[ `Parent of parent_lookup_error ] )
685
-
Result.result =
686
fun env' parent' ->
687
let lookup env parent =
688
match parent with
···
714
Odoc_model.Paths.Path.Resolved.Module.t ->
715
( Component.Signature.t * Component.Substitution.t,
716
[ `Parent of parent_lookup_error ] )
717
-
Result.result =
718
fun env parent ->
719
lookup_module_gpath env parent
720
|> map_error (fun e -> `Parent (`Parent_module e))
···
728
and lookup_type_gpath :
729
Env.t ->
730
Odoc_model.Paths.Path.Resolved.Type.t ->
731
-
(Find.careful_type, simple_type_lookup_error) Result.result =
732
fun env p ->
733
let do_type p name =
734
lookup_parent_gpath env p
···
774
and lookup_value_gpath :
775
Env.t ->
776
Odoc_model.Paths.Path.Resolved.Value.t ->
777
-
(Find.value, simple_value_lookup_error) Result.result =
778
fun env p ->
779
let do_value p name =
780
lookup_parent_gpath env p
···
797
and lookup_class_type_gpath :
798
Env.t ->
799
Odoc_model.Paths.Path.Resolved.ClassType.t ->
800
-
(Find.careful_class, simple_type_lookup_error) Result.result =
801
fun env p ->
802
let do_type p name =
803
lookup_parent_gpath env p
···
831
and lookup_type :
832
Env.t ->
833
Cpath.Resolved.type_ ->
834
-
(Find.careful_type, simple_type_lookup_error) Result.result =
835
fun env p ->
836
let do_type p name =
837
lookup_parent env p |> map_error (fun e -> (e :> simple_type_lookup_error))
···
862
res
863
864
and lookup_value :
865
-
Env.t ->
866
-
Cpath.Resolved.value ->
867
-
(_, simple_value_lookup_error) Result.result =
868
fun env p ->
869
match p with
870
| `Value (p, id) ->
···
878
and lookup_class_type :
879
Env.t ->
880
Cpath.Resolved.class_type ->
881
-
(Find.careful_class, simple_type_lookup_error) Result.result =
882
fun env p ->
883
let do_type p name =
884
lookup_parent env p |> map_error (fun e -> (e :> simple_type_lookup_error))
···
1522
and module_type_expr_of_module_decl :
1523
Env.t ->
1524
Component.Module.decl ->
1525
-
( Component.ModuleType.expr,
1526
-
simple_module_type_expr_of_module_error )
1527
-
Result.result =
1528
fun env decl ->
1529
match decl with
1530
| Component.Module.Alias (`Resolved r, _) ->
···
1545
and module_type_expr_of_module :
1546
Env.t ->
1547
Component.Module.t ->
1548
-
( Component.ModuleType.expr,
1549
-
simple_module_type_expr_of_module_error )
1550
-
Result.result =
1551
fun env m -> module_type_expr_of_module_decl env m.type_
1552
1553
and expansion_of_module_path :
1554
Env.t ->
1555
strengthen:bool ->
1556
Cpath.module_ ->
1557
-
(expansion, expansion_of_module_error) Result.result =
1558
fun env ~strengthen path ->
1559
match resolve_module env path with
1560
| Ok (p', m) -> (
···
1578
Env.t ->
1579
Component.Signature.t ->
1580
Component.ModuleType.substitution list ->
1581
-
(Component.Signature.t, expansion_of_module_error) Result.result =
1582
fun env sg subs ->
1583
let open Odoc_utils.ResultMonad in
1584
List.fold_left
···
1586
(Ok sg) subs
1587
1588
and assert_not_functor : type err.
1589
-
expansion -> (Component.Signature.t, err) Result.result = function
1590
| Signature sg -> Ok sg
1591
| _ -> assert false
1592
···
1605
Env.t ->
1606
Component.ModuleType.type_of_desc ->
1607
original_path:Cpath.module_ ->
1608
-
(expansion, expansion_of_module_error) Result.result =
1609
fun env desc ~original_path:_ ->
1610
let p, strengthen =
1611
match desc with ModPath p -> (p, false) | StructInclude p -> (p, true)
···
1625
and signature_of_u_module_type_expr :
1626
Env.t ->
1627
Component.ModuleType.U.expr ->
1628
-
(Component.Signature.t, expansion_of_module_error) Result.result =
1629
fun env m ->
1630
match m with
1631
| Component.ModuleType.U.Path p -> (
···
1655
and expansion_of_module_type_expr :
1656
Env.t ->
1657
Component.ModuleType.expr ->
1658
-
(expansion, expansion_of_module_error) Result.result =
1659
fun env m ->
1660
match m with
1661
| Component.ModuleType.Path { p_expansion = Some e; _ } ->
···
1685
and expansion_of_module_type :
1686
Env.t ->
1687
Component.ModuleType.t ->
1688
-
(expansion, expansion_of_module_error) Result.result =
1689
fun env m ->
1690
match m.expr with
1691
| None -> Error `OpaqueModule
···
1694
and expansion_of_module_decl :
1695
Env.t ->
1696
Component.Module.decl ->
1697
-
(expansion, expansion_of_module_error) Result.result =
1698
fun env decl ->
1699
match decl with
1700
(* | Component.Module.Alias (_, Some e) -> Ok (expansion_of_simple_expansion e) *)
···
1703
| Component.Module.ModuleType expr -> expansion_of_module_type_expr env expr
1704
1705
and expansion_of_module :
1706
-
Env.t ->
1707
-
Component.Module.t ->
1708
-
(expansion, expansion_of_module_error) Result.result =
1709
fun env m ->
1710
expansion_of_module_decl env m.type_ >>= function
1711
| Signature sg ->
···
1723
Env.t ->
1724
Cpath.Resolved.module_ ->
1725
Component.Module.t ->
1726
-
(expansion, expansion_of_module_error) Result.result =
1727
fun env' path m ->
1728
let id = path in
1729
let run env _id = expansion_of_module env m in
···
1773
Env.t ->
1774
Component.ModuleType.substitution ->
1775
Component.Signature.t ->
1776
-
(Component.Signature.t, expansion_of_module_error) Result.result =
1777
fun env sub sg ->
1778
(* Used when we haven't finished the substitution. For example, if the
1779
substitution is `M.t = u`, this function is used to map the declaration
···
2117
Env.t ->
2118
Component.Signature.t ->
2119
ModuleName.t ->
2120
-
( Component.Module.t Component.Delayed.t,
2121
-
simple_module_lookup_error )
2122
-
Result.result =
2123
fun env sg name ->
2124
match Find.careful_module_in_sig sg name with
2125
| Some (`FModule (_, m)) -> Ok (Component.Delayed.put_val m)
···
2133
ModuleTypeName.t ->
2134
( Component.ModuleType.t Component.Delayed.t,
2135
simple_module_type_lookup_error )
2136
-
Result.result =
2137
fun _env sg name ->
2138
match Find.careful_module_type_in_sig sg name with
2139
| Some (`FModuleType (_, m)) -> Ok (Component.Delayed.put_val m)
···
214
type resolve_module_result =
215
( Cpath.Resolved.module_ * Component.Module.t Component.Delayed.t,
216
simple_module_lookup_error )
217
+
result
218
219
type resolve_module_type_result =
220
( Cpath.Resolved.module_type * Component.ModuleType.t,
221
simple_module_type_lookup_error )
222
+
result
223
224
type resolve_type_result =
225
+
(Cpath.Resolved.type_ * Find.careful_type, simple_type_lookup_error) result
226
227
type resolve_value_result =
228
+
(Cpath.Resolved.value * Find.value, simple_value_lookup_error) result
229
230
type resolve_class_type_result =
231
( Cpath.Resolved.class_type * Find.careful_class,
232
simple_type_lookup_error )
233
+
result
234
235
type ('a, 'b, 'c) sig_map = { type_ : 'a; module_ : 'b; module_type : 'c }
236
···
283
type result =
284
( Component.Module.t Component.Delayed.t,
285
simple_module_lookup_error )
286
+
Result.t
287
288
let equal = ( = )
289
···
296
type result =
297
( Component.Signature.t * Component.Substitution.t,
298
[ `Parent of parent_lookup_error ] )
299
+
Result.t
300
301
let equal = ( = )
302
···
326
module ExpansionOfModuleMemo = MakeMemo (struct
327
type t = Cpath.Resolved.module_
328
329
+
type result = (expansion, expansion_of_module_error) Result.t
330
331
let equal = ( = )
332
···
550
and lookup_module_gpath :
551
Env.t ->
552
Odoc_model.Paths.Path.Resolved.Module.t ->
553
+
(Component.Module.t Component.Delayed.t, simple_module_lookup_error) result
554
+
=
555
fun env path ->
556
match path with
557
| `Identifier i ->
···
586
and lookup_module :
587
Env.t ->
588
Cpath.Resolved.module_ ->
589
+
(Component.Module.t Component.Delayed.t, simple_module_lookup_error) result
590
+
=
591
fun env' path' ->
592
let lookup env (path : ExpansionOfModuleMemo.M.key) =
593
match path with
···
626
and lookup_module_type_gpath :
627
Env.t ->
628
Odoc_model.Paths.Path.Resolved.ModuleType.t ->
629
+
(Component.ModuleType.t, simple_module_type_lookup_error) result =
630
fun env path ->
631
match path with
632
| `Identifier i ->
···
651
and lookup_module_type :
652
Env.t ->
653
Cpath.Resolved.module_type ->
654
+
(Component.ModuleType.t, simple_module_type_lookup_error) result =
655
fun env path ->
656
let lookup env =
657
match path with
···
678
Cpath.Resolved.parent ->
679
( Component.Signature.t * Component.Substitution.t,
680
[ `Parent of parent_lookup_error ] )
681
+
result =
682
fun env' parent' ->
683
let lookup env parent =
684
match parent with
···
710
Odoc_model.Paths.Path.Resolved.Module.t ->
711
( Component.Signature.t * Component.Substitution.t,
712
[ `Parent of parent_lookup_error ] )
713
+
result =
714
fun env parent ->
715
lookup_module_gpath env parent
716
|> map_error (fun e -> `Parent (`Parent_module e))
···
724
and lookup_type_gpath :
725
Env.t ->
726
Odoc_model.Paths.Path.Resolved.Type.t ->
727
+
(Find.careful_type, simple_type_lookup_error) result =
728
fun env p ->
729
let do_type p name =
730
lookup_parent_gpath env p
···
770
and lookup_value_gpath :
771
Env.t ->
772
Odoc_model.Paths.Path.Resolved.Value.t ->
773
+
(Find.value, simple_value_lookup_error) result =
774
fun env p ->
775
let do_value p name =
776
lookup_parent_gpath env p
···
793
and lookup_class_type_gpath :
794
Env.t ->
795
Odoc_model.Paths.Path.Resolved.ClassType.t ->
796
+
(Find.careful_class, simple_type_lookup_error) result =
797
fun env p ->
798
let do_type p name =
799
lookup_parent_gpath env p
···
827
and lookup_type :
828
Env.t ->
829
Cpath.Resolved.type_ ->
830
+
(Find.careful_type, simple_type_lookup_error) result =
831
fun env p ->
832
let do_type p name =
833
lookup_parent env p |> map_error (fun e -> (e :> simple_type_lookup_error))
···
858
res
859
860
and lookup_value :
861
+
Env.t -> Cpath.Resolved.value -> (_, simple_value_lookup_error) result =
862
fun env p ->
863
match p with
864
| `Value (p, id) ->
···
872
and lookup_class_type :
873
Env.t ->
874
Cpath.Resolved.class_type ->
875
+
(Find.careful_class, simple_type_lookup_error) result =
876
fun env p ->
877
let do_type p name =
878
lookup_parent env p |> map_error (fun e -> (e :> simple_type_lookup_error))
···
1516
and module_type_expr_of_module_decl :
1517
Env.t ->
1518
Component.Module.decl ->
1519
+
(Component.ModuleType.expr, simple_module_type_expr_of_module_error) result
1520
+
=
1521
fun env decl ->
1522
match decl with
1523
| Component.Module.Alias (`Resolved r, _) ->
···
1538
and module_type_expr_of_module :
1539
Env.t ->
1540
Component.Module.t ->
1541
+
(Component.ModuleType.expr, simple_module_type_expr_of_module_error) result
1542
+
=
1543
fun env m -> module_type_expr_of_module_decl env m.type_
1544
1545
and expansion_of_module_path :
1546
Env.t ->
1547
strengthen:bool ->
1548
Cpath.module_ ->
1549
+
(expansion, expansion_of_module_error) result =
1550
fun env ~strengthen path ->
1551
match resolve_module env path with
1552
| Ok (p', m) -> (
···
1570
Env.t ->
1571
Component.Signature.t ->
1572
Component.ModuleType.substitution list ->
1573
+
(Component.Signature.t, expansion_of_module_error) result =
1574
fun env sg subs ->
1575
let open Odoc_utils.ResultMonad in
1576
List.fold_left
···
1578
(Ok sg) subs
1579
1580
and assert_not_functor : type err.
1581
+
expansion -> (Component.Signature.t, err) result = function
1582
| Signature sg -> Ok sg
1583
| _ -> assert false
1584
···
1597
Env.t ->
1598
Component.ModuleType.type_of_desc ->
1599
original_path:Cpath.module_ ->
1600
+
(expansion, expansion_of_module_error) result =
1601
fun env desc ~original_path:_ ->
1602
let p, strengthen =
1603
match desc with ModPath p -> (p, false) | StructInclude p -> (p, true)
···
1617
and signature_of_u_module_type_expr :
1618
Env.t ->
1619
Component.ModuleType.U.expr ->
1620
+
(Component.Signature.t, expansion_of_module_error) result =
1621
fun env m ->
1622
match m with
1623
| Component.ModuleType.U.Path p -> (
···
1647
and expansion_of_module_type_expr :
1648
Env.t ->
1649
Component.ModuleType.expr ->
1650
+
(expansion, expansion_of_module_error) result =
1651
fun env m ->
1652
match m with
1653
| Component.ModuleType.Path { p_expansion = Some e; _ } ->
···
1677
and expansion_of_module_type :
1678
Env.t ->
1679
Component.ModuleType.t ->
1680
+
(expansion, expansion_of_module_error) result =
1681
fun env m ->
1682
match m.expr with
1683
| None -> Error `OpaqueModule
···
1686
and expansion_of_module_decl :
1687
Env.t ->
1688
Component.Module.decl ->
1689
+
(expansion, expansion_of_module_error) result =
1690
fun env decl ->
1691
match decl with
1692
(* | Component.Module.Alias (_, Some e) -> Ok (expansion_of_simple_expansion e) *)
···
1695
| Component.Module.ModuleType expr -> expansion_of_module_type_expr env expr
1696
1697
and expansion_of_module :
1698
+
Env.t -> Component.Module.t -> (expansion, expansion_of_module_error) result
1699
+
=
1700
fun env m ->
1701
expansion_of_module_decl env m.type_ >>= function
1702
| Signature sg ->
···
1714
Env.t ->
1715
Cpath.Resolved.module_ ->
1716
Component.Module.t ->
1717
+
(expansion, expansion_of_module_error) result =
1718
fun env' path m ->
1719
let id = path in
1720
let run env _id = expansion_of_module env m in
···
1764
Env.t ->
1765
Component.ModuleType.substitution ->
1766
Component.Signature.t ->
1767
+
(Component.Signature.t, expansion_of_module_error) result =
1768
fun env sub sg ->
1769
(* Used when we haven't finished the substitution. For example, if the
1770
substitution is `M.t = u`, this function is used to map the declaration
···
2108
Env.t ->
2109
Component.Signature.t ->
2110
ModuleName.t ->
2111
+
(Component.Module.t Component.Delayed.t, simple_module_lookup_error) result
2112
+
=
2113
fun env sg name ->
2114
match Find.careful_module_in_sig sg name with
2115
| Some (`FModule (_, m)) -> Ok (Component.Delayed.put_val m)
···
2123
ModuleTypeName.t ->
2124
( Component.ModuleType.t Component.Delayed.t,
2125
simple_module_type_lookup_error )
2126
+
result =
2127
fun _env sg name ->
2128
match Find.careful_module_type_in_sig sg name with
2129
| Some (`FModuleType (_, m)) -> Ok (Component.Delayed.put_val m)
+21
-28
src/xref2/tools.mli
+21
-28
src/xref2/tools.mli
···
46
val lookup_module :
47
Env.t ->
48
Cpath.Resolved.module_ ->
49
-
( Component.Module.t Component.Delayed.t,
50
-
simple_module_lookup_error )
51
-
Result.result
52
(** [lookup_module ~mark_substituted env p] takes a resolved module cpath [p]
53
and an environment and returns a representation of the module. *)
54
55
val lookup_module_type :
56
Env.t ->
57
Cpath.Resolved.module_type ->
58
-
(Component.ModuleType.t, simple_module_type_lookup_error) Result.result
59
(** [lookup_module_type ~mark_substituted env p] takes a resolved module type
60
cpath and an environment and returns a representation of the module type. *)
61
62
val lookup_type :
63
Env.t ->
64
Cpath.Resolved.type_ ->
65
-
(Find.careful_type, simple_type_lookup_error) Result.result
66
(** [lookup_type env p] takes a resolved type path and an environment and
67
returns a representation of the type. The type can be an ordinary type, a
68
class type or a class. If the type has been destructively substituted, the
···
71
val lookup_class_type :
72
Env.t ->
73
Cpath.Resolved.class_type ->
74
-
(Find.careful_class, simple_type_lookup_error) Result.result
75
(** [lookup_class_type env p] takes a resolved class type path and an
76
environment and returns a representation of the class type. The type can be
77
a class type or a class. *)
···
81
Cpath.module_ ->
82
( Cpath.Resolved.module_ * Component.Module.t Component.Delayed.t,
83
simple_module_lookup_error )
84
-
Result.result
85
(** [resolve_module ~mark_substituted ~add_canonical env p] takes an unresolved
86
module path and an environment and returns a tuple of the resolved module
87
path alongside a representation of the module itself. *)
···
91
Cpath.module_type ->
92
( Cpath.Resolved.module_type * Component.ModuleType.t,
93
simple_module_type_lookup_error )
94
-
Result.result
95
(** [resolve_module_type ~mark_substituted ~add_canonical env p] takes an
96
unresolved module type path and an environment and returns a tuple of the
97
resolved module type path alongside a representation of the module type
···
100
val resolve_type :
101
Env.t ->
102
Cpath.type_ ->
103
-
( Cpath.Resolved.type_ * Find.careful_type,
104
-
simple_type_lookup_error )
105
-
Result.result
106
(** [resolve_type env p] takes an unresolved type path and an environment and
107
returns a tuple of the resolved type path alongside a representation of the
108
type itself. As with {!val:lookup_type} the returned type is either the
···
114
Cpath.class_type ->
115
( Cpath.Resolved.class_type * Find.careful_class,
116
simple_type_lookup_error )
117
-
Result.result
118
(** [resolve_class_type env p] takes an unresolved class type path and an
119
environment and returns a tuple of the resolved class type path alongside a
120
representation of the class type itself. As with {!val:lookup_type} the
···
132
val resolve_module_path :
133
Env.t ->
134
Cpath.module_ ->
135
-
(Cpath.Resolved.module_, simple_module_lookup_error) Result.result
136
137
val resolve_module_type_path :
138
Env.t ->
139
Cpath.module_type ->
140
-
(Cpath.Resolved.module_type, simple_module_type_lookup_error) Result.result
141
142
val resolve_type_path :
143
Env.t ->
144
Cpath.type_ ->
145
-
(Cpath.Resolved.type_, simple_type_lookup_error) Result.result
146
147
val resolve_value_path :
148
Env.t ->
149
Cpath.value ->
150
-
(Cpath.Resolved.value, simple_value_lookup_error) Result.result
151
152
val resolve_class_type_path :
153
Env.t ->
154
Cpath.class_type ->
155
-
(Cpath.Resolved.class_type, simple_type_lookup_error) Result.result
156
157
(** {2 Re-resolve functions} *)
158
···
203
val prefix_signature :
204
Cpath.Resolved.parent * Component.Signature.t -> Component.Signature.t
205
206
-
val assert_not_functor :
207
-
expansion -> (Component.Signature.t, 'err) Result.result
208
209
val expansion_of_module_path :
210
Env.t ->
211
strengthen:bool ->
212
Cpath.module_ ->
213
-
(expansion, expansion_of_module_error) Result.result
214
215
val expansion_of_module :
216
-
Env.t ->
217
-
Component.Module.t ->
218
-
(expansion, expansion_of_module_error) Result.result
219
220
val expansion_of_module_type :
221
Env.t ->
222
Component.ModuleType.t ->
223
-
(expansion, expansion_of_module_error) Result.result
224
225
val class_signature_of_class_type :
226
Env.t -> Component.ClassType.t -> Component.ClassSignature.t option
···
233
val expansion_of_module_type_expr :
234
Env.t ->
235
Component.ModuleType.expr ->
236
-
(expansion, expansion_of_module_error) Result.result
237
(** The following functions are use for the resolution of
238
{{!type:Odoc_model.Paths.Fragment.t}Fragments} Whilst resolving fragments it
239
is necessary to process them in order, applying the 'with' expression of
···
247
val signature_of_u_module_type_expr :
248
Env.t ->
249
Component.ModuleType.U.expr ->
250
-
(Component.Signature.t, expansion_of_module_error) Result.result
251
(** The following functions are use for the resolution of
252
{{!type:Odoc_model.Paths.Fragment.t}Fragments} Whilst resolving fragments it
253
is necessary to process them in order, applying the 'with' expression of
···
320
Env.t ->
321
Component.ModuleType.substitution ->
322
Component.Signature.t ->
323
-
(Component.Signature.t, expansion_of_module_error) Result.result
324
(** [fragmap ~mark_substituted env sub sg] takes an environment [env] and
325
signature [sg], and a fragment substitution (e.g. [ModuleSubst] to
326
destructively substitute a module), and returns the substituted signature.
···
330
Env.t ->
331
Component.Signature.t ->
332
Component.ModuleType.substitution list ->
333
-
(Component.Signature.t, expansion_of_module_error) Result.result
334
(** [handle_signature_with_subs ~mark_substituted env sg subs] applies the
335
fragment modifiers [subs], in order, to the supplied signature [sg]. *)
336
···
46
val lookup_module :
47
Env.t ->
48
Cpath.Resolved.module_ ->
49
+
(Component.Module.t Component.Delayed.t, simple_module_lookup_error) result
50
(** [lookup_module ~mark_substituted env p] takes a resolved module cpath [p]
51
and an environment and returns a representation of the module. *)
52
53
val lookup_module_type :
54
Env.t ->
55
Cpath.Resolved.module_type ->
56
+
(Component.ModuleType.t, simple_module_type_lookup_error) result
57
(** [lookup_module_type ~mark_substituted env p] takes a resolved module type
58
cpath and an environment and returns a representation of the module type. *)
59
60
val lookup_type :
61
Env.t ->
62
Cpath.Resolved.type_ ->
63
+
(Find.careful_type, simple_type_lookup_error) result
64
(** [lookup_type env p] takes a resolved type path and an environment and
65
returns a representation of the type. The type can be an ordinary type, a
66
class type or a class. If the type has been destructively substituted, the
···
69
val lookup_class_type :
70
Env.t ->
71
Cpath.Resolved.class_type ->
72
+
(Find.careful_class, simple_type_lookup_error) result
73
(** [lookup_class_type env p] takes a resolved class type path and an
74
environment and returns a representation of the class type. The type can be
75
a class type or a class. *)
···
79
Cpath.module_ ->
80
( Cpath.Resolved.module_ * Component.Module.t Component.Delayed.t,
81
simple_module_lookup_error )
82
+
result
83
(** [resolve_module ~mark_substituted ~add_canonical env p] takes an unresolved
84
module path and an environment and returns a tuple of the resolved module
85
path alongside a representation of the module itself. *)
···
89
Cpath.module_type ->
90
( Cpath.Resolved.module_type * Component.ModuleType.t,
91
simple_module_type_lookup_error )
92
+
result
93
(** [resolve_module_type ~mark_substituted ~add_canonical env p] takes an
94
unresolved module type path and an environment and returns a tuple of the
95
resolved module type path alongside a representation of the module type
···
98
val resolve_type :
99
Env.t ->
100
Cpath.type_ ->
101
+
(Cpath.Resolved.type_ * Find.careful_type, simple_type_lookup_error) result
102
(** [resolve_type env p] takes an unresolved type path and an environment and
103
returns a tuple of the resolved type path alongside a representation of the
104
type itself. As with {!val:lookup_type} the returned type is either the
···
110
Cpath.class_type ->
111
( Cpath.Resolved.class_type * Find.careful_class,
112
simple_type_lookup_error )
113
+
result
114
(** [resolve_class_type env p] takes an unresolved class type path and an
115
environment and returns a tuple of the resolved class type path alongside a
116
representation of the class type itself. As with {!val:lookup_type} the
···
128
val resolve_module_path :
129
Env.t ->
130
Cpath.module_ ->
131
+
(Cpath.Resolved.module_, simple_module_lookup_error) result
132
133
val resolve_module_type_path :
134
Env.t ->
135
Cpath.module_type ->
136
+
(Cpath.Resolved.module_type, simple_module_type_lookup_error) result
137
138
val resolve_type_path :
139
Env.t ->
140
Cpath.type_ ->
141
+
(Cpath.Resolved.type_, simple_type_lookup_error) result
142
143
val resolve_value_path :
144
Env.t ->
145
Cpath.value ->
146
+
(Cpath.Resolved.value, simple_value_lookup_error) result
147
148
val resolve_class_type_path :
149
Env.t ->
150
Cpath.class_type ->
151
+
(Cpath.Resolved.class_type, simple_type_lookup_error) result
152
153
(** {2 Re-resolve functions} *)
154
···
199
val prefix_signature :
200
Cpath.Resolved.parent * Component.Signature.t -> Component.Signature.t
201
202
+
val assert_not_functor : expansion -> (Component.Signature.t, 'err) result
203
204
val expansion_of_module_path :
205
Env.t ->
206
strengthen:bool ->
207
Cpath.module_ ->
208
+
(expansion, expansion_of_module_error) result
209
210
val expansion_of_module :
211
+
Env.t -> Component.Module.t -> (expansion, expansion_of_module_error) result
212
213
val expansion_of_module_type :
214
Env.t ->
215
Component.ModuleType.t ->
216
+
(expansion, expansion_of_module_error) result
217
218
val class_signature_of_class_type :
219
Env.t -> Component.ClassType.t -> Component.ClassSignature.t option
···
226
val expansion_of_module_type_expr :
227
Env.t ->
228
Component.ModuleType.expr ->
229
+
(expansion, expansion_of_module_error) result
230
(** The following functions are use for the resolution of
231
{{!type:Odoc_model.Paths.Fragment.t}Fragments} Whilst resolving fragments it
232
is necessary to process them in order, applying the 'with' expression of
···
240
val signature_of_u_module_type_expr :
241
Env.t ->
242
Component.ModuleType.U.expr ->
243
+
(Component.Signature.t, expansion_of_module_error) result
244
(** The following functions are use for the resolution of
245
{{!type:Odoc_model.Paths.Fragment.t}Fragments} Whilst resolving fragments it
246
is necessary to process them in order, applying the 'with' expression of
···
313
Env.t ->
314
Component.ModuleType.substitution ->
315
Component.Signature.t ->
316
+
(Component.Signature.t, expansion_of_module_error) result
317
(** [fragmap ~mark_substituted env sub sg] takes an environment [env] and
318
signature [sg], and a fragment substitution (e.g. [ModuleSubst] to
319
destructively substitute a module), and returns the substituted signature.
···
323
Env.t ->
324
Component.Signature.t ->
325
Component.ModuleType.substitution list ->
326
+
(Component.Signature.t, expansion_of_module_error) result
327
(** [handle_signature_with_subs ~mark_substituted env sg subs] applies the
328
fragment modifiers [subs], in order, to the supplied signature [sg]. *)
329
+1
-1
test/odoc_print/print_index.ml
+1
-1
test/odoc_print/print_index.ml
+1
-1
test/xref2/resolve/test.md
+1
-1
test/xref2/resolve/test.md
···
62
over the tree. For this example the interesting point comes when we get to
63
looking at the manifest for type `u`. We see that we have a `Constr` that has a
64
path in it, so we look up the component from the path via the function
65
-
`Tools.lookup_type_from_model_path`. This returns us a `Result.result`
66
containing the resolved path and the `Component.Type.t` that represents the
67
type `t`. We don't particularly care about this, but the returned path we use
68
in place of the path we had before.
···
62
over the tree. For this example the interesting point comes when we get to
63
looking at the manifest for type `u`. We see that we have a `Constr` that has a
64
path in it, so we look up the component from the path via the function
65
+
`Tools.lookup_type_from_model_path`. This returns us a `result`
66
containing the resolved path and the `Component.Type.t` that represents the
67
type `t`. We don't particularly care about this, but the returned path we use
68
in place of the path we had before.