(**************************************************************************)
(*  Copyright © 2009-2017 Stéphane Glondu <steph@glondu.net>              *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Printf
open Benl_core

let input_source = ref Benl_types.NoSource
let output_file = ref None

let get_config config key =
  try StringMap.find key config
  with Not_found -> Benl_error.raise (Benl_error.Missing_configuration_item key)

let is_affected config =
  lazy (Query.of_expr (get_config config "is_affected"))

let rebuild_command config =
  let c = Benl_frontend.to_string "rebuild_command" (get_config config "rebuild_command") in
  fun pkg -> Printf.ksprintf Sys.command "%s %s" c pkg = 0

open Benl_modules
open Marshallable
open Benl_data

let print_dep_line oc src deps =
  fprintf oc "%s:" !!!src;
  S.iter (fun dep -> fprintf oc " %s" !!!dep) deps;
  fprintf oc "\n%!"

let spec =
  Arg.align [
      "-stdin",
      Arg.Unit (fun () -> input_source := Benl_types.Stdin),
      " Use stdin to read the input file";
      "--output",
      Arg.String (fun x -> output_file := Some x),
      " Path to output file";
      "-o",
      Arg.String (fun x -> output_file := Some x),
      " Path to output file";
    ]

let compute_graph data config =
  let {src_map = sources; bin_map = binaries} = filter_affected data is_affected config in
  let src_of_bin : ([`binary], [`source] Package.Name.t) M.t =
    PAMap.fold
      (fun (name, _) pkg accu ->
         let source = Package.get "source" pkg in
         M.add name (Package.Name.of_string source) accu)
      binaries
      M.empty
  in
  Dependencies.get_dep_graph sources src_of_bin

let rebuild dep_graph config =
  let rebuild_command = rebuild_command config in
  let state = ref M.empty in
  let rec build pkg =
    match (try Some (M.find pkg !state) with Not_found -> None) with
    | None ->
       state := M.add pkg `Building !state;
       if S.for_all build (M.find pkg dep_graph) then (
         let b = rebuild_command !!!pkg in
         state := M.add pkg (`Built b) !state;
         b
       ) else (
         state := M.add pkg (`Built false) !state;
         false
       )
    | Some `Building -> failwith "dependency cycle detected"
    | Some (`Built b) -> b
  in
  M.iter (fun pkg _ -> ignore (build pkg)) dep_graph;
  let unsuccessful pkg =
    match M.find pkg !state with
    | `Building -> assert false
    | `Built b -> not b
  in
  M.fold
    (fun pkg deps accu ->
      if unsuccessful pkg then (
        let deps = S.filter unsuccessful deps in
        M.add pkg deps accu
      ) else accu
    ) dep_graph M.empty

let print_dependency_levels oc dep_graph rounds =
  List.iter begin fun xs ->
    let packages = List.sort (fun x y -> compare !!!x !!!y) xs in
    List.iter begin fun src ->
      let deps = M.find src dep_graph in
      print_dep_line oc src deps
    end packages
  end rounds

let main () =
  let config = match !input_source with
    | Benl_types.NoSource -> Benl_error.raise Benl_error.Missing_configuration_file
    | _ as source -> Benl_frontend.read_config ~multi:true source
  in
  let archs_list = Benl_frontend.to_string_l
    "architectures"
    (Benl_clflags.get_config config "architectures")
  in
  let data = Benl_data.load_cache archs_list in
  let dep_graph = compute_graph data config in
  let dep_graph = rebuild dep_graph config in
  let rounds = Dependencies.topo_split dep_graph in
  let oc, close = match !output_file with
    | None -> stdout, fun () -> ()
    | Some x -> let oc = open_out x in oc, fun () -> close_out oc
  in
  print_dependency_levels oc dep_graph rounds;
  close ()

let anon_fun file =
  if Benl_core.ends_with file ".ben" then
    input_source := Benl_types.File file

let frontend = {
  Benl_frontend.name = "rebuild";
  Benl_frontend.main = main;
  Benl_frontend.anon_fun = anon_fun;
  Benl_frontend.help = spec;
}
