(*********************************************************************************)
(*                Higlo                                                          *)
(*                                                                               *)
(*    Copyright (C) 2014-2021 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    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 Library General Public License for more details.                       *)
(*                                                                               *)
(*    You should have received a copy of the GNU Lesser General Public           *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*                                                                               *)
(*********************************************************************************)

(** *)

type to_load = Pkgs of string list | Files of string list

let verbose = ref false;;
let verb msg = if !verbose then prerr_endline msg;;

let string_of_inch chanin =
  let len = 1024 in
  let s = Bytes.create len in
  let buf = Buffer.create len in
  let rec iter () =
    try
      let n = input chanin s 0 len in
      if n = 0 then
        ()
      else
        (
         Buffer.add_subbytes buf s 0 n;
         iter ()
        )
    with
      End_of_file -> ()
  in
  iter ();
  Buffer.contents buf
;;

let string_of_file name =
  let chanin = open_in_bin name in
  let s = string_of_inch chanin in
  close_in chanin ;
  s
;;

let handle_file lang printer file =
  let tokens = Higlo.Lang.parse ~lang (string_of_file file) in
  printer tokens
;;

let handle_stdin lang printer =
  let code = string_of_inch stdin in
  let tokens = Higlo.Lang.parse ~lang code in
  printer tokens
;;

(*c==v=[List.list_remove_doubles]=1.0====*)
let list_remove_doubles ?(pred=(=)) l =
  List.fold_left
    (fun acc e -> if List.exists (pred e) acc then acc else e :: acc)
    []
    (List.rev l)
(*/c==v=[List.list_remove_doubles]=1.0====*)

let load_file file =
  let file = Dynlink.adapt_filename file in
  verb (Printf.sprintf "Loading file %s" file);
  try Dynlink.loadfile file
  with Dynlink.Error e ->
      failwith (Dynlink.error_message e)

let files_of_packages pkg_names =
  let kind = if Dynlink.is_native then "native" else "byte" in
  let tmp_file = Filename.temp_file "higlo" ".txt" in
  let com =
    Printf.sprintf "ocamlfind query %s -predicates plugin,%s -r -format %%d/%%a > %s"
      (String.concat " " (List.map Filename.quote pkg_names))
      kind (Filename.quote tmp_file)
  in
  match Sys.command com with
    0 ->
      let s = string_of_file tmp_file in
      Sys.remove tmp_file ;
      Higlo.Misc.split_string s ['\n']
  | n ->
      Sys.remove tmp_file ;
      let msg = Printf.sprintf "Command failed (%d): %s" n com in
      failwith msg
;;


let files_of_to_load = function
  Pkgs pkgs -> files_of_packages pkgs
| Files files -> files
;;

let dynload_code l =
  let files = List.fold_left
    (fun acc to_load ->
       List.fold_left
         (fun acc f -> if List.mem f acc then acc else f :: acc)
         acc (files_of_to_load to_load)
    )
    [] l
  in
  List.iter load_file (List.rev files)
;;

let to_load = ref [];;

let add_pkgs s = to_load := (Pkgs (Higlo.Misc.split_string s [','; ' '])) :: !to_load ;;
let add_dynf s = to_load := (Files (Higlo.Misc.split_string s [','; ' '])) :: !to_load;;

let files = ref [];;
let lang = ref "ocaml";;
let out_format = ref "xml";;

let options = [
    "-v", Arg.Set verbose, " verbose mode";

    "-f", Arg.Set_string out_format,
    "<s> set output format to <s>; default is xml" ;

    "-l", Arg.Set_string lang, "<s> set language to <s>; default is ocaml" ;

    "--pkg", Arg.String add_pkgs,
    "pkg1,pkg2,... dynmically load the given packages" ;

    "--load", Arg.String add_dynf,
    "file1.cm[xs|o|a],... dynmically load the given object files" ;
  ]
;;

let () =
  try
    Arg.parse (Arg.align options)
      (fun f  -> files := f :: !files)
      (Printf.sprintf "Usage: %s [options] [files]\nwhere options are:" Sys.argv.(0));
    dynload_code (List.rev !to_load);
    let printer = Higlo.Printers.get_printer !out_format in
    ignore(
     try let _x = Higlo.Lang.get_lexer !lang in ()
     with Higlo.Lang.Error (Unknown_lang name) ->
         failwith (Printf.sprintf "Unknown language %S" name)
    );
    match List.rev !files with
      [] -> handle_stdin !lang printer
    | files -> List.iter (handle_file !lang printer) files
  with
    Failure s ->
      prerr_endline s ;
      exit 1
;;
    