Source

spotinstall / spotinstall.ml

Full commit
open Spotlib.Spot
open Unix
open Printf

module C = Unix.Command

type dest = 
  | Package of string
  | Path of string

let show_dest = function
  | Package s -> sprintf "package %s" s
  | Path s -> s

let dests, verbose, meth = 
  let dests = ref [] in
  let verbose = ref false in
  let meth = Once.create () in
    
  Arg.parse 
      [ "-v", Arg.Set verbose, "verbose"
      ; "-c", Arg.Unit (fun () -> Once.set meth `Copy), "use cp"
      ; "-l", Arg.Unit (fun () -> Once.set meth `Link), "use ln  (default)"
      ; "-s", Arg.Unit (fun () -> Once.set meth `Sym),  "use ln -s"
      ] 
      (fun x -> 
        let d = if Filename.is_relative x then Package x else Path x in
        dests := d :: !dests)
          "spotinstall <packages-or-abs-paths>\n  \
           Check the files installed as ocamlfind package <package>, or files in directory <abs-path> and if there are corresponding .cmt/.cmti/.spot/.spit files in the current and sub directories, copy them to the installation directory.";
    
  let dests = match !dests with
    | [] -> `All
    | dests -> `Some dests
  in
  let verbose = !verbose in
  let meth = match Once.get meth with
      | Some v -> v
      | None -> `Link
  in
  dests, verbose, meth

module OCamlFind = struct

  let path = 
    match 
      imp_ None & fun ocamlfind_path ->
        C.shell "ocamlfind printconf destdir" 
        |> C.iter ~f: (function
            | (`Out, `Read line) ->
                begin match !ocamlfind_path with
                | Some _ -> failwith "ocamlfind printconf destdir prints more than one line"
                | None -> ocamlfind_path := Some (String.chop_eols line)
                end
            | _ -> ())
        |> C.must_exit_with 0
    with
    | None -> failwith "No ocamlfind installtion path found. Check your ocamlfind."
    | Some p -> p

  let dest_dir package = 
    match 
      imp_ None & fun result ->
        C.shell (sprintf "ocamlfind query %s" package) 
        |> C.iter ~f:(function
            | (`Out, `Read line) ->
                begin match !result with
                | Some _ -> failwith "ocamlfind query package prints more than one line"
                | None -> result := Some (String.chop_eols line)
                end
            | _ -> ())
        |> C.must_exit_with 0
    with
    | None -> failwithf "No ocamlfind installtion path for package \"%s\" found. Check your ocamlfind." package
    | Some p -> p

  let packages =
    StringSet.to_list
    & imp_ StringSet.empty 
    & fun packs ->
        C.shell "ocamlfind list" 
        |> C.iter ~f:(function
            | (`Err, `Read s) -> prerr_endline s
            | (`Out, `Read s) ->
                begin 
                  s |> <:m<\[(distributed with Ocaml|internal)\]>> -> () (* exclude bases *)
                    | <:m<(^[^. ]+)>> as x -> packs := StringSet.add x#_1 !packs
                    | _ -> ()
                end
            | _ -> ())
        |> C.must_exit_with 0
end

module OCaml = struct

  let where = 
    match 
      imp_ None & fun ocaml_where ->
        C.shell "ocamlc -where" 
        |> C.iter ~f:(function
            | (`Out, `Read line) ->
                begin match !ocaml_where with
                | Some _ -> failwith "ocamlc -where prints more than one line"
                | None -> ocaml_where := Some (String.chop_eols line)
                end
            | _ -> ())
        |> C.must_exit_with 0
    with
    | None -> failwith "ocamlc -where failed."
    | Some p -> p

end

let exts_of_sp = function
  | ".cmx" | ".cmo" -> [ ".spot"; ".cmt" ]
  | ".cmi" -> [ ".spit"; ".cmti"; ".cmt" ] (* Packed .cmi has no .spit but .spot *)
  | ".ml" | ".mly" | ".mll" -> [ ".annot"; ".cmt" ]
  | ".mli" -> [ ".cmti" ]
  | _ -> assert false

let find_installed tbl package =
  eprintf "Finding cms of %s...\n%!" (show_dest package);
  let dest_dir = match package with 
    | Package "ocaml" -> OCaml.where 
    | Package package -> OCamlFind.dest_dir package 
    | Path p -> p
  in
  Find.find [dest_dir] &~ (fun path -> 
    if path#base = "site-lib" && package = Package "ocaml" then 
      Find.prune ()
    else match Filename.split_extension path#base with
    | body, (".cmx" | ".cmo" | ".cmi" | ".ml" | ".mli" | ".mly" | ".mll" as ext) -> 
        if verbose then Printf.eprintf "found %s\n" path#path;
        Hashtbl.add tbl (body, ext) (package, path#path)
    | _ -> ());
  !!% "Found %d entries@." & Hashtbl.length tbl

let dests = 
  match dests with
  | `Some dests -> dests
  | `All -> List.map (fun x -> Package x) OCamlFind.packages

let installed_files = 
  let tbl = Hashtbl.create 107 in
  List.iter (fun package -> find_installed tbl package) dests;
  tbl

(* For each installed *.cm* file, we try to find the same file in the current directory,
   then copy the accompanied .spot/.spit *)

let () =
  let copied = Hashset.create 107 in

  eprintf "Traversing the current directory to find compiled files...\n%!";

  Unix.Find.find ["."] ~f:(fun path ->
    match Filename.split_extension path#base with
    | body, (".cmx" | ".cmo" | ".cmi" | ".ml" | ".mly" | ".mll" | ".mli" as ext) -> 
        List.map (fun ext -> path#dir ^/ body ^ ext) (exts_of_sp ext)
        |> List.find_all Sys.file_exists 
        |> List.iter (fun spotspit ->
          Hashtbl.find_all installed_files (body, ext) 
          |> List.iter (fun (_package, p) -> 
            match Shell.cmp p path#path with
            | `Different | `Error -> ()
            | `Same ->
                (* The file is installed! If there is .spot/.spit, copy it! *)
                let dirname = Filename.dirname p in
                let destfile = dirname ^/ Filename.basename spotspit in 
                let need_to_copy = 
                  not (Sys.file_exists destfile && Shell.cmp spotspit destfile = `Same)
                in
                if not need_to_copy then
                  Hashset.add copied p                
                else begin
                  if Sys.file_exists destfile then unlink destfile;
                  let comm = match meth with
                    | `Copy -> ["/bin/cp"]
                    | `Link -> ["/bin/ln"]
                    | `Sym  -> ["/bin/ln"; "-s"]
                  in
                  match 
                    C.execvp (comm @ [spotspit; dirname])
                    |> C.iter ~f:(function
                        | (`Err, `Read mes) -> eprintf "Failed to install %s to %s: %s\n%!" spotspit dirname mes
                        | _ -> ())
                    |> fst
                  with
                  | Unix.WEXITED 0 -> 
                      Hashset.add copied p;
                      eprintf "Installed %s to %s\n%!" spotspit dirname
                  | WEXITED n -> 
                      eprintf "%s returned with a strange status %d\n%!" 
                        (String.concat " " comm)
                        n
                  | _ -> 
                      eprintf "Failed to %s %s to %s: SOME STRANGE REASON\n%!" 
                        (String.concat " " comm)
                        spotspit dirname
                end 
          ))
    | _ -> ());

  (* check not found *)
  Hashtbl.iter (fun _ (package, path) -> 
    if not (Hashset.mem copied path) then
      Printf.eprintf "No binannot file found %s (%s)\n" path (show_dest package))
    installed_files