Source

spotinstall / spotinstall.ml

open Spotlib.Spot
open Unix
open Printf

type dest = 
  | Package of string
  | Path of string

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

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
  | [], v -> `All, v
  | dests, v -> `Some dests, v

module OCamlFind = struct

  let path = 
    match 
      imp_ None & fun ocamlfind_path ->
        ignore & shell_command "ocamlfind printconf destdir" ~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_newline line)
              end
          | _ -> ())
    with
    | None -> failwith "No ocamlfind installtion path found. Check your ocamlfind."
    | Some p -> p
  
  let dest_dir package = 
    match 
      imp_ None & fun result ->
        ignore & shell_command (sprintf "ocamlfind query %s" package) ~f:(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 -> 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 ->
      ignore & shell_command "ocamlfind list" ~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
        | _ -> ())
end

module OCaml = struct

  let where = 
    match 
      imp_ None & fun ocaml_where ->
        ignore & shell_command "ocamlc -where" ~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_newline line)
              end
          | _ -> ())
    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" -> [ ".annot" ]
  | _ -> assert false

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

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

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

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

  find ["."] ~f:(fun path ->
    match Filename.split_extension path.base with
    | body, (".cmx" | ".cmo" | ".cmi" | ".ml" 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_cms (body, ext) 
          |> List.iter (fun (_package, p) -> 
            match 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
                match 
                  command ["cp"; spotspit; dirname] ~f:(function
                    | (`Err, `Read mes) -> eprintf "Failed to copy %s to %s: %s\n%!" spotspit dirname mes
                    | _ -> ())
                with
                | WEXITED 0 -> 
                    Hashset.add copied p;
                    eprintf "Copied %s to %s\n%!" spotspit dirname
                | WEXITED _ -> ()
                | _ -> eprintf "Failed to copy %s to %s: SOME STRANGE READON\n%!" spotspit dirname))
    | _ -> ());

  (* 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_cms
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.