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

(* Suggestions *)
open Mo_def
open Mo_types
open Mo_config
open Type

let oneof sep lastsep ss =
  let rest, last = Lib.List.split_last ss in
  ((if rest <> [] then (String.concat sep rest) ^ lastsep else "") ^ last)

let suggest_id desc id ids =
  let ids =
      List.filter (fun id ->
        not (Syntax.is_privileged id))
      ids
  in
  if !Flags.ai_errors then
    Printf.sprintf
      "\nThe %s %s is not available. Try something else?"
      desc
      id
  else
  let suggestions =
    let limit = Lib.Int.log2 (String.length id) in
    let distance = Lib.String.levenshtein_distance id in
    let weighted_ids = List.filter_map (fun id0 ->
      let d = distance id0 in
      if String.starts_with ~prefix:id id0 || d <= limit then
        Some (d, id0)
      else None) ids in
    List.sort compare weighted_ids |> List.map snd
  in
  if suggestions = [] then ""
  else
  Printf.sprintf "\nDid you mean %s %s?" desc (oneof ", " " or " suggestions)

let search_obj desc path ty ty1 ty2 =
  let suggestions = ref [] in
  let seen = ref S.empty in
  let rec go path ty =
  if S.mem ty !seen then ()
  else begin
    seen := S.add ty (!seen);
    match promote ty with
    | Obj(_, tfs) ->
      tfs |>
      List.iter (fun {lab;typ;_} ->
        match normalize typ with
        | Func _ when
          (String.starts_with ~prefix:"to" lab ||
           String.starts_with ~prefix:"from" lab) &&
           sub typ (Func(Local, Returns,  [], [ty1], [ty2])) ->
          suggestions := Printf.sprintf "`%s.%s(_)`%s" path lab desc :: !suggestions
        | Obj(_, tfs) as ty1  ->
          go (path^"."^lab) ty1
        | _ -> ())
    | _ -> ()
    end
  in
  go path ty;
  !suggestions

let suggest_conversion libs vals ty1 ty2 =
  match promote ty1, promote ty2 with
  | Prim p1, Prim p2 ->
    let suggestions = ref [] in
    Env.iter (fun filename ty ->
      if String.starts_with ~prefix:"@" filename
      then () (* skip prim etc *)
      else
      let imported_name =
        (* try to determine imported name, if any *)
        Env.fold (fun id (ty1, _, _, _) acc ->
            if ty == ty1 (*HACK*)
            then Some id
            else acc)
          vals None
      in
      let lib_opt = match imported_name with
        | Some id -> Some (id, "")
        | None ->
          (* search libs for suggested import *)
          Flags.M.fold (fun package path acc  ->
              let base = Lib.FilePath.normalise path in
              match Lib.FilePath.relative_to base filename with
              | None -> acc
              | Some rel_path ->
                let rel_name = Filename.chop_extension rel_path in
                let id = Filename.basename rel_name in
                Some (
                  id,
                  Printf.sprintf  " after adding `import %s = \"mo:%s/%s\"`" id package rel_name))
             !Flags.package_urls None
      in
      match lib_opt with
      | None -> ()
      | Some (id, desc) ->
        suggestions := (search_obj desc id ty ty1 ty2) @ !suggestions)
      libs;
    if !suggestions = []
    then ""
    else
      Printf.sprintf "\nMaybe try conversion:\n  %s?"
      (oneof ",\n  " " or\n  " !suggestions)
  (* not primitive types, make no suggestion *)
  | _, _ -> ""

(** Convert a filesystem path to a mo:<package>/<module> URL if it lies under any configured package path. *)
let mo_url_of_path path =
  let seq = Flags.M.to_seq !Flags.package_urls in
  Seq.fold_left (fun acc (package, base) ->
    match acc with
    | Some _ -> acc
    | None ->
      let base_norm = Lib.FilePath.normalise base in
      let path_norm = Lib.FilePath.normalise path in
      match Lib.FilePath.relative_to base_norm path_norm with
      | None -> None
      | Some rel ->
        if Filename.basename rel = "lib.mo" then
          Some (Printf.sprintf "mo:%s" package)
        else
          Some (Printf.sprintf "mo:%s/%s" package (Filename.chop_extension rel))
  ) None seq

let module_name_as_url module_path =
  match mo_url_of_path module_path with
  | Some url -> url
  | None -> module_path