open Motus_lib

(** Represent a decision rule *)
let format_filter : Format.formatter -> Criteria.t -> unit =
 fun formatter f ->
  match f with
  | Lenght l -> Format.fprintf formatter "Doit etre de longueur %d" l
  | Contain (c, None) -> Format.fprintf formatter "Doit contenir un %c" c
  | Contain (c, Some i) ->
      Format.fprintf formatter "Doit contenir un %c a la position %d" c i
  | NotContain (c, None) ->
      Format.fprintf formatter "Ne doit pas contenir un %c" c
  | NotContain (c, Some i) ->
      Format.fprintf formatter "Ne doit pas contenir un %c a la position %d" c i


(** Display the informations about the structure *)
let show_structure :
    Format.formatter -> Persistence.t -> Criteria.t list -> unit =
 fun format data filters ->
  Format.fprintf
    format
    "Filtres en cours : @[<v>%a@]@\n"
    (Format.pp_print_list format_filter)
    filters;

  Format.fprintf format "Got %d elements @\n" data.number;

  Format.fprintf
    format
    "Frequencies : @[<v>%a@]@\n"
    (Format.pp_print_list (fun f (k, v) -> Format.fprintf f "%c -> %d" k v))
    (Persistence.extract_freq data);

  if data.number < 20
  then
    Format.fprintf
      format
      "Remaining words @[<v>@;%a@]@\n"
      (Format.pp_print_list ~pp_sep:Format.pp_force_newline (fun f w ->
           Format.fprintf f "%s" w ) )
      data.element;
  Format.close_box ()


(** Get the initial list *)
let rec get_list :
    in_channel -> Persistence.t -> Criteria.t list -> Persistence.t =
 fun channel data filters ->
  let word =
    try Some (String.lowercase_ascii (Stdlib.input_line channel)) with
    | End_of_file -> None
  in
  match word with
  | None -> data
  | Some word ->
      let data = Persistence.add_word filters data word in
      get_list channel data filters


(** Compare the proposed word and the result from the user in order to identify
    the future rules to apply *)
let create_new_rules word result =
  let rules = ref []
  and max_length = min (String.length word) (String.length result) in
  for i = 0 to max_length - 1 do
    match (String.get word i, String.get result i) with
    (* A space means that the letter is not present *)
    | c, ' ' -> rules := Criteria.NotContain (c, None) :: !rules
    (* The same letter means that the we found the right caracter *)
    | c, c' when Char.equal c c' ->
        rules := Criteria.Contain (c, Some i) :: !rules
    (* Anything else, we got the letter, but at the wrong place *)
    | c, _ ->
        rules :=
          Criteria.Contain (c, None)
          :: Criteria.NotContain (c, Some i)
          :: !rules
  done;
  !rules


let rec run filters words =
  let () = show_structure Format.std_formatter words filters in
  let freq = Persistence.extract_freq words in
  let next, score = Persistence.pick_next_word words freq in

  let () =
    Format.fprintf
      Format.std_formatter
      "Next word will be : %s (%d)@\n"
      next
      score
  in

  let input = Stdlib.read_line () in

  (* if the input is empty, remove the word from the list and restart *)
  match String.equal String.empty input with
  | true ->
      let new_words =
        List.filter (fun w -> not (String.equal w next)) words.element
      in
      run filters { words with element = new_words; number = words.number - 1 }
  | false ->
      let new_rules =
        Criteria.merge_lists ~init:filters (create_new_rules next input)
        |> List.sort_uniq Stdlib.compare
      in

      let words =
        List.fold_left
          (Persistence.add_word new_rules)
          (Persistence.empty_data ())
          words.element
      in
      run new_rules words


let init_rule rules word =
  String.iteri
    (fun p c ->
      match c with
      | ' ' -> ()
      | _ -> rules := Criteria.Contain (c, Some p) :: !rules )
    word


let () =
  let length = ref 5
  and dict = ref [] in
  let rules = ref [] in

  let anon_fun filename = dict := filename :: !dict in
  let speclist =
    [ ("-n", Arg.Set_int length, "Nombre de lettres")
    ; ("-p", Arg.String (init_rule rules), "Motif initial")
    ]
  in
  let () = Arg.parse speclist anon_fun "motus [-n <nb>] dictionnaire" in

  let initial_filter = Criteria.Lenght !length :: !rules in
  let words_channel = open_in (List.hd !dict) in
  let words =
    get_list words_channel (Persistence.empty_data ()) initial_filter
  in
  close_in words_channel;
  run initial_filter words