this repo has no description
Extract code: handle cmti files
authored by
Paul-Elliot
and committed by
+12
src/loader/doc_attr.mli
+12
src/loader/doc_attr.mli
···
81
81
val conv_canonical_type : Odoc_model.Reference.path -> Paths.Path.Type.t option
82
82
val conv_canonical_module_type :
83
83
Odoc_model.Reference.path -> Paths.Path.ModuleType.t option
84
+
85
+
type payload = string * Location.t
86
+
87
+
type parsed_attribute =
88
+
[ `Text of payload (* Standalone comment. *)
89
+
| `Doc of payload (* Attached comment. *)
90
+
| `Stop of Location.t (* [(**/**)]. *)
91
+
| `Alert of string * payload option * Location.t
92
+
(* [`Alert (name, payload, loc)] is for [\[@@alert name "payload"\]] attributes. *)
93
+
]
94
+
95
+
val parse_attribute : Parsetree.attribute -> parsed_attribute option
+2
src/loader/odoc_loader.ml
+2
src/loader/odoc_loader.ml
+2
src/loader/odoc_loader.mli
+2
src/loader/odoc_loader.mli
+53
-9
src/odoc/extract_code.ml
+53
-9
src/odoc/extract_code.ml
···
24
24
in
25
25
match names with [] -> check_language () | _ :: _ -> check_name ()
26
26
27
-
let print oc line_directives location value =
27
+
let print line_directives oc location value =
28
28
if line_directives then (
29
-
Printf.fprintf oc "#%d \"%s\"\n" (location.Loc.start.line + 1) location.file;
29
+
Printf.fprintf oc "#%d \"%s\"\n" location.Loc.start.line location.file;
30
30
Printf.fprintf oc "%s%s\n"
31
-
(String.v ~len:(location.start.column + 1) (fun _ -> ' '))
31
+
(String.v ~len:location.start.column (fun _ -> ' '))
32
32
value)
33
33
else Printf.fprintf oc "%s" value
34
34
···
37
37
| `Verbatim _ | `Modules _ | `Math_block _ | `Media _ | `Paragraph _ -> ()
38
38
| `Code_block { Ast.content = { value; location }; meta; _ }
39
39
when needs_extraction names meta ->
40
-
print oc line_directives location value
40
+
print line_directives oc location value
41
41
| `Code_block _ -> ()
42
42
| `List (_, _, l) ->
43
43
List.iter (List.iter (nestable_block_element line_directives oc names)) l
···
47
47
List.iter (nestable_block_element line_directives oc names) x))
48
48
table
49
49
50
-
and block_element line_directives oc names v =
50
+
let block_element line_directives oc names v =
51
51
match v.Loc.value with
52
52
| `Tag
53
53
( `Deprecated l
···
66
66
| #Ast.nestable_block_element as value ->
67
67
nestable_block_element line_directives oc names { v with value }
68
68
69
-
let extract ~dst ~input ~names ~line_directives =
69
+
let pad_loc loc =
70
+
{ loc.Location.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 }
71
+
72
+
let iterator line_directives oc names =
73
+
let attribute _ attr =
74
+
match Odoc_loader.parse_attribute attr with
75
+
| None | Some (`Stop _ | `Alert _) -> ()
76
+
| Some (`Text (doc, loc) | `Doc (doc, loc)) ->
77
+
let ast_docs =
78
+
Odoc_parser.parse_comment ~location:(pad_loc loc) ~text:doc
79
+
in
80
+
let ast = Odoc_parser.ast ast_docs in
81
+
List.iter (block_element line_directives oc names) ast
82
+
in
83
+
(* For some reason, Tast_iterator.default_iterator does not recurse on
84
+
Tsig_attribute and on attributes... *)
85
+
let signature_item sub sig_ =
86
+
match sig_.Typedtree.sig_desc with
87
+
| Tsig_attribute attr -> attribute sub attr
88
+
| _ -> Tast_iterator.default_iterator.signature_item sub sig_
89
+
in
90
+
let attributes sub attrs = List.iter (attribute sub) attrs in
91
+
{ Tast_iterator.default_iterator with attribute; attributes; signature_item }
92
+
93
+
let load_cmti line_directives oc names input =
94
+
let cmt_info = Cmt_format.read_cmt input in
95
+
match cmt_info.cmt_annots with
96
+
| Interface intf ->
97
+
let iterator = iterator line_directives oc names in
98
+
iterator.signature iterator intf
99
+
| _ -> failwith "TODO"
100
+
101
+
let load_mld line_directives oc names input =
70
102
let location =
71
-
{ Lexing.pos_fname = input; pos_lnum = 0; pos_bol = 0; pos_cnum = 0 }
103
+
{ Lexing.pos_fname = input; pos_lnum = 1; pos_bol = 0; pos_cnum = 0 }
72
104
in
73
105
let c = Io_utils.read_lines input |> String.concat ~sep:"\n" in
74
106
let parsed = parse_comment ~location ~text:c in
75
107
let ast = ast parsed in
76
-
let go oc = List.iter (block_element line_directives oc names) ast in
77
-
match dst with None -> go stdout | Some dst -> Io_utils.with_open_out dst go
108
+
List.iter (block_element line_directives oc names) ast
109
+
110
+
let extract ~dst ~input ~names ~line_directives =
111
+
let loader =
112
+
match input |> Fpath.v |> Fpath.get_ext with
113
+
| ".mld" -> load_mld
114
+
| ".cmti" -> load_cmti
115
+
| _ -> failwith "TODO"
116
+
in
117
+
match dst with
118
+
| None -> loader line_directives stdout names input
119
+
| Some dst ->
120
+
Io_utils.with_open_out dst @@ fun oc ->
121
+
loader line_directives oc names input
+25
test/extract_code/cmti_extraction.t/main.mli
+25
test/extract_code/cmti_extraction.t/main.mli
···
1
+
(** {[
2
+
let x = 1
3
+
]} *)
4
+
5
+
val x : int
6
+
[@@deriving none]
7
+
(** {[
8
+
let () =
9
+
print_int x;
10
+
print_newline ()
11
+
]} *)
12
+
13
+
module A : sig
14
+
val x : int
15
+
(** {[
16
+
let hello = 2
17
+
]} *)
18
+
end
19
+
20
+
type t =
21
+
| A of int
22
+
(** {[
23
+
let _ = hello +. hello
24
+
]} *)
25
+
| B of int
+29
test/extract_code/cmti_extraction.t/run.t
+29
test/extract_code/cmti_extraction.t/run.t
···
1
+
$ ocamlc -bin-annot main.mli
2
+
$ odoc extract-code -o output.ml --line-directives main.cmti
3
+
4
+
$ cat output.ml
5
+
#1 "main.mli"
6
+
7
+
let x = 1
8
+
9
+
#7 "main.mli"
10
+
11
+
let () =
12
+
print_int x;
13
+
print_newline ()
14
+
15
+
#15 "main.mli"
16
+
17
+
let hello = 2
18
+
19
+
#22 "main.mli"
20
+
21
+
let _ = hello +. hello
22
+
23
+
24
+
$ ocaml output.ml
25
+
1
26
+
File "main.mli", line 23, characters 20-25:
27
+
Error: This expression has type "int" but an expression was expected of type
28
+
"float"
29
+
[2]
+11
-11
test/extract_code/mld_extraction.t/run.t
+11
-11
test/extract_code/mld_extraction.t/run.t
···
26
26
27
27
$ odoc extract-code --line-directives --name error.ml --name printing main.mld
28
28
#18 "main.mld"
29
-
let five = 5
29
+
let five = 5
30
30
#20 "main.mld"
31
-
31
+
32
32
let () = print_int five
33
33
34
34
#25 "main.mld"
35
-
35
+
36
36
let y = five +. five (* This is a typing error *)
37
37
38
38
···
42
42
43
43
$ odoc extract-code --line-directives main.mld
44
44
#5 "main.mld"
45
-
45
+
46
46
(** By default, an odoc code block is assumed to contain OCaml code *)
47
47
let () = ()
48
48
49
49
#18 "main.mld"
50
-
let five = 5
50
+
let five = 5
51
51
#20 "main.mld"
52
-
52
+
53
53
let () = print_int five
54
54
55
55
#25 "main.mld"
56
-
56
+
57
57
let y = five +. five (* This is a typing error *)
58
58
59
59
···
61
61
62
62
$ odoc extract-code --line-directives --name error.ml main.mld
63
63
#18 "main.mld"
64
-
let five = 5
64
+
let five = 5
65
65
#25 "main.mld"
66
-
66
+
67
67
let y = five +. five (* This is a typing error *)
68
68
69
69
···
72
72
$ odoc extract-code --line-directives --name error.ml -o error.ml main.mld
73
73
$ cat error.ml
74
74
#18 "main.mld"
75
-
let five = 5
75
+
let five = 5
76
76
#25 "main.mld"
77
-
77
+
78
78
let y = five +. five (* This is a typing error *)
79
79
80
80