open Basetypes
open Cmdliner
open Datatype
open Json_parser
open Sys

module ParseExt =
struct
  open Yojson.Basic
    
      
  let remove_quotes s =
    let len = String.length s in
    if String.get s 0 = '"' && String.get s (len-1) = '"' then
      String.sub s 1 (len-2)
    else (
      Format.eprintf "No quotes in string %s@.@?" s;
      assert false
    )

  let get_vars json =
      let get_vdecls key json =
	let s = json |> Util.member key |> to_string in
	try
	  let s'= remove_quotes s in
	  if s' = "" then [] else  
	    let lexbuf = Lexing.from_string s' in
	    Parser_lustre.vdecl_list Lexer_lustre.token lexbuf
	with _ -> (Format.eprintf "Issues parsing decls for %s: %s@.@?" key s; assert false)
	  
      in
      let inputs = get_vdecls "inputs" json in
      let outputs = get_vdecls "outputs" json in
      let variables = get_vdecls "variables" json in
      inputs, outputs, variables
      
  (* Protecting the generation of condition/action in case of an empty string
     instead of a subtree *)
  let protect default parse_fun embed_fun json =
    try
      let vars = get_vars json in
	let actions = json |> Util.member "actions" |> to_string in
	if actions = "[]" || actions = "" then default (* should not happen *) else (
	  Format.eprintf "Parsing string: %s@." actions;
	  let lexbuf = Lexing.from_string (remove_quotes actions) in
	  try
	    let content = parse_fun Lexer_lustre.token lexbuf in
	    Parsing.clear_parser ();
	    embed_fun content vars
	  with Parsing.Parse_error ->
	    let loc = Location.dummy_loc in
	    raise (Parse.Error (loc, Parse.String_Syntax_error actions))
	)
    with Util.Type_error _ -> (
      Format.eprintf
	"Unable to explore json subtree: empty string %s@." (to_string json);
      default
    )
      
  let parse_condition =
    protect
      Condition.tru
      Parser_lustre.expr
      (fun e (in_,out_,locals_) ->
	(* let vars = Corelang.get_expr_vars e in *)
	Condition.cquote {
	expr =  e;
	cinputs = in_;
	coutputs = out_;
	cvariables = locals_;
	  
      })
    
  let parse_action =
    protect Action.nil Parser_lustre.stmt_list
      (fun (stmts, asserts, annots) (in_, out_, locals_) ->
	if asserts != [] || annots != [] then
	  assert false (* Stateflow equations should not use asserts nor define
			  annotations *)
	else
	  Action.aquote ({
	    defs = stmts;
	    ainputs = in_;
	    aoutputs = out_;
	    avariables = locals_;
	  })
      )
      
  let parse_event json  = Some Yojson.Basic.(json |> to_string)
end

module JParse = Parser (ParseExt)

(* setup for logging *)
let setup_log style_renderer level =
  Fmt_tty.setup_std_outputs ?style_renderer ();
  Logs.set_level level;
  Logs.set_reporter (Logs_fmt.reporter ());
  ()

let modular = ref 0

(* function representing the program to execute *)
let json_parse _ file pp =
  try
    let prog = JParse.parse_prog (Yojson.Basic.from_file file) in
    if pp then
      SF.pp_prog Format.std_formatter prog;

    let module Model =
	struct
	  let model = prog
	  let name = "toto" (* TODO find a meaningful name *)
	  let traces = [] (* TODO: shall we remove the traces field? *)
	end
    in
    let modularmode =
      match !modular with
      | 2 -> true, true, true
      | 1 -> false, true, false
      | _ (* 0 *) -> false, false ,false
    in
    let state_vars = Datatype.SF.states Model.model in
    let global_vars = Datatype.SF.global_vars Model.model in
    
    let module T = CPS_lustre_generator.LustrePrinter (struct
      let state_vars = state_vars
      let global_vars = global_vars 
    end) in
    let module Sem = CPS.Semantics (T) (Model) in
    let prog = Sem.code_gen modularmode in
    let header = List.map Corelang.mktop [
      (LustreSpec.Open (false,"lustrec_math"));
      (LustreSpec.Open (false,"conv"));
      (LustreSpec.Open (true,"locallib"));
    ]
    in
    let prog =header@prog in
    Options.print_dec_types := true;
    (* Format.printf "%a@." Printers.pp_prog prog; *)

    let auto_file = "sf_gen_test_auto.lus" in (* Could be changed *)
    let auto_out = open_out auto_file in
    let auto_fmt = Format.formatter_of_out_channel auto_out in
    Format.fprintf auto_fmt "%a@." Printers.pp_prog prog;
    Format.eprintf "Print initial lustre model with automaton in sf_gen_test_auto.lus@.";
    
    let prog, deps = Compiler_stages.stage1 prog "" "" in

    (* Format.printf "%a@." Printers.pp_prog prog; *)
    let noauto_file = "sf_gen_test_noauto.lus" in (* Could be changed *)
    let noauto_out = open_out noauto_file in
    let noauto_fmt = Format.formatter_of_out_channel noauto_out in
    Format.fprintf noauto_fmt "%a@." Printers.pp_prog prog;
    Format.eprintf "Print expanded lustre model in sf_gen_test_noauto.lus@.";
    ()

  with Parse.Error (l, err) -> Format.eprintf "Parse error at loc %a : %a@.@?" Location.pp_loc l Parse.pp_error err

(* term representing argument for file *)
let file =
  let doc = "The file to parse." in
  let env = Arg.env_var "JSON_FILE" ~doc in
  let doc = "The file to parse." in
  Arg.(required & pos 0 (some string) None & info [] ~env ~docv:"FILE" ~doc)

(* term representing argument for flag for pretty printing the program *)
let pp =
  let doc = "Pretty print the resulting program" in
  Arg.(value & flag & info ["pp"; "pretty-print"] ~docv:"PP" ~doc)

(* term for argument for logging *)
let setup_log_arg =
  let env = Arg.env_var "TOOL_VERBOSITY" in
  Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ~env ())

(* term representing the program to execute *)
let json_parse_t = Term.(const json_parse $ setup_log_arg $ file $ pp)

(* term info for manpages etc. *)
let info =
  let doc = "parse a JSON file representing a Stateflow model" in
  let man = [
    `S Manpage.s_bugs;
    `P "Report bug to Github issues tracking." ]
  in
  Term.info "parse_json_file" ~doc ~exits:Term.default_exits ~man

(* program *)
let _ =
  Term.exit @@ Term.eval (json_parse_t, info)
