(**************************************************************************)
(*                                                                        *)
(*    Copyright (c) 2014 - 2016.                                          *)
(*    Dynamic Ledger Solutions, Inc. <contact@tezos.com>                  *)
(*                                                                        *)
(*    All rights reserved. No warranty, explicit or implicit, provided.   *)
(*                                                                        *)
(**************************************************************************)

open Error_monad
open CalendarLib

type t = int64

let compare = Int64.compare
let (=) x y = compare x y = 0
let equal = (=)
let (<>) x y = compare x y <> 0
let (<) x y = compare x y < 0
let (<=) x y = compare x y <= 0
let (>=) x y = compare x y >= 0
let (>) x y = compare x y > 0
let min x y = if x <= y then x else y
let max x y = if x <= y then y else x

let add = Int64.add
let diff = Int64.sub

let now () = Int64.of_float (Unix.gettimeofday ())

let of_seconds x = x
let to_seconds x = x

let formats =
  [ "%Y-%m-%dT%H:%M:%SZ" ; "%Y-%m-%d %H:%M:%SZ";
    "%Y-%m-%dT%H:%M:%S%:z"; "%Y-%m-%d %H:%M:%S%:z"; ]

let int64_of_calendar c =
  let round fc =
    let f, i = modf fc in
    Int64.(add (of_float i) Pervasives.(if f < 0.5 then 0L else 1L)) in
  round @@ Calendar.Precise.to_unixfloat c

let rec iter_formats s = function
  | [] -> None
  | f :: fs ->
      try
        Some (int64_of_calendar @@ Printer.Precise_Calendar.from_fstring f s)
      with _ -> iter_formats s fs

let of_notation s =
  iter_formats s formats
let of_notation_exn s =
  match of_notation s with
  | None -> invalid_arg "Time.of_notation: can't parse."
  | Some t -> t

let to_notation t =
  let ft = Int64.to_float t in
  if Int64.of_float ft <> t then
    "out_of_range"
  else
    Printer.Precise_Calendar.sprint
      "%Y-%m-%dT%H:%M:%SZ"
      (Calendar.Precise.from_unixfloat ft)

let rfc_encoding =
  let open Data_encoding in
  def
    "timestamp" @@
  describe
    ~title:
      "RFC 339 formatted timestamp"
    ~description:
      "A date in human readble form as specified in RFC 3339." @@
  conv
    to_notation
    (fun s -> match of_notation s with
       | Some s -> s
       | None -> Data_encoding.Json.cannot_destruct "Time.of_notation")
    string

let encoding =
  let open Data_encoding in
  splitted
    ~binary: int64
    ~json:
      (union [
          case
            rfc_encoding
            (fun i -> Some i)
            (fun i -> i) ;
          case
            int64
            (fun _ -> None)
            (fun i -> i) ;
        ])

type 'a timed_data = {
  data: 'a ;
  time: t ;
}

let timed_encoding arg_encoding =
  let open Data_encoding in
  conv
    (fun {time; data} -> (time, data))
    (fun (time, data) -> {time; data})
    (tup2 encoding arg_encoding)

let make_timed data = {
  data ; time = now () ;
}

let pp_hum ppf t = Format.pp_print_string ppf (to_notation t)