Source file indexing.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
open Odoc_utils
open Astring
open Odoc_json_index
open Or_error
open Odoc_model

module H = Odoc_model.Paths.Identifier.Hashtbl.Any
module Id = Odoc_model.Paths.Identifier

let parse_input_file input =
  let is_sep = function '\n' | '\r' -> true | _ -> false in
  Fs.File.read input >>= fun content ->
  let files =
    String.fields ~empty:false ~is_sep content |> List.rev_map Fs.File.of_string
  in
  Ok files

let parse_input_files input =
  List.fold_left
    (fun acc file ->
      acc >>= fun acc ->
      parse_input_file file >>= fun files -> Ok (files :: acc))
    (Ok []) input
  >>= fun files -> Ok (List.concat files)

let compile_to_json ~output ~occurrences ~wrap ~simplified hierarchies =
  let output_channel =
    Fs.Directory.mkdir_p (Fs.File.dirname output);
    open_out_bin (Fs.File.to_string output)
  in
  let output = Format.formatter_of_out_channel output_channel in
  if wrap then Format.fprintf output "let documents = ";
  let all =
    List.fold_left
      (fun acc hierarchy ->
        Tree.fold_left
          ~f:(fun acc entry ->
            Json_search.of_entry ~simplified ?occurrences entry :: acc)
          acc hierarchy)
      [] hierarchies
  in
  Format.fprintf output "%s" (Odoc_utils.Json.to_string (`Array (List.rev all)));
  if wrap then
    Format.fprintf output
      ";\n\
       const options = { keys: ['name', 'comment'] };\n\
       var idx_fuse = new Fuse(documents, options);\n";
  Ok ()

let read_occurrences file =
  let ic = open_in_bin file in
  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
  htbl

let absolute_normalization p =
  let p =
    if Fpath.is_rel p then Fpath.( // ) (Fpath.v (Sys.getcwd ())) p else p
  in
  Fpath.normalize p

let compile out_format ~output ~warnings_options ~occurrences ~roots
    ~inputs_in_file ~simplified_json ~wrap_json ~odocls =
  let handle_warnings f =
    let res = Error.catch_warnings f in
    Error.handle_warnings ~warnings_options res |> Result.join
  in
  handle_warnings @@ fun () ->
  parse_input_files inputs_in_file >>= fun files ->
  let files = List.rev_append odocls files in
  let occurrences =
    match occurrences with
    | None -> None
    | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
  in
  let all_files =
    roots
    |> List.fold_left
         (fun set include_rec ->
           Fs.Directory.fold_files_rec ~ext:"odocl"
             (fun files file ->
               Fpath.Set.add (absolute_normalization file) files)
             set include_rec)
         Fpath.Set.empty
    |> fun set -> Fpath.Set.fold (fun a l -> a :: l) set []
  in
  (* let () = List.iter (Format.printf "%a\n" Fpath.pp) all_files in *)
  let root_groups =
    (* We group the files we have found by root.

       Some files may belong to multiple roots. In this case, we associate the
       file to the root that is the deepest in the hierarchy.
    *)
    let roots = List.map Fs.Directory.to_fpath roots in
    let roots = List.map absolute_normalization roots in
    (* Add an index to keep the original order *)
    let roots = List.mapi (fun i c -> (i, c)) roots in
    let roots =
      (* Make sure that we treat first the "deepest" one *)
      List.sort
        (fun (_, p1) (_, p2) -> if Fpath.is_prefix p1 p2 then 1 else -1)
        roots
    in
    let groups, _ =
      List.fold_left
        (fun (acc, remaining_files) (i, root) ->
          let root_files, remaining_files =
            List.partition (Fpath.is_prefix root) remaining_files
          in
          ((i, root_files) :: acc, remaining_files))
        ([], all_files) roots
    in
    let root_groups =
      List.sort (fun (i, _) (j, _) -> compare i j) groups |> List.map snd
    in
    (* Files given without [--root] are grouped together *)
    match files with _ :: _ -> files :: root_groups | [] -> root_groups
  in
  let hierarchies =
    (* For each group, we create a hierarchy. *)
    let hierarchy_of_group g =
      let pages, modules, implementations =
        let read (pages, modules, impls) f =
          match Odoc_file.load f with
          | Ok { content = Page_content p; _ } -> (p :: pages, modules, impls)
          | Ok { content = Unit_content m; _ } -> (pages, m :: modules, impls)
          | Ok { content = Impl_content i; _ } -> (pages, modules, i :: impls)
          | _ -> (pages, modules, impls)
        in
        List.fold_left read ([], [], []) g
      in
      Odoc_index.Skeleton_of.lang ~pages ~modules ~implementations
    in
    List.map hierarchy_of_group root_groups
  in
  match out_format with
  | `JSON ->
      compile_to_json ~output ~occurrences ~simplified:simplified_json
        ~wrap:wrap_json hierarchies
  | `Marshall -> Ok (Odoc_file.save_index output hierarchies)