Show/Hide Toolbars

Waysys on the Web

(*

 

Class:          WayDate

Package:        com.waysysweb.util

Author:         W. Shaffer

Date:           28-Nov-1997

Description:

        This structure provides specifications for algorithms for manipulating

        dates.

 

Maintenance:

 

Date        Author    Description

----------- ------    ----------------------------------------------------------------

28-Nov-1997 Shaffer   File created

23-Feb-1998 Shaffer   Day Positions added to support time zones

12-Mar-1998 Shaffer   Day Position functions added to support daylight savings time

30-Jan-2000 Shaffer   Adjustment to accommodate Version 1.44 of Moscow ML

31-May-2003 Shaffer   Addition of age and currentAge functions

01-Aug-2005 Shaffer   Addition of daysInPolicyYear for insurance applications

04-Apr-2006 Shaffer   Added minDate function

05-Apr-2006 Shaffer   Added anniversary methods

11-Nov-2006 Shaffer   Moved holiday functions to separate structure

07-Jan-2007 Shaffer   Moved insurance date manipulations to separate structure

 

*)

 

structure WAYDATE = struct

 

    (*============  Exceptions ==============================================*)

 

    exception DateError;

 

    (*============  Types      ==============================================*)

 

    type Month     = int;

    type Day       = int;

    type Year      = int;

    type DayOfYear = int;

 

    (* Days of the Week *)

    datatype DayOfWeek = Sunday | Monday | Tuesday | Wednesday | Thursday |

                 Friday | Saturday;

 

    (*============  Constants  ==============================================*)

 

    (* Maximum allowed year *)

    val MaxYear : Year = 3999;

 

    (* Minimum allowed year *)

    val MinYear : Year = 1601;

 

    (* Convert Day of Week to int *)

    fun numDayOfWeek(Sunday)    : int = 0

      | numDayOfWeek(Monday)    : int = 1

      | numDayOfWeek(Tuesday)   : int = 2

      | numDayOfWeek(Wednesday) : int = 3

      | numDayOfWeek(Thursday)  : int = 4

      | numDayOfWeek(Friday)    : int = 5

      | numDayOfWeek(Saturday)  : int = 6;

 

    (* Convert int to Day of Week *)

    fun dayOfWeekEnum(0) = Sunday

      | dayOfWeekEnum(1) = Monday

      | dayOfWeekEnum(2) = Tuesday

      | dayOfWeekEnum(3) = Wednesday

      | dayOfWeekEnum(4) = Thursday

      | dayOfWeekEnum(5) = Friday

      | dayOfWeekEnum(6) = Saturday

      | dayOfWeekEnum(_) = raise DateError;

 

    (* Days of the month: non-leap year *)

    fun daysNonLeapYear(1) = 31 (* January  *)

      | daysNonLeapYear(2) = 28 (* February *)

      | daysNonLeapYear(3) = 31 (* March    *)

      | daysNonLeapYear(4) = 30 (* April    *)

      | daysNonLeapYear(5) = 31 (* May      *)

      | daysNonLeapYear(6) = 30 (* June     *)

      | daysNonLeapYear(7) = 31 (* July     *)

      | daysNonLeapYear(8) = 31 (* August   *)

      | daysNonLeapYear(9) = 30 (* September*)

      | daysNonLeapYear(10)= 31 (* October  *)

      | daysNonLeapYear(11)= 30 (* November *)

      | daysNonLeapYear(12)= 31 (* December *)

      | daysNonLeapYear(_) = raise DateError;

 

    (* Days of the month: leap year         *)

    fun daysLeapYear(1) = 31 (* January  *)

      | daysLeapYear(2) = 29 (* February *)

      | daysLeapYear(3) = 31 (* March    *)

      | daysLeapYear(4) = 30 (* April    *)

      | daysLeapYear(5) = 31 (* May      *)

      | daysLeapYear(6) = 30 (* June     *)

      | daysLeapYear(7) = 31 (* July     *)

      | daysLeapYear(8) = 31 (* August   *)

      | daysLeapYear(9) = 30 (* September*)

      | daysLeapYear(10)= 31 (* October  *)

      | daysLeapYear(11)= 30 (* November *)

      | daysLeapYear(12)= 31 (* December *)

      | daysLeapYear(_) = raise DateError;

 

    (* The abbreviations of months          *)

    fun mnthAbbrev(1)     = "Jan"

      | mnthAbbrev(2)     = "Feb"

      | mnthAbbrev(3)     = "Mar"

      | mnthAbbrev(4)     = "Apr"

      | mnthAbbrev(5)     = "May"

      | mnthAbbrev(6)     = "Jun"

      | mnthAbbrev(7)     = "Jul"

      | mnthAbbrev(8)     = "Aug"

      | mnthAbbrev(9)     = "Sep"

      | mnthAbbrev(10)    = "Oct"

      | mnthAbbrev(11)    = "Nov"

      | mnthAbbrev(12)    = "Dec"

      | mnthAbbrev(_)     = raise DateError;

 

    (* Is leap year *)

    fun isLeapYear(yr : Year) : bool =

        if ( (yr mod 400) = 0) orelse (( (yr mod 4) = 0) andalso ((yr mod 100) <> 0))

        then true

        else false;

 

    (* Days in year *)

    fun daysInYear(yr : Year) : DayOfYear =

        if   isLeapYear(yr)

        then 366

        else 365;

 

    val MaxDate = (12, 31, MaxYear);

    

    val MinDate = (01, 01, MinYear);

 

 

    (*============  Properties ==============================================*)

 

    (* Valid month *)

    fun isMonth(mnth : Month) : bool =

        if   (mnth > 0) andalso (mnth <= 12)

        then true

        else false;

 

    (* Valid year  *)

    fun isYear(yr : Year) : bool =

        if   (yr >= MinYear) andalso (yr <= MaxYear)

        then true

        else false;

 

    (* Days in month *)

    fun daysInMonth(mnth : Month, yr : Year) : Day =

        if isLeapYear(yr)

        then daysLeapYear(mnth)

        else daysNonLeapYear(mnth);

 

    (* Is valid day *)

    fun isValidDay(mnth : Month, dy : Day, yr : Year) : bool =

        if (dy > 0) andalso (dy <= daysInMonth(mnth, yr))

        then true

        else false;

 

    (* Valid date  *)

    fun isValidDate(mnth : Month, dy : Day, yr : Year) : bool =

        if   isMonth(mnth) andalso isYear(yr) andalso isValidDay(mnth, dy, yr)

        then true

        else false;

 

    (* Is day of year *)

    fun isDayOfYear(dayOfYear : DayOfYear, yr : Year) : bool =

        if   (dayOfYear > 0) andalso (dayOfYear <= daysInYear(yr))

        then true

        else false;

 

    (*============  Attributes  ==============================================*)

 

    type WayDate = Month * Day * Year;

 

    (*============  Invariant   ==============================================*)

 

    fun inv_WayDate(mn : Month, dy : Day, yr : Year) : bool =

        isValidDate(mn, dy, yr);

 

    (*============  Initialization ===========================================*)

 

    (* Create a date *)

    (* Precondition:  (none)                                                  *)

    fun create(mnth : Month, dy : Day, yr : Year) : WayDate =

        if   isValidDate(mnth, dy, yr)

        then (mnth, dy, yr)

        else raise DateError;

 

    (* Return today's date *)

    fun today() : WayDate =

        let

            val  aDate =

                Date.fromTimeLocal(TIME.now());

 

            fun fromMonth(DATE.Jan) = 1

            |   fromMonth(DATE.Feb) = 2

            |   fromMonth(DATE.Mar) = 3

            |   fromMonth(DATE.Apr) = 4

            |   fromMonth(DATE.May) = 5

            |   fromMonth(DATE.Jun) = 6

            |   fromMonth(DATE.Jul) = 7

            |   fromMonth(DATE.Aug) = 8

            |   fromMonth(DATE.Sep) = 9

            |   fromMonth(DATE.Oct) = 10

            |   fromMonth(DATE.Nov) = 11

            |   fromMonth(DATE.Dec) = 12;

        in

            create(fromMonth(Date.month aDate), Date.day aDate, Date.year aDate)

        end;

 

    (*============  Operations  ==============================================*)

 

    (* Obtain attributes *)

 

    fun getDay(_, dy, _)              : Day   = dy;      (* day part of date *)

    fun getMonth(mnth, _, _)          : Month = mnth;    (* month part of date*)

    fun getYear(_, _, yr)             : Year  = yr;      (* year part of date *)

 

    (* Sum the days of the month *)

    fun sumDaysOfMonth(           1, yr : Year) : int = daysInMonth(1, yr)

 

      | sumDaysOfMonth(mnth : Month, yr : Year) : int =

        daysInMonth(mnth, yr) + sumDaysOfMonth(mnth-1, yr);

 

    (* Day of year *)

    fun dayOfYear(           1, dy : Day, _        ) : DayOfYear =

        dy

 

      | dayOfYear(mnth : Month, dy : Day, yr : Year) : DayOfYear =

        sumDaysOfMonth(mnth - 1, yr) + dy;

 

    (* Days in prior years *)

    fun daysInPriorYears(1601)      : int = 0

 

      | daysInPriorYears(yr : Year) : int =

        daysInYear(yr - 1) + daysInPriorYears(yr - 1);

 

    (* Add one day to the date *)

    fun increment(12, 31,      3999)                       : WayDate =

        raise DateError

 

      | increment(12, 31, yr : Year)                       : WayDate =

        (1, 1, yr + 1)

 

      | increment(mnth : Month, dy : Day, yr : Year)       : WayDate =

        if   dy = daysInMonth(mnth, yr)

        then (mnth + 1,      1, yr)

        else (mnth    , dy + 1, yr);

 

    (* Subtract one day from the date *)

    fun decrement(1, 1, 1601)                              : WayDate =

        raise DateError

 

      | decrement(1, 1, yr : Month)                        : WayDate =

        (12, 31,  yr - 1)

 

      | decrement(mnth : Month, 1, yr : Year)              : WayDate =

        (mnth - 1, daysInMonth(mnth - 1, yr), yr)

 

      | decrement(mnth : Month, dy : Day, yr : Year)       : WayDate =

        (mnth, dy - 1, yr);

 

    (* Add a number of days to a date *)

    fun add(date1 : WayDate, value : int) : WayDate =

        if   value = 0

        then date1

        else

             if   value < 0

             then add(decrement(date1), value + 1)

             else add(increment(date1), value - 1);

 

    (* Convert Julian to Gregorian Date *)

    fun convertGregorian(dayInYear : DayOfYear, yr : Year) : WayDate =

        if   isDayOfYear(dayInYear, yr)

        then add(create(1, 1, yr), dayInYear - 1)

        else raise DateError;

 

    (* Compare *)

    fun compare(date1 : WayDate, date2 : WayDate) : order =

            let

                val yr1   = getYear(date1)

                val yr2   = getYear(date2)

                val mnth1 = getMonth(date1)

                val mnth2 = getMonth(date2)

                val dy1   = getDay(date1)

                val dy2   = getDay(date2)

            in

                if yr1 < yr2                                              then LESS

                else if yr1 = yr2 andalso mnth1 < mnth2                   then LESS

                else if yr1 = yr2 andalso mnth1 = mnth2 andalso dy1 < dy2 then LESS

                else if yr1 = yr2 andalso mnth1 = mnth2 andalso dy1 = dy2 then EQUAL

                else                                                           GREATER

            end;

 

    (* isEqual - are two dates equal *)

    fun isEqual(date1 : WayDate, date2 : WayDate) : bool =

        if (compare(date1, date2) = EQUAL) then true

        else                                    false;

 

    (* Return the earliest of two dates                                      *)

    fun minDate(date1 : WayDate, date2 : WayDate) : WayDate =

        case compare(date1, date2) of

            LESS    => date1

        |   EQUAL   => date1

        |   GREATER => date2;

 

    (* Return the later of two dates                                         *)

    fun maxDate(date1 : WayDate, date2 : WayDate) : WayDate =

        case compare(date1, date2) of

            LESS    => date2

        |   EQUAL   => date2

        |   GREATER => date1;

 

 

    (* is in period *)

    fun isInPeriod(begin_date : WayDate, end_date : WayDate, date1 : WayDate) : bool =

        let

            val bgn_cmp = compare(begin_date, date1);

            val end_cmp = compare(end_date  , date1);

        in

            if      bgn_cmp = GREATER  then false

            else if end_cmp = LESS     then false

            else                            true

        end;

 

    (* Date Difference: date1 - date2 *)

    fun difference(date1 : WayDate, date2 : WayDate)  : int =

        case compare(date1, date2) of

             EQUAL       => 0

           | LESS        => difference(increment(date1), date2) - 1

           | GREATER     => difference(decrement(date1), date2) + 1;

 

    (* Day of week *)

    (* This specification is based on 1-1-1601 being a Monday (1) *)

    (* Precondition: isValidDate(getMonth(date1), getDay(date1), getYear(date1)) *)

    fun dayOfWeek(date1 : WayDate) : DayOfWeek =

        dayOfWeekEnum((difference(date1, (1, 1, MinYear)) + 1) mod 7);

 

    (* Convert a date to a string *)

    fun toString(mnth : Month, dy : Day, yr : Year) : string =

        makestring(dy) ^ "-" ^ mnthAbbrev(mnth) ^  "-" ^ makestring(yr);

 

 

end (* WAYDATE *)