this repo has no description
Remove document/Utils in favor of Odoc_utils
Remove list operations that were not needed and move skip_until and
split_at into Odoc_utils.
Document related utils could be moved to Codefmt.
This makes the code more consistent regarding List and String
manipulations.
authored by
Jules Aguillon
and committed by
+23
-2
src/document/codefmt.ml
+23
-2
src/document/codefmt.ml
···
42
flush state)
43
end
44
45
(** Modern implementation using semantic tags, Only for 4.08+ *)
46
47
(*
···
79
80
let elt ppf elt =
81
Format.pp_open_stag ppf (Elt elt);
82
-
Format.pp_print_as ppf (Utils.compute_length_inline elt) "";
83
Format.pp_close_stag ppf ()
84
85
let ignore ppf txt =
···
140
141
let elt ppf (elt : Inline.t) =
142
Format.fprintf ppf "@{<tag:%s>%t@}" (Marshal.to_string elt []) (fun fmt ->
143
-
Format.pp_print_as fmt (Utils.compute_length_inline elt) "")
144
145
let ignore ppf txt = Format.fprintf ppf "@{<ignore-tag>%t@}" txt
146
end
···
42
flush state)
43
end
44
45
+
let rec compute_length_source (t : Types.Source.t) : int =
46
+
let f (acc : int) = function
47
+
| Types.Source.Elt t -> acc + compute_length_inline t
48
+
| Types.Source.Tag (_, t) -> acc + compute_length_source t
49
+
in
50
+
List.fold_left f 0 t
51
+
52
+
and compute_length_inline (t : Types.Inline.t) : int =
53
+
let f (acc : int) { Types.Inline.desc; _ } =
54
+
match desc with
55
+
| Text s -> acc + String.length s
56
+
| Entity _e -> acc + 1
57
+
| Linebreak -> 0 (* TODO *)
58
+
| Styled (_, t) | Link { content = t; _ } -> acc + compute_length_inline t
59
+
| Source s -> acc + compute_length_source s
60
+
| Math _ -> assert false
61
+
| Raw_markup _ -> assert false
62
+
(* TODO *)
63
+
in
64
+
List.fold_left f 0 t
65
+
66
(** Modern implementation using semantic tags, Only for 4.08+ *)
67
68
(*
···
100
101
let elt ppf elt =
102
Format.pp_open_stag ppf (Elt elt);
103
+
Format.pp_print_as ppf (compute_length_inline elt) "";
104
Format.pp_close_stag ppf ()
105
106
let ignore ppf txt =
···
161
162
let elt ppf (elt : Inline.t) =
163
Format.fprintf ppf "@{<tag:%s>%t@}" (Marshal.to_string elt []) (fun fmt ->
164
+
Format.pp_print_as fmt (compute_length_inline elt) "")
165
166
let ignore ppf txt = Format.fprintf ppf "@{<ignore-tag>%t@}" txt
167
end
+4
-3
src/document/comment.ml
+4
-3
src/document/comment.ml
···
14
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
*)
16
17
open Types
18
module Comment = Odoc_model.Comment
19
open Odoc_model.Names
···
67
| `TAbsolutePath -> "/"
68
| `TCurrentPackage -> "//"
69
in
70
-
tag ^ String.concat "/" cs
71
72
let rec render_unresolved : Reference.t -> string =
73
let open Reference in
···
412
match Comment.synopsis docs with Some p -> [ paragraph p ] | None -> []
413
414
let standalone docs =
415
-
Utils.flatmap ~f:item_element
416
@@ List.map (fun x -> x.Odoc_model.Location_.value) docs
417
418
let to_ir (docs : Comment.elements) =
419
-
Utils.flatmap ~f:block_element
420
@@ List.map (fun x -> x.Odoc_model.Location_.value) docs
421
422
let has_doc docs = docs <> []
···
14
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
*)
16
17
+
open Odoc_utils
18
open Types
19
module Comment = Odoc_model.Comment
20
open Odoc_model.Names
···
68
| `TAbsolutePath -> "/"
69
| `TCurrentPackage -> "//"
70
in
71
+
tag ^ String.concat ~sep:"/" cs
72
73
let rec render_unresolved : Reference.t -> string =
74
let open Reference in
···
413
match Comment.synopsis docs with Some p -> [ paragraph p ] | None -> []
414
415
let standalone docs =
416
+
List.concat_map item_element
417
@@ List.map (fun x -> x.Odoc_model.Location_.value) docs
418
419
let to_ir (docs : Comment.elements) =
420
+
List.concat_map block_element
421
@@ List.map (fun x -> x.Odoc_model.Location_.value) docs
422
423
let has_doc docs = docs <> []
+16
-11
src/document/doctree.ml
+16
-11
src/document/doctree.ml
···
1
open Types
2
3
module Take = struct
···
97
val compute : Page.t -> Subpage.t list
98
end = struct
99
let rec walk_documentedsrc (l : DocumentedSrc.t) =
100
-
Utils.flatmap l ~f:(function
101
-
| DocumentedSrc.Code _ -> []
102
-
| Documented _ -> []
103
-
| Nested { code; _ } -> walk_documentedsrc code
104
-
| Subpage p -> [ p ]
105
-
| Alternative (Expansion r) -> walk_documentedsrc r.expansion)
106
107
let rec walk_items (l : Item.t list) =
108
-
Utils.flatmap l ~f:(function
109
-
| Item.Text _ -> []
110
-
| Heading _ -> []
111
-
| Declaration { content; _ } -> walk_documentedsrc content
112
-
| Include i -> walk_items i.content.content)
113
114
let compute (p : Page.t) = walk_items (p.preamble @ p.items)
115
end
···
1
+
open Odoc_utils
2
open Types
3
4
module Take = struct
···
98
val compute : Page.t -> Subpage.t list
99
end = struct
100
let rec walk_documentedsrc (l : DocumentedSrc.t) =
101
+
List.concat_map
102
+
(function
103
+
| DocumentedSrc.Code _ -> []
104
+
| Documented _ -> []
105
+
| Nested { code; _ } -> walk_documentedsrc code
106
+
| Subpage p -> [ p ]
107
+
| Alternative (Expansion r) -> walk_documentedsrc r.expansion)
108
+
l
109
110
let rec walk_items (l : Item.t list) =
111
+
List.concat_map
112
+
(function
113
+
| Item.Text _ -> []
114
+
| Heading _ -> []
115
+
| Declaration { content; _ } -> walk_documentedsrc content
116
+
| Include i -> walk_items i.content.content)
117
+
l
118
119
let compute (p : Page.t) = walk_items (p.preamble @ p.items)
120
end
+23
-21
src/document/generator.ml
+23
-21
src/document/generator.ml
···
14
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
*)
16
17
open Odoc_model.Names
18
module Location = Odoc_model.Location_
19
module Paths = Odoc_model.Paths
···
76
rest is inserted into [items]. *)
77
let prepare_preamble comment items =
78
let preamble, first_comment =
79
-
Utils.split_at
80
~f:(function
81
| { Odoc_model.Location_.value = `Heading _; _ } -> true | _ -> false)
82
comment
···
213
let in_bound x = min (max x 0) (String.length src) in
214
let a = in_bound a and b = in_bound b in
215
let a, b = (min a b, max a b) in
216
-
String.sub src a (b - a)
217
in
218
let plain_code = function
219
| "" -> []
···
358
| Open -> O.txt "[> " ++ elements ++ O.txt " ]"
359
| Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]"
360
| Closed lst ->
361
-
let constrs = String.concat " " lst in
362
O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]"))
363
364
and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) =
···
461
format_type_path ~delim:`brackets args
462
(Link.from_path (path :> Paths.Path.t))
463
| Poly (polyvars, t) ->
464
-
O.txt ("'" ^ String.concat " '" polyvars ^ ". ") ++ type_expr t
465
| Package pkg ->
466
enclose ~l:"(" ~r:")"
467
(O.keyword "module" ++ O.txt " "
···
747
| Closed [] ->
748
(O.documentedSrc (O.txt "[< "), O.documentedSrc (O.txt " ]"))
749
| Closed lst ->
750
-
let constrs = String.concat " " lst in
751
( O.documentedSrc (O.txt "[< "),
752
O.documentedSrc (O.txt (" " ^ constrs ^ " ]")) )
753
in
···
773
| Some Odoc_model.Lang.TypeDecl.Neg -> "-" :: desc
774
in
775
let final = if injectivity then "!" :: var_desc else var_desc in
776
-
String.concat "" final
777
in
778
O.txt
779
(match params with
780
| [] -> ""
781
| [ x ] -> format_param x |> Syntax.Type.handle_format_params
782
| lst -> (
783
-
let params = String.concat ", " (List.map format_param lst) in
784
(match delim with `parens -> "(" | `brackets -> "[")
785
^ params
786
^ match delim with `parens -> ")" | `brackets -> "]"))
···
1077
| Constraint cst -> continue @@ constraint_ cst
1078
| Comment `Stop ->
1079
let rest =
1080
-
Utils.skip_until rest ~p:(function
1081
| Lang.ClassSignature.Comment `Stop -> true
1082
| _ -> false)
1083
in
···
1268
loop rest (List.rev_append items acc_items)
1269
| Comment `Stop ->
1270
let rest =
1271
-
Utils.skip_until rest ~p:(function
1272
| Lang.Signature.Comment `Stop -> true
1273
| _ -> false)
1274
in
···
1376
| Some params, sg ->
1377
let sg_doc, content = signature sg in
1378
let params =
1379
-
Utils.flatmap params ~f:(fun arg ->
1380
-
let content = functor_parameter arg in
1381
-
let attr = [ "parameter" ] in
1382
-
let anchor =
1383
-
Some
1384
-
(Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t))
1385
-
in
1386
-
let doc = [] in
1387
-
[
1388
-
Item.Declaration
1389
-
{ content; anchor; attr; doc; source_anchor = None };
1390
-
])
1391
in
1392
let prelude = mk_heading ~label:"parameters" "Parameters" :: params
1393
and content = mk_heading ~label:"signature" "Signature" :: content in
···
14
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
*)
16
17
+
open Odoc_utils
18
open Odoc_model.Names
19
module Location = Odoc_model.Location_
20
module Paths = Odoc_model.Paths
···
77
rest is inserted into [items]. *)
78
let prepare_preamble comment items =
79
let preamble, first_comment =
80
+
List.split_at
81
~f:(function
82
| { Odoc_model.Location_.value = `Heading _; _ } -> true | _ -> false)
83
comment
···
214
let in_bound x = min (max x 0) (String.length src) in
215
let a = in_bound a and b = in_bound b in
216
let a, b = (min a b, max a b) in
217
+
String.with_range src ~first:a ~len:(b - a)
218
in
219
let plain_code = function
220
| "" -> []
···
359
| Open -> O.txt "[> " ++ elements ++ O.txt " ]"
360
| Closed [] -> O.txt "[< " ++ elements ++ O.txt " ]"
361
| Closed lst ->
362
+
let constrs = String.concat ~sep:" " lst in
363
O.txt "[< " ++ elements ++ O.txt (" " ^ constrs ^ " ]"))
364
365
and te_object (t : Odoc_model.Lang.TypeExpr.Object.t) =
···
462
format_type_path ~delim:`brackets args
463
(Link.from_path (path :> Paths.Path.t))
464
| Poly (polyvars, t) ->
465
+
O.txt ("'" ^ String.concat ~sep:" '" polyvars ^ ". ") ++ type_expr t
466
| Package pkg ->
467
enclose ~l:"(" ~r:")"
468
(O.keyword "module" ++ O.txt " "
···
748
| Closed [] ->
749
(O.documentedSrc (O.txt "[< "), O.documentedSrc (O.txt " ]"))
750
| Closed lst ->
751
+
let constrs = String.concat ~sep:" " lst in
752
( O.documentedSrc (O.txt "[< "),
753
O.documentedSrc (O.txt (" " ^ constrs ^ " ]")) )
754
in
···
774
| Some Odoc_model.Lang.TypeDecl.Neg -> "-" :: desc
775
in
776
let final = if injectivity then "!" :: var_desc else var_desc in
777
+
String.concat ~sep:"" final
778
in
779
O.txt
780
(match params with
781
| [] -> ""
782
| [ x ] -> format_param x |> Syntax.Type.handle_format_params
783
| lst -> (
784
+
let params = String.concat ~sep:", " (List.map format_param lst) in
785
(match delim with `parens -> "(" | `brackets -> "[")
786
^ params
787
^ match delim with `parens -> ")" | `brackets -> "]"))
···
1078
| Constraint cst -> continue @@ constraint_ cst
1079
| Comment `Stop ->
1080
let rest =
1081
+
List.skip_until rest ~p:(function
1082
| Lang.ClassSignature.Comment `Stop -> true
1083
| _ -> false)
1084
in
···
1269
loop rest (List.rev_append items acc_items)
1270
| Comment `Stop ->
1271
let rest =
1272
+
List.skip_until rest ~p:(function
1273
| Lang.Signature.Comment `Stop -> true
1274
| _ -> false)
1275
in
···
1377
| Some params, sg ->
1378
let sg_doc, content = signature sg in
1379
let params =
1380
+
let decl_of_arg arg =
1381
+
let content = functor_parameter arg in
1382
+
let attr = [ "parameter" ] in
1383
+
let anchor =
1384
+
Some (Url.Anchor.from_identifier (arg.id :> Paths.Identifier.t))
1385
+
in
1386
+
let doc = [] in
1387
+
[
1388
+
Item.Declaration
1389
+
{ content; anchor; attr; doc; source_anchor = None };
1390
+
]
1391
+
in
1392
+
List.concat_map decl_of_arg params
1393
in
1394
let prelude = mk_heading ~label:"parameters" "Parameters" :: params
1395
and content = mk_heading ~label:"signature" "Signature" :: content in
-42
src/document/utils.ml
-42
src/document/utils.ml
···
1
-
let option_of_result = function Ok x -> Some x | Error _ -> None
2
-
3
-
let rec flatmap ?sep ~f = function
4
-
| [] -> []
5
-
| [ x ] -> f x
6
-
| x :: xs -> (
7
-
let hd = f x in
8
-
let tl = flatmap ?sep ~f xs in
9
-
match sep with None -> hd @ tl | Some sep -> hd @ sep @ tl)
10
-
11
-
let rec skip_until ~p = function
12
-
| [] -> []
13
-
| h :: t -> if p h then t else skip_until ~p t
14
-
15
-
let split_at ~f lst =
16
-
let rec loop acc = function
17
-
| hd :: _ as rest when f hd -> (List.rev acc, rest)
18
-
| [] -> (List.rev acc, [])
19
-
| hd :: tl -> loop (hd :: acc) tl
20
-
in
21
-
loop [] lst
22
-
23
-
let rec compute_length_source (t : Types.Source.t) : int =
24
-
let f (acc : int) = function
25
-
| Types.Source.Elt t -> acc + compute_length_inline t
26
-
| Types.Source.Tag (_, t) -> acc + compute_length_source t
27
-
in
28
-
List.fold_left f 0 t
29
-
30
-
and compute_length_inline (t : Types.Inline.t) : int =
31
-
let f (acc : int) { Types.Inline.desc; _ } =
32
-
match desc with
33
-
| Text s -> acc + String.length s
34
-
| Entity _e -> acc + 1
35
-
| Linebreak -> 0 (* TODO *)
36
-
| Styled (_, t) | Link { content = t; _ } -> acc + compute_length_inline t
37
-
| Source s -> acc + compute_length_source s
38
-
| Math _ -> assert false
39
-
| Raw_markup _ -> assert false
40
-
(* TODO *)
41
-
in
42
-
List.fold_left f 0 t
···
-6
src/document/utils.mli
-6
src/document/utils.mli
···
1
-
val option_of_result : ('a, 'b) result -> 'a option
2
-
val flatmap : ?sep:'a list -> f:('b -> 'a list) -> 'b list -> 'a list
3
-
val skip_until : p:('a -> bool) -> 'a list -> 'a list
4
-
val split_at : f:('a -> bool) -> 'a list -> 'a list * 'a list
5
-
val compute_length_source : Types.Source.t -> int
6
-
val compute_length_inline : Types.Inline.t -> int
···
+6
-5
src/manpage/generator.ml
+6
-5
src/manpage/generator.ml
···
1
module ManLink = Link
2
open Odoc_document
3
open Types
···
299
| { Inline.desc = Text s; _ } -> Accum [ s ]
300
| _ -> Stop_and_keep)
301
in
302
-
str {|%s|} (String.concat "" l) ++ inline rest
303
| Entity e ->
304
let x = entity e in
305
x ++ inline rest
···
343
| Default -> "l")
344
align
345
in
346
-
Align_line (String.concat "" alignment)
347
in
348
env "TS" "TE" ""
349
(str "allbox;" ++ alignment
···
408
| 1, n :: _ -> [ n + 1 ]
409
| i, n :: t -> n :: succ_heading (i - 1) t
410
in
411
-
let print_heading l = String.concat "." @@ List.map string_of_int l in
412
let next level =
413
let new_heading = succ_heading level !heading_stack in
414
heading_stack := new_heading;
···
547
let i = Shift.compute ~on_sub p.items in
548
macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.url.name
549
++ macro "SH" "Name"
550
-
++ str "%s" (String.concat "." @@ Link.for_printing p.url)
551
++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header
552
++ macro "SH" "Documentation" ++ vspace ++ macro "nf" ""
553
++ item ~nested:false i
···
558
559
and render_page (p : Page.t) =
560
let p = Doctree.Labels.disambiguate_page ~enter_subpages:true p
561
-
and children = Utils.flatmap ~f:subpage @@ Subpages.compute p in
562
let content ppf = Format.fprintf ppf "%a@." Roff.pp (page p) in
563
let filename = Link.as_filename p.url in
564
{ Renderer.filename; content; children; path = p.url }
···
1
+
open Odoc_utils
2
module ManLink = Link
3
open Odoc_document
4
open Types
···
300
| { Inline.desc = Text s; _ } -> Accum [ s ]
301
| _ -> Stop_and_keep)
302
in
303
+
str {|%s|} (String.concat ~sep:"" l) ++ inline rest
304
| Entity e ->
305
let x = entity e in
306
x ++ inline rest
···
344
| Default -> "l")
345
align
346
in
347
+
Align_line (String.concat ~sep:"" alignment)
348
in
349
env "TS" "TE" ""
350
(str "allbox;" ++ alignment
···
409
| 1, n :: _ -> [ n + 1 ]
410
| i, n :: t -> n :: succ_heading (i - 1) t
411
in
412
+
let print_heading l = String.concat ~sep:"." @@ List.map string_of_int l in
413
let next level =
414
let new_heading = succ_heading level !heading_stack in
415
heading_stack := new_heading;
···
548
let i = Shift.compute ~on_sub p.items in
549
macro "TH" {|%s 3 "" "Odoc" "OCaml Library"|} p.url.name
550
++ macro "SH" "Name"
551
+
++ str "%s" (String.concat ~sep:"." @@ Link.for_printing p.url)
552
++ macro "SH" "Synopsis" ++ vspace ++ item ~nested:false header
553
++ macro "SH" "Documentation" ++ vspace ++ macro "nf" ""
554
++ item ~nested:false i
···
559
560
and render_page (p : Page.t) =
561
let p = Doctree.Labels.disambiguate_page ~enter_subpages:true p
562
+
and children = List.concat_map subpage (Subpages.compute p) in
563
let content ppf = Format.fprintf ppf "%a@." Roff.pp (page p) in
564
let filename = Link.as_filename p.url in
565
{ Renderer.filename; content; children; path = p.url }
+12
src/utils/odoc_list.ml
+12
src/utils/odoc_list.ml
···
32
33
(* Since 5.1 *)
34
let is_empty = function [] -> true | _ :: _ -> false
35
+
36
+
let rec skip_until ~p = function
37
+
| [] -> []
38
+
| h :: t -> if p h then t else skip_until ~p t
39
+
40
+
let split_at ~f lst =
41
+
let rec loop acc = function
42
+
| hd :: _ as rest when f hd -> (List.rev acc, rest)
43
+
| [] -> (List.rev acc, [])
44
+
| hd :: tl -> loop (hd :: acc) tl
45
+
in
46
+
loop [] lst