rescript/analysis/src/process_attributes.ml at de67df7164c2752d51ee250457fcd3de198e62d0 · rescript-lang/rescript · GitHub

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
open Shared_types

(* TODO should I hang on to location? *)
let rec find_doc_attribute attributes =
  match attributes with
  | [] -> None
  | ({Asttypes.txt = "ocaml.doc" | "ocaml.text" | "ns.doc" | "res.doc"}, payload)
    :: rest -> (
    match Ast_payload.semantic_string_of_payload payload with
    | Some doc -> Some doc
    | None -> find_doc_attribute rest)
  | _ :: rest -> find_doc_attribute rest

let rec find_deprecated_attribute attributes =
  let open Parsetree in
  match attributes with
  | [] -> None
  | ({Asttypes.txt = "deprecated"}, PStr [{pstr_desc = Pstr_eval (expr, _)}])
    :: _ -> (
    match Ast_payload.semantic_string_of_expression expr with
    | Some msg -> Some msg
    | None -> (
      match expr.pexp_desc with
      (* deprecated attr with record *)
      | Pexp_record (fields, _) ->
        let reason = ref "" in
        fields
        |> List.iter (fun {lid = {txt}; x} ->
            match txt with
            | Lident "reason" -> (
              match Ast_payload.semantic_string_of_expression x with
              | Some msg -> reason := msg
              | None -> ())
            | _ -> ());
        Some !reason
      | _ -> None))
  | ({Asttypes.txt = "deprecated"}, _) :: _ -> Some ""
  | _ :: rest -> find_deprecated_attribute rest

let new_declared ~item ~extent ~name ~stamp ~module_path is_exported attributes
    =
  {
    Declared.name;
    stamp;
    extent_loc = extent;
    is_exported;
    module_path;
    deprecated = find_deprecated_attribute (List.rev attributes);
    docstring =
      (match find_doc_attribute attributes with
      | None -> []
      | Some d -> [d]);
    item;
  }

let rec find_editor_complete_from_attribute ?(module_paths = []) attributes =
  let open Parsetree in
  match attributes with
  | [] -> module_paths
  | ( {Asttypes.txt = "editor.completeFrom"},
      PStr [{pstr_desc = Pstr_eval (payload_expr, _)}] )
    :: rest ->
    let items =
      match payload_expr with
      | {pexp_desc = Pexp_array items} -> items
      | p -> [p]
    in
    let module_paths_from_array =
      items
      |> List.filter_map (fun item ->
          match item.Parsetree.pexp_desc with
          | Pexp_construct ({txt = path}, None) ->
            Some (Utils.flatten_long_ident path)
          | _ -> None)
    in
    find_editor_complete_from_attribute
      ~module_paths:(module_paths_from_array @ module_paths)
      rest
  | _ :: rest -> find_editor_complete_from_attribute ~module_paths rest