indexop_test.ml

let file = open_in "pkg"

module In = struct
  let failure = open_in "failures.in"
  let success = open_in "success.in"
end

let (%) f g x = f (g x)
let fmt_open = Format.formatter_of_out_channel % open_out

type kind = Syntax | NI | Depext | Other
module M = Map.Make(struct type t = kind let compare=compare end)
let madd m (k,x) = M.add k x m
let of_list l = List.fold_left madd M.empty l

let errors =
  [ Syntax, "syntax.out";
    NI, "not_installable.out";
    Depext, "depexts.out";
    Other, "other.out"        ]
  |> List.map (fun (x,y) -> x, fmt_open y)
  |> of_list

let success = Format.formatter_of_out_channel @@ open_out "success.out"

let rec read file reader acc =
  match reader (input_line file) acc with
  | exception End_of_file -> acc
  | x -> read file reader x

module S = Set.Make(struct type t = string let compare = compare end)

let known =
  S.empty
  |> read In.failure S.add
  |> read In.success S.add

let skip = [
  "aacplus" (* DEPEXT *);
  "abt"; (* S *)
  "acgtk" (* OTHER *);
  "ansi-parse"; (* S *)
  "arakoon"; (* DEPEXT *)
  "async-mvar"; (* NI *)
  "async_core"; (* NI *)
  "aws-s3"; (* OTHER *)
]

let counter = ref 0

let marker s =
  let re = Tyre.(compile @@ str s) in
  fun s' ->
    match Tyre.exec re s' with
    | Ok () -> true
    | Error _ -> false

let search = let open M in
    of_list
      [
        Syntax, marker "Error: Syntax error";
        Depext, marker "depext";
        NI, marker "Your request can't be satisfied";
      ]

let process cmd =
  let std, stdin, errchan = Unix.open_process_full cmd (Unix.environment ()) in
  let reader line acc =
    M.fold
      (fun k search acc ->
         if search line then k else acc)
      search acc in
  let err = read errchan reader Other in
  let err = read std reader err in
  let pid', process_status = Unix.wait () in
  if process_status = Unix.WEXITED 0 then
    Ok ()
  else
    Error err

let exec fmt =
        Format.kasprintf process fmt

let string_of_kind = function
  | Syntax -> "\x1b[91m[SYNTAX]\x1b[0m"
  | NI -> "\x1b[36m[not installable]\x1b[0m"
  | Depext -> "\x1b[35m[external dependencies]\x1b[0m"
  | Other -> "\x1b[33m[???]\x1b[0m"

let next () =
  incr counter;
  let pkg = input_line file in
  Format.printf "%d) @?" !counter;
  if List.mem pkg skip || S.mem pkg known then
    Format.printf "%s: skipping@." pkg
  else
    begin
      Format.printf "installing package %s: @?" pkg;
      let status =
        match exec "opam install -y %s" pkg with
        | Ok () -> Format.printf "\x1b[32m[success]\x1b[0m@."; success
        | Error err ->
          Format.printf "%s@." (string_of_kind err);
          M.find err errors
      in
      Format.fprintf status "%s@." pkg
    end

let rec loop () =
  match next () with
  | () -> loop ()
  | exception End_of_file -> ()


;; loop ()