comparison datebox.ur @ 5:4385bc6a0d2d

Some Datebox functions related to dates
author Adam Chlipala <adam@chlipala.net>
date Thu, 10 Feb 2011 12:39:20 -0500
parents 377c11586999
children bbdedfde154e
comparison
equal deleted inserted replaced
4:377c11586999 5:4385bc6a0d2d
8 style selday 8 style selday
9 9
10 datatype month = Prev | This | Next 10 datatype month = Prev | This | Next
11 11
12 type date = {Year : int, Month : int, Day : int} 12 type date = {Year : int, Month : int, Day : int}
13 val date_ord = mkOrd {Lt = fn {Year = y1, Month = m1, Day = d1} {Year = y2, Month = m2, Day = d2} =>
14 y1 < y2 || (y1 = y2 && m1 < m2) || (y1 = y2 && m1 = m2 && d1 < d2),
15 Le = fn {Year = y1, Month = m1, Day = d1} {Year = y2, Month = m2, Day = d2} =>
16 y1 < y2 || (y1 = y2 && m1 < m2) || (y1 = y2 && m1 = m2 && d1 <= d2)}
13 17
14 type t = {Month : source {ThisMonth : int, Year : int, 18 type t = {Month : source {ThisMonth : int, Year : int,
15 ThisMonthLength : int, PrevMonthLength : int, 19 ThisMonthLength : int, PrevMonthLength : int,
16 MondayMonth : month, MondayDay : int, 20 MondayMonth : month, MondayDay : int,
17 PrevMonthName : string, ThisMonthName : string, NextMonthName : string}, 21 PrevMonthName : string, ThisMonthName : string, NextMonthName : string},
28 else 32 else
29 pad' (len-1) ("0" ^ s) 33 pad' (len-1) ("0" ^ s)
30 in 34 in
31 pad' (len - String.length s) s 35 pad' (len - String.length s) s
32 end 36 end
37
38 fun time {Year = y, Month = m, Day = d} = readError (show y ^ "-" ^ pad 2 m ^ "-" ^ pad 2 d ^ " 00:00:00")
33 39
34 fun monthLen m = 40 fun monthLen m =
35 let 41 let
36 fun f n tm = 42 fun f n tm =
37 let 43 let