(*
 *    Copyright (C) 2020  Alban Gruin
 *
 *    ucs is free software: you can redistribute it and/or modify
 *    it under the terms of the GNU Affero General Public License as published
 *    by the Free Software Foundation, either version 3 of the License, or
 *    (at your option) any later version.
 *
 *    ucs 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 Affero General Public License for more details.
 *
 *    You should have received a copy of the GNU Affero General Public License
 *    along with ucs.  If not, see <http://www.gnu.org/licenses/>.
 *)

open CalendarLib

module J = Json_encoding

let memoize f =
  let hashtbl = Hashtbl.create ~random:true 100 in
  fun v ->
  match Hashtbl.find_opt hashtbl v with
  | Some r -> r
  | None ->
     let r = f v in
     Hashtbl.add hashtbl v r;
     r

let get_unicode v =
  let b = Buffer.create 1 in
  Buffer.add_utf_8_uchar b (Uchar.of_int v);
  Buffer.contents b

let memoized_get_unicode = memoize get_unicode

let html_entities_regex = Re.Perl.compile_pat "&#(\\d+);"

let replace_entities str =
  Re.Pcre.full_split ~rex:html_entities_regex str
  |> List.filter_map (function
         | Re.Pcre.Group (_, v) ->
            Some ("&#" ^ v ^ ";", memoized_get_unicode @@ int_of_string v)
         | _ -> None)
  |> Stringext.replace_all_assoc str

type loc_and_sum =
  | Nothing
  | Groups
  | Location of string
  | Summary of string * string

let loc_and_sum_to_str category = function
  | Nothing | Groups -> "", category
  | Location location -> location, category
  | Summary (location, summary) ->
     let summary = match Astring.String.cut ~sep:" - " summary with
       | None -> summary
       | Some (_, str) -> str in
     location, summary ^ " (" ^ category ^ ")"

let check_groups str =
  let group_affixes = ["L1 "; "L2 "; "L3 "; "L3P "; "M1 "; "M2 "; "DEUST ";
                       "MAG1 "; "1ERE ANNEE "; "2EME ANNEE "; "3EME ANNEE ";
                       "MAT-Agreg Interne "] in
  if List.fold_left
       (fun res affix ->
         res || Astring.String.is_prefix ~affix str) false group_affixes then
    Groups
  else
    Nothing

let location_and_summary str category =
  let sep = "\r\n\r\n<br />\r\n\r\n" in
  let parts = Astring.String.cuts ~empty:false ~sep str in
  List.fold_right (fun str -> function
      | Nothing -> check_groups str
      | Groups -> Location (replace_entities str)
      | Location summary -> Summary (replace_entities str, summary)
      | Summary _ as res -> res)
    parts Nothing
  |> loc_and_sum_to_str category

let date =
  let date_format = "%FT%T" in
  Printer.Calendar.(
    J.(conv (sprint date_format) (from_fstring date_format) string))

let encoding =
  J.(conv
       (fun _ -> (None, None, "", ""), ())
       (fun ((start, stop, description, category), ()) ->
         let location, summary = location_and_summary description category in
         match start, stop with
         | Some start, Some stop ->
            Some (Ics.Event.make start stop summary location)
         | _, _ -> None)
       (merge_objs
          (obj4
             (req "start" @@ option date)
             (req "end" @@ option date)
             (req "description" string)
             (req "eventCategory" string))
          unit))

let decode s =
  let toks =
    match s with
    | "" -> `O []
    | s -> Ezjsonm.from_string s in
  J.(destruct (list encoding) toks)
  |> List.filter_map (fun event -> event)
  |> Ics.make