Source

spotinstall / spotinstall.ml

Full commit
open Spotlib.Spot
open Unix

type dest = 
  | Package of string
  | Path of string

let dests, verbose = 
  match 
    imp [] & fun dests -> 
      imp_ false & fun verbose -> 
        Arg.parse 
          ["-v", Arg.Set verbose, "verbose"] 
          (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."
  with
  | [], _ -> failwith "You must specify at least one package name or absolute path"
  | dests, v -> dests, v

let ocamlfind_path = 
  match 
    imp_ None & fun ocamlfind_path ->
      ignore & shell_command "ocamlfind printconf destdir" & 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_newline line)
            end
        | _ -> ()
  with
  | None -> failwith "No ocamlfind installtion path found. Check your ocamlfind."
  | Some p -> p

let ocamlfind_dest_dir package = 
  match 
    imp_ None & fun result ->
      ignore & shell_command (Printf.sprintf "ocamlfind query %s" package) & function
        | (`Out, `Read line) ->
            begin match !result with
            | Some _ -> failwith "ocamlfind query package prints more than one line"
            | None -> result := Some (String.chop_newline line)
            end
        | _ -> ()
  with
  | None -> failwith "No ocamlfind installtion path for the package found. Check your ocamlfind."
  | Some p -> p

let ocaml_where = 
  match 
    imp_ None & fun ocaml_where ->
      ignore & shell_command "ocamlc -where" & function
        | (`Out, `Read line) ->
            begin match !ocaml_where with
            | Some _ -> failwith "ocamlc -where prints more than one line"
            | None -> ocaml_where := Some (String.chop_newline line)
            end
        | _ -> ()
  with
  | None -> failwith "ocamlc -where failed."
  | Some p -> p

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

let find_installed_cms tbl package =
  let dest_dir = match package with 
    | Package "ocaml" -> ocaml_where 
    | Package package -> ocamlfind_dest_dir package 
    | Path p -> p
  in
  Unix.find [dest_dir] &~ fun path -> 
    if path.Unix.base = "site-lib" && package = Package "ocaml" then 
      Unix.prune ()
    else match Filename.split_extension path.Unix.base with
    | body, (".cmx" | ".cmo" | ".cmi" as ext) -> 
        if verbose then Printf.eprintf "found %s\n" path.Unix.path;
        Hashtbl.add tbl (body, ext) path.Unix.path
    | _ -> ()

let installed_cms = 
  let tbl = Hashtbl.create 107 in
  List.iter (fun package -> find_installed_cms 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

  Unix.find ["."] ~f:(fun path ->
    match Filename.split_extension path.Unix.base with
    | body, (".cmx" | ".cmo" | ".cmi" | ".ml" as ext) -> 
        begin match 
            let spotspits = 
              List.map (fun ext -> path.Unix.dir ^/ body ^ ext) (exts_of_sp ext)
            in
            try Some (List.find Sys.file_exists spotspits) with Not_found -> None
        with
        | None -> ()
        | Some spotspit ->
            let found = Hashtbl.find_all installed_cms (body, ext) in
            List.iter (fun p -> 
              match Unix.cmp p path.Unix.path with
              | `Different | `Error -> ()
              | `Same ->
                  (* The file is installed! If there is .spot/.spit, copy it! *)
                  let dirname = Filename.dirname p in
                  match 
                    Unix.command ["cp"; spotspit; dirname] (function
                      | (`Err, `Read mes) -> Printf.eprintf "Failed to copy %s to %s: %s\n" spotspit dirname mes
                      | _ -> ())
                  with
                  | WEXITED 0 -> 
                      Hashset.add copied p;
                      Printf.eprintf "Copied %s to %s\n" spotspit dirname
                  | WEXITED _ -> ()
                  | _ -> Printf.eprintf "Failed to copy %s to %s: SOME STRANGE READON\n" spotspit dirname
            ) found
        end
    | _ -> ());

  (* check not found *)
  Hashtbl.iter (fun _ path -> 
    if not (Hashset.mem copied path) then
      Printf.eprintf "No spot/spit/cmt/cmti found for %s\n" path) installed_cms