(*
 *  ENIAMsubsyntax: MWE, abbreviation and sentence detecion for Polish
 *  Copyright (C) 2016 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
 *  Copyright (C) 2016 Institute of Computer Science Polish Academy of Sciences
 *
 *  This library is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  This library 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 Lesser 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, see <http://www.gnu.org/licenses/>.
 *)

open Xstd
open ENIAMtokenizerTypes
open ENIAMsubsyntaxTypes

let load_dict dict filename =
  let lines = File.load_lines filename in
  Xlist.fold lines dict (fun dict line ->
    match Str.split_delim (Str.regexp "\t") line with
      [orth; _; _] ->
        let s = List.hd (Str.split_delim (Str.regexp " ") orth) in
        StringMap.add_inc dict s [line] (fun l -> line :: l)
    | _ -> failwith ("load_mwe_dict '" ^ line ^ "'"))

let mwe_dict =
  let dict = load_dict StringMap.empty brev_filename in
(*  let dict = load_dict dict fixed_filename in
  let dict = load_dict dict complete_entries_filename in*)
  dict

let preselect_dict orths dict =
  StringSet.fold orths [] (fun rules orth ->
    try
      let l = StringMap.find dict orth in
      Xlist.fold l rules (fun rules line ->
        match Str.split_delim (Str.regexp "\t") line with
          [orth; lemma; interp] ->
               let match_list = Str.split (Str.regexp " ") orth in
               let b = Xlist.fold match_list true (fun b s -> StringSet.mem orths s && b) in
               if b then (match_list,lemma,interp) :: rules else rules
        | _ -> failwith "preselect_dict")
    with Not_found -> rules)




let get_orths paths =
  IntMap.fold paths StringSet.empty (fun orths _ map ->
    IntMap.fold map orths (fun orths _ l ->
      Xlist.fold l orths (fun orths t ->
        StringSet.add orths (ENIAMtokens.get_orth t.token))))

let rec match_path_rec map found t rev = function
    [] -> (t :: rev) :: found
  | s :: l ->
     let map2 = try IntMap.find map t.next with Not_found -> IntMap.empty in
     let found2 = IntMap.fold map2 [] (fun found2 _ l ->
       Xlist.fold l found2 (fun found2 new_t ->
         if ENIAMtokens.get_orth new_t.token = s then new_t :: found2 else found2)) in
     Xlist.fold found2 found (fun found new_t -> match_path_rec map found new_t (t :: rev) l)

let match_path map = function
    [] -> failwith "match_path"
  | s :: l ->
     let found = IntMap.fold map [] (fun found i map2 ->
       IntMap.fold map2 found (fun found j l ->
         Xlist.fold l found (fun found t ->
           if ENIAMtokens.get_orth t.token = s then t :: found else found))) in
     Xlist.fold found [] (fun found t -> match_path_rec map found t [] l)

let concat_orths l =
  String.concat "" (Xlist.map l (fun t -> t.orth))

let create_token matching lemma interp = (* FIXME: problem z nazwami własnymi *)
  let l = List.rev matching in
  let beg = (List.hd l).beg in
  let t = List.hd matching in
  let len = t.beg + t.len - beg in
   {empty_token with
    orth=concat_orths l;
    beg=beg;
    len=len;
    next=t.next;
    token=ENIAMtokens.make_lemma (lemma,interp);
    weight=0.; (* FIXME: dodać wagi do konkretnych reguł i uwzględnić wagi maczowanych tokenów *)
    attrs=ENIAMtokens.merge_attrs l}

let add_token paths t =
  let map = try IntMap.find paths t.beg with Not_found -> IntMap.empty in
  let map = IntMap.add_inc map t.next [t] (fun l -> t :: l) in
  IntMap.add paths t.beg map

let apply_rule paths (match_list,lemma,interp) =
  let matchings_found = match_path paths match_list in
  Xlist.fold matchings_found paths (fun paths matching ->
    try
      let token = create_token matching lemma interp in
      add_token paths token
    with Not_found -> paths)

let process (paths,last) =
  let paths = Xlist.fold paths IntMap.empty add_token in
  let orths = get_orths paths in
  let rules = preselect_dict orths mwe_dict in
  let paths = Xlist.fold rules paths apply_rule in
  let paths = IntMap.fold paths [] (fun paths _ map ->
    IntMap.fold map paths (fun paths _ l ->
      Xlist.fold l paths (fun paths t ->
        t :: paths))) in
  ENIAMpaths.sort (paths,last)
