(*

Class:      Holiday
Package:    com.waysysweb.util
Author:     W. Shaffer
Date:       11-Nov-2006
Description:

    This structure handles holiday calculations.  
    See http://en.wikipedia.org/wiki/Federal_holidays#List_of_Holidays
    See also http://www.opm.gov/fedhol/2006.asp
    See also http://aa.usno.navy.mil/faq/docs/easter.html

Maintenance:

Date        Author  Description
----------- ------  -----------------------------------------------------------
11-Nov-2006 Shaffer File created

*)

structure HOLIDAY = struct

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



    (*============  Imports     =============================================*)
    
    (* Date imports                                                          *)

    type WayDate   = WAYDATE.WayDate;
    type Month     = WAYDATE.Month;
    type Day       = WAYDATE.Day;
    type Year      = WAYDATE.Year;
    type DayOfYear = WAYDATE.DayOfYear;
    type DayOfWeek = WAYDATE.DayOfWeek;
    
    fun add(date1 : WayDate, value : int) : WayDate =
        WAYDATE.add(date1, value);
    fun numDayOfWeek(dayOfWeek : DayOfWeek) : int = 
        WAYDATE.numDayOfWeek(dayOfWeek);
    fun dayOfWeek(date1 : WayDate) : DayOfWeek =
        WAYDATE.dayOfWeek(date1);
    fun daysInMonth(mnth : Month, yr : Year) : Day =
        WAYDATE.daysInMonth(mnth, yr);
        
    (* Date set                                                              *)
    
    type DateSet = DATERANGE.DateSet;
    fun max(set : DateSet, pred : WayDate -> bool) : WayDate =
        DATERANGE.max(set, pred);
    fun range(fromDate : WayDate, thruDate : WayDate) : DateSet =
        DATERANGE.range(fromDate, thruDate);
        
    (*============  Types       =============================================*)

    (* Day Positions    *)
    datatype DayPosition = First | Second | Third | Fourth | Last;


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



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



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



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



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

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

    (*============  Operations  =============================================*)
    
    (* ------------ Date positioning functions ----------------------------- *)

    (* Day of week on or before *)
    fun dayOfWeekOnOrBefore(date : WayDate, dyOfWk : DayOfWeek) : WayDate =
        let
            val datePriorWeek = add(date, ~6);
            val dateRange = range(datePriorWeek, date);
            fun pred(adate : WayDate)  : bool = dayOfWeek(adate) = dyOfWk
        in
            max(dateRange, pred)
        end;

    (* Day of week on or after *)
    fun dayOfWeekAfter(date1 : WayDate, dyOfWk : DayOfWeek) : WayDate =
        dayOfWeekOnOrBefore(add(date1, 7), dyOfWk);

    (* Day of week after *)
    fun dayOfWeekBefore(date1 : WayDate, dyOfWk : DayOfWeek) : WayDate =
        dayOfWeekOnOrBefore(add(date1, ~1), dyOfWk);

    (* Nth Day from Date *)
    fun nthDayFromDate( First, dyOfWk : DayOfWeek, date1 : WayDate)  : WayDate =
            add(dayOfWeekBefore(date1, dyOfWk), 7)
    |   nthDayFromDate( Second, dyOfWk : DayOfWeek, date1 : WayDate) : WayDate =
            add(dayOfWeekBefore(date1, dyOfWk), 14)
    |   nthDayFromDate( Third, dyOfWk : DayOfWeek, date1 : WayDate)  : WayDate =
            add(dayOfWeekBefore(date1, dyOfWk), 21)
    |   nthDayFromDate( Fourth, dyOfWk : DayOfWeek, date1 : WayDate)  : WayDate =
            add(dayOfWeekBefore(date1, dyOfWk), 28)
    |   nthDayFromDate( Last,  dyOfWk : DayOfWeek, date1 : WayDate)  : WayDate =
            add(dayOfWeekAfter (date1, dyOfWk), ~7);

    (* Date from position *)
    fun dateFromPosition( mnth : Month, Last, dow : DayOfWeek, yr : Year) =
            nthDayFromDate(Last, dow, create(mnth, daysInMonth(mnth, yr), yr))
    |   dateFromPosition( mnth : Month, dy : DayPosition, dow : DayOfWeek, yr : Year)  =
            nthDayFromDate(dy, dow, create(mnth, 1, yr));   
            
    (* Observed holiday                                                      *)
    fun calcObservedHoliday(date : WayDate) : WayDate =
        case dayOfWeek(date) of
             WAYDATE.Saturday => WAYDATE.decrement(date)
       |     WAYDATE.Sunday   => WAYDATE.increment(date)
       |     _                => date;

    (* ------------ Supporting routines for Easter calculation ------------- *)

    (* century - determine the century from a year *)
    fun century(yr : Year) : int = (yr div 100) + 1;

    fun shiftedEpact(yr : Year) : int =
        let
            val cent = century(yr)
        in
           (14 + (11 * (yr mod 19)) - ((3 * cent) div 4) + ((5 + 8 * cent) div 25))
           mod 30
        end;

    fun adjustedEpact(yr : Year) : int =
        let
            val shifted = shiftedEpact(yr)
        in
            if shifted = 0 orelse ( (shifted = 1) andalso (10 < (yr mod 19)))
            then shifted + 1
            else shifted
        end;

    fun paschalMoon(yr : Year) : WayDate =
        let
            val paschal = adjustedEpact(yr)
        in
            add(create(4, 19, yr), ~ (paschal))
        end;

    (* ------------ US Federal Holidays ------------------------------------ *)

    (* New Year's Day *)
    fun NewYearsDay(yr : Year) : WayDate =
        create(1, 1, yr);
    
    (* Birthday of Martin Luther King, Jr. *)
    fun MartinLutherKingsBirthday(yr : Year) : WayDate =
        dateFromPosition(1, Third, WAYDATE.Monday, yr);
        
    (* Washington's Birthday *)
    fun WashingtonsBirthday(yr : Year) : WayDate =
        dateFromPosition(2, Third, WAYDATE.Monday, yr);
        
    (* Memorial Day *)
    fun MemorialDay(yr : Year) : WayDate =
        dateFromPosition(5, Last, WAYDATE.Monday, yr); 
        
    (* Independence Day *)
    fun IndependenceDay(yr : Year) : WayDate = 
        create(7, 4, yr); 
    
    (* Labor Day *) 
    fun LaborDay(yr : Year) : WayDate =
        dateFromPosition(9,First, WAYDATE.Monday, yr);
        
    (* Columbus Day *)
    fun ColumbusDay(yr : Year) : WayDate =
        dateFromPosition(10, Second, WAYDATE.Monday, yr);

    (* Veteran's Day *)
    fun VeteransDay(yr : Year) : WayDate =
        create(11, 11, yr);
        
    (* Thanksgiving *) 
    fun ThanksgivingDay(yr : Year) : WayDate = 
        dateFromPosition(11, Fourth, WAYDATE.Thursday, yr); 
    
    (* Christmas *) 
    fun Christmas(yr : Year) : WayDate =
        create(12, 25, yr); 

    (* ------------ Easter ------------------------------------------------- *)
    
    (* Easter *) 
    fun Easter(yr : Year) : WayDate =
        dayOfWeekAfter(paschalMoon(yr), WAYDATE.Sunday);
        
    
    
    
    
end (* HOLIDAY *)