path: root/tools.ml

let u = UTF8.from_utf8string

module Option = struct

  let map f = function
  | Some x -> Some (f x)
  | None -> None
end

module String = struct

  include String

  let split str ~by:sep = begin
    let p = String.index str sep in
    let slen = String.length str in
    String.sub str 0 p, String.sub str (p + 1) (slen - p - 1)
  end

  let cut str ~by:sep = begin
    try String.sub str 0 @@ String.index str sep with
    | Not_found -> str
  end

  let string_of_ints v = begin
    let buff = Buffer.create 1 in
    let rec convert value = begin
      Buffer.add_char buff @@ char_of_int @@ value land 0xFF;
      let rem = value lsr 8 in
      match rem with
      | 0 -> Buffer.contents buff
      | x -> convert x
    end in
    let res = convert v in
    let buff' = Buffer.create @@ String.length res in
    for i = ((String.length res) - 1) downto 0 do
      Buffer.add_char buff' @@ String.get res i
    done;
    Buffer.contents buff'
  end

  let print_buffer f t = begin
    let buff = UTF8.Buffer.create 16 in
    f buff t;
    UTF8.Buffer.contents buff
  end

  let filter_float str = begin
    let l = String.length str in
    if l > 0 && String.get str (l - 1) = '.' then
      String.sub str 0 (l - 1)
    else
      str
  end

end

module Num = struct

  include Num

  let of_float_string a = begin
    try
      let ipart_s,fpart_s = String.split a ~by:'.' in
      let ipart = if ipart_s = "" then Num.Int 0 else Num.num_of_string ipart_s in
      let fpart =
        if fpart_s = "" then Num.Int 0
        else
          let fpart = Num.num_of_string fpart_s in
          let num10 = Num.num_of_int 10 in
          let frac = Num.power_num num10 (Num.num_of_int (String.length fpart_s)) in
          Num.div_num fpart frac
      in
      Num.add_num ipart fpart
    with Not_found -> Num.num_of_string a
  end

end

module List = struct

  (** fold_left over only the first element *)
  let fst f init = function
  | hd::tl -> f init hd
  | [] -> init

  let printb ?(first=(u"(")) ?(last=(u")")) ?(sep=(u",")) f buffer elems = begin

    let rec print = begin function
    | [] -> ()
    | hd::[] ->
        f buffer hd;
    | hd::tl ->
        f buffer hd;
        UTF8.Buffer.add_string buffer sep;
        print tl
    end in

    UTF8.Buffer.add_string buffer first;
    print elems;
    UTF8.Buffer.add_string buffer last
  end


end

module Tuple2 = struct

  let fst = Pervasives.fst

  let snd = Pervasives.snd

  let map1 f (a, b) = (f a, b)

  let map2 f (a, b) = (a, f b)

  let replace1 v (a, b) = (v, b)

  let replace2 v (a, b) = (a, v)

  let printb ?(first="(") ?(last=")") ?(sep=",") format1 format2 out (a, b) = begin
    UTF8.Printf.bprintf out "%s%a%s%a%s"
      first
      format1 a
      sep
      format2 b
      last
  end

end

module Tuple3 = struct

    let fst (a, b, c) = a

    let snd (a, b, c) = b

    let thd (a, b, c) = c

    let map f (a, b, c) = (f a, f b, f c)

    let map1 f (a, b, c) = (f a, b, c)

    let map2 f (a, b, c) = (a, f b, c)

    let map3 f (a, b, c) = (a, b, f c)

    let replace1 v (a, b, c) = (v, b, c)

    let replace2 v (a, b, c) = (a, v, c)

    let replace3 v (a, b, c) = (a, b, v)
end

(*
module Locale = struct

  type locale =
    | LC_ALL
    | LC_COLLATE
    | LC_CTYPE
    | LC_MONETARY
    | LC_NUMERIC
    | LC_TIME
    | LC_MESSAGES

  external set: locale -> string -> string = "c_set_locale"

  external length: string -> int = "c_length"

end
*)

module NCurses = struct

  type mouse_event =
  | BUTTON1_PRESSED
  | BUTTON1_RELEASED
  | BUTTON1_CLICKED
  | BUTTON1_DOUBLE_CLICKED
  | BUTTON1_TRIPLE_CLICKED
  | BUTTON2_PRESSED
  | BUTTON2_RELEASED
  | BUTTON2_CLICKED
  | BUTTON2_DOUBLE_CLICKED
  | BUTTON2_TRIPLE_CLICKED
  | BUTTON3_PRESSED
  | BUTTON3_RELEASED
  | BUTTON3_CLICKED
  | BUTTON3_DOUBLE_CLICKED
  | BUTTON3_TRIPLE_CLICKED
  | BUTTON4_PRESSED
  | BUTTON4_RELEASED
  | BUTTON4_CLICKED
  | BUTTON4_DOUBLE_CLICKED
  | BUTTON4_TRIPLE_CLICKED
  | BUTTON_SHIFT
  | BUTTON_CTRL
  | BUTTON_ALT
  | ALL_MOUSE_EVENTS
  | REPORT_MOUSE_POSITION

  type event_type

  external set_mouse_event: mouse_event list -> unit = "c_set_mouse_event"

  external get_mouse_event: unit -> (int * event_type * (int * int * int)) option = "c_get_mouse_event"

  external is_event_of_type: mouse_event -> event_type -> bool = "c_is_event_of_type"

end

module Date = struct

  type t = Num.num

  let get_julian_day year month day = begin
    CalendarLib.Date.make year month day
    |> CalendarLib.Date.to_jd
    |> Num.num_of_int
  end

  let date_from_julian_day j = begin
    let date = CalendarLib.Date.from_jd (Num.int_of_num @@ Num.floor_num j) in
    (CalendarLib.Date.year date),
    (CalendarLib.Date.int_of_month @@ CalendarLib.Date.month date),
    (CalendarLib.Date.day_of_month date)
  end

  let time_from_julian_day j = begin Num.(
    let day = floor_num j in
    let time = j -/ day in

    let h = floor_num @@ time */ (num_of_int 24) in
    let h_24 = (h // (num_of_int 24)) in
    let m = floor_num @@ (num_of_int 1440) */ (time -/ h_24 ) in
    let s = (num_of_int 86400) */ (time -/ h_24 -/ (m // (num_of_int 1440))) in
    (h, m, s)
  ) end

  (** Compute the julian for a given date.

      Integer return number of days since November 24, 4714 BC.
      Fractionnal part return the time since midnight.
  *)
  let from_string str = begin
    let n = Num.num_of_int in
    let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+"
    and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in
    if Str.string_match time_regex str 0 then
      Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec ->
      Num.(
        let nhour = n hour // (n 24)
        and nmin  = n min // (n 1440)
        and nsec  = n sec // (n 86400) in
        (get_julian_day year month day) +/ nhour +/ nmin +/ nsec
      )
    ) else if Str.string_match date_regex str 0 then
      Scanf.sscanf str "%d-%d-%d" get_julian_day
    else (
      Num.num_of_int 0
    )
  end

  let to_string date = begin
    let y, m, d = date_from_julian_day date
    and h, n, s = time_from_julian_day date in

    Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g"
      y
      m
      d
      (Num.int_of_num h)
      (Num.int_of_num n)
      (Num.float_of_num s)

  end


end

let try_finally f except =
  try let res = f () in
    except ();
    res
  with e ->
    except ();
    raise e