(* Copyright (C) 2005, HELM Team.
 * 
 * This file is part of HELM, an Hypertextual, Electronic
 * Library of Mathematics, developed at the Computer Science
 * Department, University of Bologna, Italy.
 * 
 * HELM is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 * 
 * HELM 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 General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with HELM; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 * MA  02111-1307, USA.
 * 
 * For details, see the HELM World-Wide-Web page,
 * http://helm.cs.unibo.it/
 *)

let logger = fun mark -> 
  match mark with 
  | `Error -> MatitaLog.error
  | `Warning -> MatitaLog.warn
  | `Debug -> MatitaLog.debug
  | `Message -> MatitaLog.message
;;

type development = 
  { root: string ; name: string }

let developments = ref []
  
let pool () = Helm_registry.get "matita.basedir" ^ "/matitamake/" ;;
let rootfile = "/root" ;;

let ls_dir dir = 
  try
    let d = Unix.opendir dir in
    let content = ref [] in
    try
      while true do
        let name = Unix.readdir d in
        if name <> "." && name <> ".." then
          content := name :: !content
      done;
      Some []
    with End_of_file -> Unix.closedir d; Some !content
  with Unix.Unix_error _ -> None

let initialize () = 
  (* create a base env if none *)
  MatitaMisc.mkdir (pool ());
  (* load developments *)
  match ls_dir (pool ()) with
  | None -> logger `Error ("Unable to list directory " ^ pool ()) 
  | Some l -> 
      List.iter 
        (fun name -> 
          let root = 
            try 
              Some (MatitaMisc.input_file (pool () ^ name ^ rootfile))
            with Unix.Unix_error _ -> 
              logger `Warning ("Malformed development " ^ name);
              None
          in 
          match root with 
          | None -> ()
          | Some root -> 
              developments := {root = root ; name = name} :: !developments) 
      l

(* finds the makefile path for development devel *)
let makefile_for_development devel =
  let develdir = pool () ^ devel.name in
  develdir ^ "/makefile"
;;

(* given a dir finds a development that is radicated in it or below *)
let development_for_dir dir =
  let is_prefix_of d1 d2 =
    let len1 = String.length d1 in
    let len2 = String.length d2 in
    if len2 < len1 then 
      false
    else
      let pref = String.sub d2 0 len1 in
      pref = d1
  in
  (* it must be unique *)
  try
    Some (List.find (fun d -> is_prefix_of d.root dir) !developments)
  with Not_found -> None
;;

let development_for_name name =
  try 
    Some (List.find (fun d -> d.name = name) !developments)
  with Not_found -> None

(* dumps the deveopment to disk *)
let dump_development devel =
  let devel_dir = pool () ^ devel.name in 
  MatitaMisc.mkdir devel_dir;
  MatitaMisc.output_file devel.root (devel_dir ^ rootfile);
;;

let list_known_developments () = 
  List.map (fun r -> r.name,r.root) !developments

let am_i_opt () = 
  if Pcre.pmatch ~pat:"\\.opt$" Sys.argv.(0) then ".opt" else ""
  
let rebuild_makefile development = 
  let makefilepath = makefile_for_development development in
  let template = 
    MatitaMisc.input_file BuildTimeConf.matitamake_makefile_template 
  in
  let cc = BuildTimeConf.runtime_base_dir ^ "/matitac" ^ am_i_opt () in
  let rm = BuildTimeConf.runtime_base_dir ^ "/matitaclean" ^ am_i_opt () in
  let mm = BuildTimeConf.runtime_base_dir ^ "/matitadep" ^ am_i_opt () in
  let df = pool () ^ development.name ^ "/depend" in
  let dfs = pool () ^ development.name ^ "/depend.short" in
  let template = Pcre.replace ~pat:"@ROOT@" ~templ:development.root template in
  let template = Pcre.replace ~pat:"@CC@" ~templ:cc template in
  let template = Pcre.replace ~pat:"@DEP@" ~templ:mm template in
  let template = Pcre.replace ~pat:"@DEPFILE@" ~templ:df template in
  let template = Pcre.replace ~pat:"@DEPFILESHORT@" ~templ:dfs template in
  let template = Pcre.replace ~pat:"@CLEAN@" ~templ:rm template in
  MatitaMisc.output_file template makefilepath
  
(* creates a new development if possible *)
let initialize_development name dir =
  let dev = {name = name ; root = dir} in
  match development_for_dir dir with
  | Some d ->
      logger `Error 
        ("Directory " ^ dir ^ " is already handled by development " ^ d.name);
      logger `Error
        ("Development " ^ d.name ^ " is rooted in " ^ d.root); 
      logger `Error
        (dir ^ " is a subdir of " ^ d.root);
      None
  | None -> 
      dump_development dev;
      rebuild_makefile dev;
      developments := dev :: !developments;
      Some dev

let make chdir args = 
  let old = Unix.getcwd () in
  try
    Unix.chdir chdir;
    let rc = Unix.system (String.concat " " ("make"::args)) in
    Unix.chdir old;
    match rc with
    | Unix.WEXITED 0 -> true
    | Unix.WEXITED i -> logger `Error ("make returned " ^ string_of_int i);false
    | _ -> logger `Error "make STOPPED or SIGNALED!";false
  with Unix.Unix_error (_,cmd,err) -> 
    logger `Warning ("Unix Error: " ^ cmd ^ ": " ^ err);
    false
      
let call_make development target =
  rebuild_makefile development;
  let makefile = makefile_for_development development in
  make development.root 
    ["--no-print-directory"; "-s"; "-k"; "-f"; makefile; target]
      
let build_development ?(target="all") development =
  call_make development target
  
let clean_development development =
  call_make development "clean"

let destroy_development development =
  let delete_development development = 
    let unlink file =
      try 
        Unix.unlink file 
      with Unix.Unix_error _ -> logger `Debug ("Unable to delete " ^ file)
    in
    let rmdir dir =
      try
        Unix.rmdir dir 
      with Unix.Unix_error _ -> 
        logger `Warning ("Unable to remove dir " ^ dir);
        match ls_dir dir with
        | None -> logger `Error ("Unable to list directory " ^ dir) 
        | Some [] -> ()
        | Some l -> logger `Error ("The directory is not empty")
    in
    unlink (makefile_for_development development);
    unlink (pool () ^ development.name ^ rootfile);
    unlink (pool () ^ development.name ^ "/depend");
    unlink (pool () ^ development.name ^ "/depend.short");
    rmdir (pool () ^ development.name);
    developments := 
      List.filter (fun d -> d.name <> development.name) !developments
  in
  if not(clean_development development) then
    begin
      logger `Warning "Unable to clean the development problerly.";
      logger `Warning "This may cause garbage."
    end;
  delete_development development 
  
let root_for_development development = development.root
let name_for_development development = development.name