(******************************************************************************)
(*  _  __ * The Kappa Language                                                *)
(* | |/ / * Copyright 2010-2020 CNRS - Harvard Medical School - INRIA - IRIF  *)
(* | ' /  *********************************************************************)
(* | . \  * This file is distributed under the terms of the                   *)
(* |_|\_\ * GNU Lesser General Public License Version 3                       *)
(******************************************************************************)

let file = ref ""
let dotCflows = ref Causal.Dot
let none_compression = ref false
let weak_compression = ref false
let strong_compression = ref false

let options =
  [
    "-o", Arg.String Kappa_files.set_cflow, "file name skeleton for outputs";
    ( "-d",
      Arg.String Kappa_files.set_dir,
      "Specifies directory name where output file(s) should be stored" );
    "--none", Arg.Set none_compression, "Outputs uncompressed stories";
    "--weak", Arg.Set weak_compression, "Outputs weakly compressed stories";
    ( "--strong",
      Arg.Set strong_compression,
      "Outputs strongly compressed stories" );
    ( "-format",
      Arg.String
        (function
        | "true" | "yes" | "dot" -> dotCflows := Causal.Dot
        | "false" | "no" | "html" -> dotCflows := Causal.Html
        | "json" -> dotCflows := Causal.Json
        | _ as error ->
          raise
            (ExceptionDefn.Malformed_Decl
               (Loc.annot_with_dummy
                  ("Value " ^ error
                 ^ " should be either \"html, dot\" or \"json\"")))),
      "Print stories in html format" );
    ( "--time-independent",
      Arg.Set Parameter.time_independent,
      "Disable the use of time is story heuritics (for test suite)" );
  ]

let process_command delimiter =
  let f =
    Kastor_mpi.on_message ~none:!none_compression ~weak:!weak_compression
      ~strong:!strong_compression ~send_message:(fun x ->
        Format.printf "%s%c@?" x delimiter)
  in
  fun text ->
    let () = f text in
    Lwt.return_unit

let get_simulation fname =
  let env, steps =
    Trace.fold_trace_file
      (fun _env steps step -> step :: steps)
      (fun _ -> [])
      fname
  in
  env, List.rev steps

let main () =
  let common_args = Common_args.default in
  let stdsim_args = Agent_args.default in
  let options =
    Common_args.options common_args @ Agent_args.options stdsim_args @ options
  in
  let () =
    Arg.parse options
      (fun f ->
        if !file = "" then
          file := f
        else (
          let () = Format.eprintf "Deals only with 1 file" in
          exit 2
        ))
      (Sys.argv.(0)
     ^ " trace\n computes stories from 'trace' file generated by KaSim")
  in
  let () = Printexc.record_backtrace common_args.Common_args.backtrace in
  if !file = "" then
    Lwt_main.run
      (Agent_common.serve Lwt_io.stdin stdsim_args.Agent_args.delimiter
         (process_command stdsim_args.Agent_args.delimiter))
  else (
    let none, weak, strong =
      !none_compression, !weak_compression, !strong_compression
    in
    let parameter =
      Compression_main.build_parameter
        ~called_from:Remanent_parameters_sig.KaSim ?send_message:None ~none
        ~weak ~strong ()
    in
    let () =
      Loggers.fprintf
        (Compression_main.get_logger parameter)
        "+ Loading trace@."
    in
    let dotFormat = !dotCflows in
    try
      let env, steps = get_simulation !file in
      Compression_main.compress_and_print parameter ~dotFormat env
        (Compression_main.init_secret_log_info ())
        steps
    with Yojson.Basic.Util.Type_error (s, x) ->
      Loggers.fprintf
        (Compression_main.get_logger parameter)
        "Json error: \"%s\" in %s@." s (Yojson.Basic.to_string x)
  )

let () = Sys.catch_break true
let () = main ()
