Source file unic_resolve.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
module Set = Set.Make (Modname)

let ( let* ) = Result.bind
let error_msgf fmt = Fmt.kstr (fun msg -> Error (`Msg msg)) fmt

module Elt = struct
  type t =
    | Resolved of Modname.t * Uniq_meta.Path.t
    | Ambiguous of Modname.t * Uniq_meta.Path.t list
    | Not_found of Modname.t

  let pp ppf = function
    | Resolved (modname, pkg) ->
        Fmt.pf ppf "%a => %a"
          Fmt.(styled (`Fg `Green) Modname.pp)
          modname Uniq_meta.Path.pp pkg
    | Not_found modname ->
        Fmt.pf ppf "%a" Fmt.(styled (`Fg `Red) Modname.pp) modname
    | Ambiguous (modname, pkgs) ->
        Fmt.pf ppf "%a => @[<hov>%a@]"
          Fmt.(styled (`Fg `Yellow) Modname.pp)
          modname
          Fmt.(Dump.list Uniq_meta.Path.pp)
          pkgs
end

let run _quiet cfg recurse root without_stdlib ocamlfind_roots =
  let sources = Uniq_resolve.Src.sources ~recurse root in
  let srcs =
    match cfg with
    | None -> [ sources ]
    | Some cfg ->
        begin if without_stdlib then [ sources ]
        else
          match Uniq_cfg.(get cfg ~key:"standard_library" Value.path) with
          | Some stdlib -> [ sources; Uniq_resolve.Src.objects stdlib ]
          | None -> [ sources ]
        end
  in
  let* ts = Uniq_resolve.qualify ~stdlib:(not without_stdlib) srcs in
  let intfs, impls =
    let fn (intfs, impls) t =
      let intfs', impls' = Uniq_info.missing t in
      let intfs' = List.map fst intfs' in
      let impls' = List.map fst impls' in
      let intfs = Set.add_seq (List.to_seq intfs') intfs in
      let impls = Set.add_seq (List.to_seq impls') impls in
      (intfs, impls)
    in
    List.fold_left fn Set.(empty, empty) ts
  in
  let results =
    let missing = Set.union intfs impls in
    if Set.is_empty missing then []
    else
      let missing = Set.to_list missing in
      let providers = Uniq_meta.find_providers ~roots:ocamlfind_roots missing in
      let not_found =
        let fn s (m, _) = Set.add m s in
        let provided = List.fold_left fn Set.empty providers in
        let fn m = not (Set.mem m provided) in
        List.filter fn missing
      in
      let not_found = List.rev_map (fun m -> (m, [])) not_found in
      let elements = List.rev_append providers not_found in
      let fn (modname, pkgs) =
        match pkgs with
        | [ pkg ] -> Elt.Resolved (modname, pkg)
        | [] -> Elt.Not_found modname
        | pkgs -> Elt.Ambiguous (modname, pkgs)
      in
      List.map fn elements
  in
  List.iter (fun elt -> Fmt.pr "%a\n%!" Elt.pp elt) results;
  Ok 0

open Cmdliner
open Unic_cli

let path =
  let doc = "The OCaml project directory." in
  let parser str =
    match Fpath.of_string str with
    | Ok v when Sys.file_exists str ->
        if Sys.is_directory str then Ok (Fpath.to_dir_path v) else Ok v
    | Ok v -> error_msgf "%a does not exist" Fpath.pp v
    | Error _ as err -> err
  in
  let existing_context = Arg.conv (parser, Fpath.pp) in
  let open Arg in
  required
  & pos ~rev:true 0 (some existing_context) None
  & info [] ~doc ~docv:"DIRECTORY"

let recurse =
  let doc = "Include sub-directories." in
  Arg.(value & flag & info [ "r"; "recurse" ] ~doc)

let without_stdlib =
  let doc = "Do not add the standard library to the list of include sources." in
  Arg.(value & flag & info [ "without-stdlib" ] ~doc)

let term =
  let open Term in
  const run
  $ setup_logs
  $ setup_ocaml
  $ recurse
  $ path
  $ without_stdlib
  $ setup_ocamlfind
  |> term_result

let cmd =
  let doc = "Resolve the missing modules of an OCaml project." in
  let man =
    [
      `S Manpage.s_description
    ; `P
        "$(tname) qualifies the given OCaml project (as $(b,unic qualify) \
         does) and collects the modules required by the project but not \
         provided by it. Then, for each missing module, $(tname) searches an \
         $(b,ocamlfind) package which provides it."
    ; `P
        "For each missing module, three results are possible: the module is \
         resolved (only one package provides it), the module is ambiguous \
         (several packages provide it) or the module is not found (no package \
         provides it)."
    ]
  in
  Cmd.v (Cmd.info "resolve" ~doc ~man) term