(*
    Title:      Standard Basis Library: Date Signature and structure.
    Author:     David Matthews
    Copyright   David Matthews 2000

	This library is free software; you can redistribute it and/or
	modify it under the terms of the GNU Lesser General Public
	License as published by the Free Software Foundation; either
	version 2.1 of the License, or (at your option) any later version.
	
	This library 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
	Lesser General Public License for more details.
	
	You should have received a copy of the GNU Lesser General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

(* G&R 2004 status: Signature checked.  No change.  Probably needs the structure checking to
   see whether the implementation is correct. *)

signature DATE =
sig
     datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
     datatype month = Jan | Feb | Mar | Apr | May | Jun | 
	 				  Jul | Aug | Sep | Oct | Nov | Dec
     type date
     exception Date
     val date : {
                    year : int,
                    month : month,
                    day : int,
                    hour : int,
                    minute : int,
                    second : int,
                    offset : Time.time option
                  } -> date
     val year    : date -> int
     val month   : date -> month
     val day     : date -> int
     val hour    : date -> int
     val minute  : date -> int
     val second  : date -> int
     val weekDay : date -> weekday
     val yearDay : date -> int
     val offset  : date -> Time.time option
     val isDst   : date -> bool option

     val localOffset : unit -> Time.time

     val fromTimeLocal : Time.time -> date
     val fromTimeUniv  : Time.time -> date

     val toTime : date -> Time.time

     val toString : date -> string
     val fmt      : string -> date -> string

     val fromString : string -> date option
     val scan       : (char, 'a) StringCvt.reader
                        -> 'a -> (date * 'a) option

     val compare : date * date -> General.order

end;

structure Date :> DATE =
struct
	(* There seems to be an assumption, particularly in the "compare"
	   function, that Date.date values are records of year, month, day
	   etc. *)
	type date = {
		year: int, (* Signed year. *)
		month: int, (* Month as 0..11 *)
		day: int, (* Day as 1..(28, 29, 30, 31) *)
		hour: int, (* Hour as 0..23 *)
		minute: int, (* Minute as 0..59 *)
		second: int, (* Second as 0..59 (maybe 60 or 61 if leap) *)
		offset: Time.time option (* Offset as Time.time -24hrs<t<24hrs *)
		}

	datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
	datatype month = Jan | Feb | Mar | Apr | May | Jun | 
	 				 Jul | Aug | Sep | Oct | Nov | Dec

	exception Date

	val secsPerHour = 60*60
	val secsPerDay = 24*secsPerHour
	val monthVec =
		Vector.fromList [Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec];
	val dayOfWkVec =
		Vector.fromList [Sun, Mon, Tue, Wed, Thu, Fri, Sat]

	(* Vector of days from the beginning of the year. *)
	val dayVec =
		Vector.fromList [~1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 365];
	val dayInLeapYearVec =
		Vector.fromList [~1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 366];

	(* Days of the week and months in abbreviated English form. *)
	val dayNames =
		Vector.fromList ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
	val monthNames =
		Vector.fromList ["Jan", "Feb", "Mar", "Apr", "May", "Jun",
						 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];

	(* Convert a month number to the enumerated type. *)
	fun monthNoToMonth n =
		Vector.sub(monthVec, n) handle _ => raise Date (* Should never happen *)

	fun isLeapYear l =
		if l mod 100 = 0 then (l div 100) mod 4 = 0 else l mod 4 = 0

	(* Convert the enumerated type to a month number. *)
	fun monthToMonthNo Jan =  0
	 |  monthToMonthNo Feb =  1
	 |  monthToMonthNo Mar =  2
	 |  monthToMonthNo Apr =  3
	 |  monthToMonthNo May =  4
	 |  monthToMonthNo Jun =  5
	 |  monthToMonthNo Jul =  6
	 |  monthToMonthNo Aug =  7
	 |  monthToMonthNo Sep =  8
	 |  monthToMonthNo Oct =  9
	 |  monthToMonthNo Nov = 10
	 |  monthToMonthNo Dec = 11

	open RuntimeCalls

	fun callTiming (code: int) args =
		RunCall.run_call2 RuntimeCalls.POLY_SYS_timing_dispatch (code,args);
	
	(* Get the local time offset which applied at the specific time.
	   The time is in seconds since the epoch. The result may be the
	   current time offset if it is outside the range for which we have
	   information.  We use seconds as the argument and result here because
	   it avoids having to multiply and divide arbitrary precision values
	   in the RTS.  May raise Size if the value is too large (or small).  In
	   that case we use the current time offset. *)
	fun localOffsetApplying (t: int) : int =
		callTiming 4 t 
			handle General.Size => callTiming 4 (Time.toSeconds(Time.now()))

	(* Get the current local time offset. *)
	fun localOffset (): Time.time =
		Time.fromSeconds(localOffsetApplying(Time.toSeconds(Time.now())))

	local
		(* Time values are since 1st January of this year. *)
		val baseYear: int = callTiming 2 0
		val yearOffset: int = callTiming 3 0 (* The offset of zeroTime within that year. *)

		(* Get the day in the year.  Either of day or year may be unnormalised
		   but that shouldn't affect the result (except if year is negative???) *)
		fun dayInYear (day, month, year) = 
			if isLeapYear year then Vector.sub(dayInLeapYearVec, month) + day
			else Vector.sub(dayVec, month) + day

		(* Compute the number of days since the start. *)
		fun yearToDays y =
		let
			fun ytod dys yr =
				if yr = baseYear then dys
				(* If the year is before the base year we subtract the number of
				   days in this year and recurse. *)
				else if yr < baseYear
				then if isLeapYear yr then ytod (dys-366) (yr+1)
					else ytod (dys-365) (yr+1)
				(* The year we want is after the base year. *)
				else if yr - baseYear >= 100
				(* If it is more than a century apart then we can add in the
				   number of days in a century.  There are 24 leap years in most
				   centuries except those which are divisible by 400.
				   Note: We're assuming the Gregorian calendar. *)
				then if ((yr-1) div 100) mod 4 = 0 then ytod (dys+36525) (yr-100)
						else ytod (dys+36524) (yr-100)
				else if isLeapYear(yr-1) then ytod (dys+366) (yr-1)
				else ytod (dys+365) (yr-1)
		in
			ytod 0 y
		end

		(* Convert days to number of years plus the day within the year. *)
		fun daysToYears d =
		let
			fun dtoy dys yr =
				if dys < 0
				then (* Before the base year: have to add in days. *)
					if isLeapYear (yr-1) then dtoy (dys+366) (yr-1)
					else dtoy (dys+365) (yr-1)
				(* If we are at least a century away we can subtract the century. *)
				else if dys >= 36525
				then if ((yr+99) div 100) mod 4 = 0 then dtoy (dys-36525) (yr+100)
					else dtoy (dys-36524) (yr+100)
				else if isLeapYear yr
				then if dys >= 366 then dtoy (dys-366) (yr+1) else (yr, dys)
				else if dys >= 365 then dtoy (dys-365) (yr+1) else (yr, dys)
		in
			dtoy d baseYear
		end
	
		(* Convert a number of seconds to a date. *)
		fun fromSeconds t (tzOffset: Time.time option) : date =
		let
			val tsecs = t - yearOffset
			val secs = tsecs mod 60
			val mins = (tsecs div 60) mod 60
			val hrs  = (tsecs div secsPerHour) mod 24
			(* Get the day and year.  The day is a value between 0 and 364/365. *)
			val (year, days) = daysToYears (tsecs div secsPerDay)
			(* Convert the day into a month+day *)
			val isLeap = isLeapYear year
			fun dayToMonth dy mth =
				if dy <= Vector.sub(if isLeap then dayInLeapYearVec else dayVec, mth+1)
				then mth
				else dayToMonth dy (mth+1)
	
			val month = dayToMonth days 0
			val dayInMonth =
				days - Vector.sub(if isLeap then dayInLeapYearVec else dayVec, month)
		in
			{year=year, month=month, day=dayInMonth, hour=hrs, minute=mins,
			 second=secs, offset = tzOffset }
		end
	in
		(* Get the day in the year. *)
		fun yearDay({day, month, year, ...}:date) = dayInYear(day, month, year)

		(* Convert the date into a UTC time value. *)
		fun toTime (date as {year, month, day, hour, minute, second, offset}) =
		let
			(* Compute the seconds. *)
			val secs =
				second + minute*60 + hour*secsPerHour + 
					(yearDay date + yearToDays year)*secsPerDay +
				    yearOffset;
		in
			case offset of
				SOME t => Time.+(t, Time.fromSeconds secs)
			  | NONE =>
			  		Time.fromSeconds(secs + localOffsetApplying secs)
		end

		(* Convert a UTC time to a UTC date. *)
		fun fromTimeUniv t = fromSeconds (Time.toSeconds t) (SOME Time.zeroTime)

		(* Convert a UTC time to a date in the local time zone. *)
		fun fromTimeLocal t =
		let
			val secs = Time.toSeconds t
			val localOffset = localOffsetApplying secs
		in
			fromSeconds (secs-localOffset) NONE
		end
			
		(* Generate a normalised date. *)
		fun date {year, month, day, hour, minute, second, offset} =
		let
			(* Get the time zone information if it is provided.  If it is
			   outside +/- 24 hours we get the number of full days. *)
			val (tzDays, normTz) =
				case offset of
					SOME tz =>
						let
							val excess = Int.quot(Time.toSeconds tz, secsPerDay)*secsPerDay;
						in
							(excess, SOME(tz-Time.fromSeconds excess))
						end
				  | NONE => (0, NONE)
			(* Convert it to the number of seconds since the epoch which will
			   normalise it. *)
			val secs =
				second + minute*60 + hour*secsPerHour + 
					(dayInYear(day, monthToMonthNo month, year) + yearToDays year)*secsPerDay +
				    yearOffset + tzDays;
		in
			(* Convert it into a date. *)
			fromSeconds secs normTz
		end
			
	end

	val year: date->int = #year
	and day: date->int = #day
	and hour: date->int = #hour
	and minute: date->int = #minute
	and second: date->int = #second
	and offset: date->Time.time option = #offset

	(* Return the month from the enumerated type. *)
	fun month({month, ...}:date) = monthNoToMonth month

	(* Get the day of the week as a number - not exported. *)
	fun dayOfWeek({year, month, day, ...}: date) =
	let
		(* From looking at the code of mktime, which is marked as being in
		   the public domain, this formula (Zeller's Congruence?) is used to
		   find the day of the week for the first of any month.
		   I don't know what range this works for but it seems accurate as
		   far as I can test it. *)
		val m0 = month+1 (* Count months from 1 *)
		val m1 = (m0 + 9) mod 12 + 1
		val yy0 = if m0 <= 2 then year-1 else year
		val yy1 = yy0 div 100
		val yy2 = yy0 mod 100
		val dow = ((26*m1 - 2) div 10 + 1 + yy2 + yy2 div 4 + yy1 div 4 - 2*yy1) mod 7
	in
		(* Add on the day within the month. *)
		(dow + day - 1) mod 7
	end

	(* Get day of week as an enumerated type - exported. *)
	fun weekDay date = Vector.sub(dayOfWkVec, dayOfWeek date)

	(* QUESTION: The definition of isDst is very vague. I am assuming that it
	   means that, for a local time, did/will Summer Time apply at that time?  *)
	fun isDst (d as {offset=NONE, ...} : date): bool option =
		let
			val isSummer =
				callTiming 5 (Time.toSeconds(toTime d)) handle Size => ~1
		in
			if isSummer < 0 then NONE
			else SOME (isSummer > 0)
		end
	  | isDst {offset=SOME _, ...} = SOME false (* ?? *)

	(* Compare the dates ignoring time zone information. *)
	fun compare({year=y1, month=m1, day=d1, hour=h1, minute=n1, second=s1, ...}:date,
				{year=y2, month=m2, day=d2, hour=h2, minute=n2, second=s2, ...}:date) =
		if y1 < y2 then General.LESS
		else if y1 > y2 then General.GREATER
		else if m1 < m2 then General.LESS
		else if m1 > m2 then General.GREATER
		else if d1 < d2 then General.LESS
		else if d1 > d2 then General.GREATER
		else if h1 < h2 then General.LESS
		else if h1 > h2 then General.GREATER
		else if n1 < n2 then General.LESS
		else if n1 > n2 then General.GREATER
		else Int.compare(s1, s2)

	(* Parse a date/time. *)
	fun scan getc str =
	let
		(* Try to extract an n-character string. *)
		fun getChars n str =
		let
			fun getN 0 s str = SOME (String.implode(List.rev s), str)
			 |  getN n s str =
			 	case getc str of
					NONE => NONE
				|   SOME(ch, str') => getN (n-1) (ch :: s) str'
		in
			getN n [] str
		end

		(* Get the day of the week.  We don't actually use it but we
		   need to verify it. *)
		(* QUESTION: What time offset should be used?  I presume NONE. *)
		fun parseDayOfWeek str =
		case getChars 3 str of
			NONE => NONE
		|	SOME(s, str') =>
				if Vector.foldr (fn(s', t) => t orelse s=s') false dayNames
				then SOME(s, str') else NONE
		
		fun parseMonth str =
		case getChars 3 str of
			NONE => NONE
		|	SOME(s, str') =>
				(* Return the month corresponding to the month name
				   otherwise NONE. *)
				Vector.foldri (fn(n:int, s':string, t) =>
					if s = s' then SOME(Vector.sub(monthVec, n), str') else t) NONE
					monthNames

		(* Get a two digit number. *)
		fun parse2Digits str =
		case getc str of
			NONE => NONE
		|	SOME(ch0, str1) =>
			if ch0 < #"0" orelse ch0 > #"9" then NONE
			else case getc str1 of
				NONE => NONE
			|	SOME(ch1, str2) =>
				if ch1 < #"0" orelse ch1 > #"9" then NONE
				else SOME((Char.ord ch0 - Char.ord #"0")*10 +
						  (Char.ord ch1 - Char.ord #"0"), str2)

		(* Get two digits as a day of the month.  Don't check the range. *)
		val parseDayOfMonth = parse2Digits

		(* A time is written as hh:mm:ss *)
		fun parseTime str =
		case parse2Digits str of
			NONE => NONE
		|	SOME(hh, str1) =>
			case getc str1 of
				NONE => NONE
			|	SOME(ch, str2) =>
				if ch <> #":" then NONE
				else case parse2Digits str2 of
					NONE => NONE
				|	SOME(mm, str3) =>
					case getc str3 of
						NONE => NONE
					|	SOME(ch, str4) =>
						if ch <> #":" then NONE
						else case parse2Digits str4 of
							NONE => NONE
						|	SOME(ss, str5) =>
								SOME((hh, mm, ss), str5)

		(* A year is represented as four digits. *)
		fun parseYear str =
		case parse2Digits str of
			NONE => NONE
		|	SOME(yy0, str1) =>
			case parse2Digits str1 of
				NONE => NONE
			|	SOME(yy1, str2) => SOME(yy0*100+yy1, str2)


		fun parseDate str =
		case parseDayOfWeek str of
			NONE => NONE
		|	SOME(_, str1) =>
			case getc str1 of (* Get exactly one space. *)
				NONE => NONE
			|	SOME(ch, str2) =>
				if ch <> #" " then NONE
				else case parseMonth str2 of (* Name of month. *)
					NONE => NONE
				|	SOME(mth, str3) =>
					case getc str3 of (* Get exactly one space. *)
						NONE => NONE
					|	SOME(ch, str4) =>
						if ch <> #" " then NONE
						else case parseDayOfMonth str4 of
							NONE => NONE
						|	SOME(day, str5) =>
							case getc str5 of (* Get exactly one space. *)
								NONE => NONE
							|	SOME(ch, str6) =>
								if ch <> #" " then NONE
								else case parseTime str6 of
									NONE => NONE
								|	SOME((hr,min,sec), str7) =>					
									case getc str7 of (* Get exactly one space. *)
										NONE => NONE
									|	SOME(ch, str8) =>
										if ch <> #" " then NONE
										else case parseYear str8 of
											NONE => NONE
										|	SOME(year, str9) =>
											SOME(date{year=year, month=mth, day=day,
												      hour=hr, minute=min, second=sec,
													  offset=NONE}, str9)				
	in
		case getc str of
			NONE => NONE
		|	SOME (ch, str') =>
				(* Remove initial white space. *)
				if Char.isSpace ch then scan getc str'
				else parseDate str
	end

	val fromString = StringCvt.scanString scan

	(* toString generates an English language, American style date. *)
	fun toString (date as {year, month, day, hour, minute, second, ...}: date) =
	let
		(* Pad a number with zeros up to the required width. Doesn't
		   work for negatives which ought to be padded after the
		   minus sign, but that's only a problem for years. *)
		fun int2str n i =
		let
			val str = Int.toString i
			fun padZeros n = if n <= 0 then "" else "0" ^  padZeros (n-1)
		in
			padZeros (n-String.size str) ^ str
		end
	in
		String.concat[
			Vector.sub(dayNames, dayOfWeek date), " ",
			Vector.sub(monthNames, month), " ",
			int2str 2 day, " ",
			int2str 2 hour, ":", int2str 2 minute, ":", int2str 2 second, " ",
			int2str 4 year]
	end

	fun fmt s (date as {year, month, day, hour, minute, second, offset}) =
	let
		(* Edit the string to remove any undefined escape combinations.
		   They shouldn't normally occur. *)
		fun editString s i l =
			if i = l then s (* Done *)
			else if String.sub(s, i) <> #"%"
			then editString s (i+1) l
			else (* Found a % sign. *)
				if i = l-1
			then (* This was the last character.  QUESTION: This isn't defined
					assume we should remove it. *)
				String.substring(s, 0, i)
			else
			let
				val c = String.sub(s, i+1)
			in
				if Char.contains "aAbBcdHIjmMpSUwWxXyYZ%" c
				then (* OK *) editString s (i+2) l
				else (* Replace %c by c, i.e. remove the %. *)
					editString (String.substring(s, 0, i) ^ 
							        String.substring(s, i+1, l-i-1))
						i (l-1)
			end
		val newFormat = editString s 0 (String.size s)
		val summer =
			case offset of
				SOME _ => ~1
			|	NONE => callTiming 5 (Time.toSeconds(toTime date))
							handle Size => ~1
	in
		callTiming 6 (newFormat, year, month, day, hour, minute, second,
			dayOfWeek date, yearDay date, summer)
			handle _ => raise Date
	end
end;

local
	(* Install the pretty printer for Date.date.  This has to be
	   done outside the structure because of the opaque matching. *)
	fun pretty(p, _, _, _) _ _ x = p(Date.toString x)
in
	val () = PolyML.install_pp pretty
end