(*
 *    Copyright (C) 2020, 2021  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 of string list
  | Summary of string list * string
  | Location of string list * string * string

let loc_and_sum_to_groups = function
  | Nothing -> []
  | Groups groups | Summary (groups, _) | Location (groups, _, _) -> groups

let loc_and_sum_to_location = function
  | Nothing | Groups _ | Summary _ -> None
  | Location (_, _, location) -> Some location

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

let loc_and_sum_to_event start stop category loc_and_sum =
  let groups = loc_and_sum_to_groups loc_and_sum and
      location = loc_and_sum_to_location loc_and_sum and
      summary = loc_and_sum_to_summary category loc_and_sum in
  Some (Ics.Event.make start stop summary location groups)

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 (Astring.String.cuts ~empty:false ~sep:"<br />" @@ replace_entities str)
  else
    Nothing

let location_and_summary str =
  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 groups -> Summary (groups, replace_entities str)
      | Summary (groups, summary) -> Location (groups, summary, replace_entities str)
      | Location _ as res -> res)
    parts Nothing

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), ()) ->
         match start, stop with
         | Some start, Some stop ->
            let loc_and_sum = location_and_summary description in
            loc_and_sum_to_event start stop category loc_and_sum
         | _, _ -> 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