open Type_options;;
open Lexing;;

exception Too_complicated

let print_simple_value vl =
  let rec print_value v=
    match v with
    ValModule(_) ->
      raise Too_complicated
    | ValInt(i) ->
      Printf.fprintf stdout "%s" (Int64.to_string i);
    | ValFloat(f) ->
      Printf.fprintf stdout "%f" f;
    | ValList(lst) ->
      print_list lst;
    | ValString(s) 
    | ValChar(s)
    | ValIdent(s) ->
      Printf.fprintf stdout "%s" s
  and
  print_list l =
    match l with
    [ itm ] ->
      print_value itm
    | itm :: tl_lst ->
      print_value itm;
      Printf.fprintf stdout " ";
      print_list tl_lst
    | [] ->
      ()
  in
  print_value vl
;;
 
let output_option chn fl =
  let rec save_one_option f =
    match f with
    Comment(s,tl_f) ->
      Printf.fprintf chn "%s\n\n" s;
      save_one_option tl_f
    | Options(v,tl_f) ->
      save_var v;
      Printf.fprintf chn "\n";
      save_one_option tl_f
    | Eof ->
      ()
  and
  save_var v =
    match v with
    StringId(s,o) ->
      Printf.fprintf chn "\"%s\" = " s;
      save_value o;
      Printf.fprintf chn "\n"
    | Id(s,o) ->
      Printf.fprintf chn "%s = " s;
      save_value o;
      Printf.fprintf chn "\n"
  and
  save_value v =
    match v with
    ValModule(f) ->
      Printf.fprintf chn "{\n";
      save_one_option f;
      Printf.fprintf chn "}"
    | ValInt(i) ->
      Printf.fprintf chn "%s" (Int64.to_string i);
    | ValFloat(f) ->
      Printf.fprintf chn "%f" f;
    | ValList(lst) ->
      Printf.fprintf chn "[\n";
      save_list lst;
      Printf.fprintf chn "]"
    | ValString(s) ->
      Printf.fprintf chn "\"%s\"" s
    | ValChar(s) ->
      Printf.fprintf chn "'%s'" s
    | ValIdent(s) ->
      Printf.fprintf chn "%s" s
  and
  save_list l =
    match l with
    [ itm ] ->
      save_value itm
    | itm :: tl_lst ->
      save_value itm;
      Printf.fprintf chn ";\n";
      save_list tl_lst
    | [] ->
      ()
  in
  save_one_option fl
;;

let save_option filename fl =
  let chn = open_out filename
  in
  output_option chn fl;
  close_out chn
;;
 
let load_option filename =
  let file = open_in filename
  in
  let lexbuf = Lexing.from_channel file
  in
  try 
    lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with
    pos_fname = filename;
    pos_lnum  = 1;
    pos_bol   = 0;
    };
    let res = Parse_options.main Lexer_options.token lexbuf
    in
    close_in file;
    res
  with 
    Parsing.Parse_error 
  | Failure "int_of_string" ->
      let start_position =
        Lexing.lexeme_start_p lexbuf
      in
      let end_position =
        Lexing.lexeme_end_p lexbuf
      in
      Printf.fprintf stderr
      ( "Unable to parse file: %s\n"
      ^^"Last word seen: %S\n"
      ^^"Position: line %d, char. %d-%d\n" )
      (start_position.pos_fname)
      (Lexing.lexeme lexbuf)
      (start_position.pos_lnum)
      (start_position.pos_cnum - start_position.pos_bol)
      (end_position.pos_cnum - start_position.pos_bol);
      raise Parsing.Parse_error
;;

let parse_option str =
  let lexbuf = Lexing.from_channel stdin
  in
  try 
          Parse_options.main Lexer_options.token lexbuf 
  with Parsing.Parse_error ->
    print_string "Unable to parse option to set.";
    print_newline ();
    print_string ("Last word seen: " ^ (Lexing.lexeme lexbuf));
    print_newline ();
    print_string ("Position: "^(string_of_int (Lexing.lexeme_start lexbuf))^
      "-" ^ (string_of_int (Lexing.lexeme_end lexbuf)));
    print_newline ();
    raise Parsing.Parse_error
;;

let rec find_option id fl =
  match fl with
  Comment(_,f) ->
    find_option id f
  | Options(StringId(x, opv),f)
  | Options(Id(x, opv), f) ->
    if x = id then
      opv
    else
      find_option id f 
  | Eof ->
    raise Not_found

let replace_option op fl =
  let rec replace_one_option id vl is_replaced f =
    match f with
      Comment(s,f) ->
        Comment(s,(replace_one_option id vl is_replaced f))
    | Options(StringId(x,opv),f) when x = id ->
        Options(StringId(x,vl), replace_one_option id vl true f)
    | Options(Id(x,opv),f) when x = id ->
        Options(Id(x,vl), replace_one_option id vl true f)
    | Options(x,f) ->
        Options(x, replace_one_option id vl is_replaced f)
    | Eof when not is_replaced ->
        Options(op, Eof)
    | Eof ->
        Eof
  in
  let (nid,nvl) =
    match op with
    StringId(x,opv)
    | Id(x,opv) ->
        (x,opv)
  in
  replace_one_option nid nvl false fl
;;

let remove_option id fl =
  let rec remove_one_option id fl =
    match fl with
      Comment(s,nfl) ->
        Comment(s,(remove_one_option id nfl))
    | Options(StringId(x,_),nfl) 
    | Options(Id(x,_), nfl) when x = id ->
        remove_one_option id nfl
    | Options(x, nfl) ->
        Options(x, remove_one_option id nfl)
    | Eof ->
        Eof
  in
  remove_one_option id fl
;;
