(* * <COPYRIGHT> * Copyright 2003 Gerd Stolpmann * * <GPL> * This file is part of WTimer. * * WTimer is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * WTimer 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with WDialog; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * </> *) (* $Id: db_types.ml 23 2015-01-14 16:24:21Z gerd $ * ---------------------------------------------------------------------- * *) (* The Scanf calls assume O'Caml 3.07 now! *) module Types = struct type date = { year : int; (* 4 digits *) month : int; (* 1-12 *) mday : int; (* 1-31 *) } type date_rec = date = { year : int; (* 4 digits *) month : int; (* 1-12 *) mday : int; (* 1-31 *) } type time = { hour : int; (* 0-23 *) minute : int; (* 0-59 *) } type time_rec = time = { hour : int; (* 0-23 *) minute : int; (* 0-59 *) } type interval = { delta_hours : int; delta_minutes : int; (* 0-59 *) } type interval_rec = interval = { delta_hours : int; delta_minutes : int; (* 0-59 *) } exception Bad_date exception Bad_time exception Bad_interval end module Date = struct open Types let days_of_month d = let is_leapyear = (d.year mod 400 = 0) || (d.year mod 4 = 0 && d.year mod 100 <> 0) in match d.month with ( 1 | 3 | 5 | 7 | 8 | 10 | 12 ) -> 31 | ( 4 | 6 | 9 | 11 ) -> 30 | 2 -> if is_leapyear then 29 else 28 | _ -> assert false let create d = (* Check plausibility: *) if d.year < 0 || d.month < 1 || d.month > 12 then raise Bad_date; let days = days_of_month d in if d.mday < 1 || d.mday > days then raise Bad_date; d let access d = d let to_string d = Printf.sprintf "%04d-%02d-%02d" d.year d.month d.mday let from_string s = try let (yr, mn, md) = Scanf.sscanf s "%4u-%2u-%2u%!" (fun yr mn md -> (yr,mn,md)) in create { year = yr; month = mn; mday = md } with Scanf.Scan_failure msg -> failwith ("Db.Date.from_string: Scan failure: " ^ msg) | Failure msg -> failwith ("Db.Date.from_string: " ^ msg) | End_of_file -> failwith ("Db.Date.from_string: too few characters") let cmp d1 d2 = if d1.year <> d2.year then d1.year - d2.year else if d1.month <> d2.month then d1.month - d2.month else d1.mday - d2.mday let as_netdate d = { Netdate.year = d.year; month = d.month; day = d.mday; hour = 0; minute = 0; second = 0; nanos = 0; zone = 0; week_day = (-1) } let week_day d = Netdate.week_day (as_netdate d) let iso8601_week_pair d = Netdate.iso8601_week_pair (as_netdate d) end module Time = struct open Types let create t = (* Check plausibility: *) if t.hour < 0 || t.hour > 23 || t.minute < 0 || t.minute > 59 then raise Bad_time; t let access t = t let to_string t = Printf.sprintf "%02d:%02d" t.hour t.minute let from_string s = (* Note: seconds are ignored *) try let (hr, mi) = Scanf.sscanf s "%2u:%2u%n" (fun hr mi n -> if n = String.length s then (hr,mi) else if s.[n] = ':' then (hr,mi) (* ignore rest after ':' *) else failwith ("too many characters: " ^ s) ) in create { hour = hr; minute = mi } with Scanf.Scan_failure msg -> failwith ("Db.Time.from_string: Scan failure: " ^ msg) | Failure msg -> failwith ("Db.Time.from_string: " ^ msg) | End_of_file -> failwith ("Db.Time.from_string: too few characters") let cmp t1 t2 = if t1.hour <> t2.hour then t1.hour - t2.hour else t1.minute - t2.minute end module Interval = struct open Types let create iv = (* Check plausibility: *) if abs iv.delta_minutes > 59 then raise Bad_interval; if iv.delta_hours < 0 && iv.delta_minutes >= 0 then raise Bad_interval; if iv.delta_hours >= 0 && iv.delta_minutes < 0 then raise Bad_interval; iv let access iv = iv let to_string iv = Printf.sprintf "%d:%02d" iv.delta_hours (abs iv.delta_minutes) let from_string s = (* Bug: intervals >= 1 day that use day notation cannot be processed: * e.g. "5 days 15:45", or "12 years 65 days 3:00". * Bug: "ago" for negative intervals is not recognized, e.g. * "08:15 ago" instead of "-08:15". *) try let (sign, hr, mi) = Scanf.sscanf s "%[-+]%u:%2u%n" (fun si hr mi n -> let sign = if si = "+" || si = "" then false else if si = "-" then true else failwith ("bad sign: " ^ s) in if n = String.length s then (sign,hr,mi) else if s.[n] = ':' then (sign,hr,mi) (* ignore rest after ':' *) else failwith ("too many characters: " ^ s) ) in let hr' = if sign then -hr else hr in let mi' = if sign then -mi else mi in create { delta_hours = hr'; delta_minutes = mi' } with Scanf.Scan_failure msg -> failwith ("Db.Interval.from_string: Scan failure: " ^ msg) | Failure msg -> failwith ("Db.Interval.from_string: " ^ msg) | End_of_file -> failwith ("Db.Interval.from_string: too few characters") let cmp iv1 iv2 = if iv1.delta_hours <> iv2.delta_hours then iv1.delta_hours - iv2.delta_hours else iv1.delta_minutes - iv2.delta_minutes let add iv1 iv2 = let sum = iv1.delta_minutes + 60 * iv1.delta_hours + iv2.delta_minutes + 60 * iv2.delta_hours in { delta_hours = sum / 60; delta_minutes = sum mod 60; } let neg iv = { delta_hours = -iv.delta_hours; delta_minutes = -iv.delta_minutes; } let move_by t iv = let mi = t.minute + iv.delta_minutes in let hr_carry = if mi < 0 then (-1) else if mi > 59 then 1 else 0 in { hour = (t.hour + iv.delta_hours + hr_carry) mod 24; minute = mi mod 60; } let delta t1 t2 = if Time.cmp t1 t2 >= 0 then begin (* t1 >= t2 *) let mi = t1.minute - t2.minute in let mi' = if mi >= 0 then mi else 60 + mi in let hr_carry = if mi >= 0 then 0 else -1 in { delta_hours = t1.hour - t2.hour + hr_carry; delta_minutes = mi'; } end else begin let mi = t2.minute - t1.minute in let mi' = if mi >= 0 then mi else 60 + mi in let hr_carry = if mi >= 0 then 0 else -1 in { delta_hours = -(t2.hour - t1.hour + hr_carry); delta_minutes = -mi'; } end let distance t1 t2 = let d = delta t1 t2 in let m_mod = d.delta_minutes mod 60 in let h_carry = if m_mod < 0 then -1 else 0 in let h_mod = (d.delta_hours + h_carry) mod 24 in { delta_hours = if h_mod < 0 then 24 + h_mod else h_mod; delta_minutes = if m_mod < 0 then 60 + m_mod else m_mod; } end