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
(* src/tdoc/tdoc_registry.ml *)
(* In-memory registry for documentation entries *)

open Tdoc_types

let registry : (string, doc_entry) Hashtbl.t = Hashtbl.create 100

let register entry =
  Hashtbl.replace registry entry.name entry

let lookup name =
  Hashtbl.find_opt registry name

let get_all () =
  Hashtbl.fold (fun _ v acc -> v :: acc) registry []

let to_json_file filename =
  let entries = get_all () in
  let json = "{\"docs\": [" ^ (String.concat ", " (List.map doc_entry_to_json entries)) ^ "]}" in
  let chan = open_out filename in
  output_string chan json;
  close_out chan

(* Simple JSON parser (very limited) would go here for loading *)
(* For now, we only implement saving as loading is for the generation phase *)

let normalize_path path =
  if Sys.file_exists path then path
  else
    (* Try to resolve relative to current project if it contains /src/ *)
    let parts = String.split_on_char '/' path in
    let rec find_src = function
      | [] -> None
      | "src" :: rest -> Some (String.concat "/" ("src" :: rest))
      | _ :: rest -> find_src rest
    in
    match find_src parts with
    | Some rel -> if Sys.file_exists rel then rel else path
    | None -> path

let load_from_json filename =
  try
    let ch = open_in filename in
    let content = really_input_string ch (in_channel_length ch) in
    close_in ch;
    
    let json = Tdoc_json.from_string content in
    match json with
    | `Assoc pairs ->
        (match List.assoc_opt "docs" pairs with
        | Some (`List docs) ->
            List.iter (fun doc_json ->
              let entry = Tdoc_types.doc_entry_of_json doc_json in
              let normalized_entry = { entry with source_path = normalize_path entry.source_path } in
              register normalized_entry
            ) docs
        | _ -> Printf.eprintf "Warning: Invalid docs.json format (missing 'docs' array)\n")
    | _ -> Printf.eprintf "Warning: Invalid docs.json format (not an object)\n"
  with
  | Sys_error msg -> Printf.eprintf "Warning: Could not load documentation: %s\n" msg
  | Tdoc_json.Json_error msg -> Printf.eprintf "Warning: Failed to parse documentation: %s\n" msg
  | exn -> Printf.eprintf "Warning: Unknown error loading documentation: %s\n" (Printexc.to_string exn)