+let require name f =
+ indent "require: %s\n" name;
+ incr depth;
+ let r = (try Either (f ()) with exn -> Or exn) in
+ decr depth;
+ match r with
+ | Either x -> x
+ | Or exn -> raise exn
+
+let _enter_goal name = indent "enter goal: %s\n" name
+let _leave_goal name = indent "leave goal: %s\n" name
+
+type period_t = Seconds | Days | Months | Years
+let seconds = (1, Seconds)
+let sec = seconds and secs = seconds and second = seconds
+let minutes = (60, Seconds)
+let min = minutes and mins = minutes and minute = minutes
+let hours = (3600, Seconds)
+let hour = hours
+let days = (1, Days)
+let day = days
+let weeks = (7, Days)
+let week = weeks
+let months = (1, Months)
+let month = months
+let years = (1, Years)
+let year = years
+
+let periodic_jobs = ref []
+
+(* Register a periodic job. *)
+let every ?name i (j, t) f =
+ let period = i*j, t in (* 5 minutes -> ((5 * 60), Seconds) *)
+ periodic_jobs := (period, (name, f)) :: !periodic_jobs
+
+(* [next_time t period] returns the earliest event of [period]
+ strictly after time [t].
+
+ Visualising periods as repeated events on a timeline, this
+ returns [t']:
+
+ {v
+ events: ---+---------+---------+---------+---------+---------+-----
+ times: t t'
+ }
+
+ Note that [period_t] events are not necessarily regular.
+ eg. The start of a month is not a fixed number of seconds
+ after the start of the previous month. 'Epoch' refers
+ to the Unix Epoch (ie. 1970-01-01 00:00:00 UTC).
+
+ If [period = i, Seconds i] then events are when
+ [t' mod i == 0] when t' is the number of seconds since
+ the Epoch. This returns the next t' > t.
+
+ If [period = i, Days] then events happen at
+ midnight UTC every [i] days since the Epoch.
+ This returns the next midnight > t.
+
+ If [period = i, Months] then events happen at
+ midnight UTC on the 1st day of the month every [i] months
+ since the Epoch. This returns midnight on the
+ 1st day of the next month > t.
+
+ If [period = i, Years] then events happen at
+ midnight UTC on the 1st day of the year when
+ [(y - 1970) mod i == 0]. This returns midnight on the
+ 1st day of the next year > t. *)
+
+let next_time =
+ (* Round up 'a' to the next multiple of 'i'. *)
+ let round_up_float a i =
+ let r = mod_float a i in
+ if r = 0. then a +. i else a +. (i -. r)
+ and round_up a i =
+ let r = a mod i in
+ if r = 0 then a + i else a + (i - r)
+ in
+
+ fun t -> function
+ | (i, Seconds) ->
+ let i = float_of_int i in
+ round_up_float t i
+
+ | (i, Years) ->
+ let tm = gmtime t in
+
+ (* Round 'tm' up to the first day of the next year. *)
+ let year = round_up tm.tm_year i in
+ let tm = { tm with tm_sec = 0; tm_min = 0; tm_hour = 0;
+ tm_mday = 1; tm_mon = 0; tm_year = year } in
+ fst (mktime tm)
+
+ | (i, Days) ->
+ let t = Date.from_unixfloat t in
+ let t0 = Date.make 1970 1 1 in
+
+ (* Number of whole days since Unix Epoch. *)
+ let nb_days = Date.Period.safe_nb_days (Date.sub t t0) in
+
+ let nb_days = round_up nb_days i in
+ let t' = Date.add t0 (Date.Period.day nb_days) in
+ Date.to_unixfloat t'
+
+ | (i, Months) ->
+ (* Calculate number of whole months since Unix Epoch. *)
+ let tm = gmtime t in
+ let months = 12 * (tm.tm_year - 70) + tm.tm_mon in
+
+ let months = round_up months i in
+ let t0 = Date.make 1970 1 1 in
+ let t' = Date.add t0 (Date.Period.month months) in
+ Date.to_unixfloat t'