Fixes #2966

[factor.git] / extra / calendar / holidays / us / us.factor

diff --git a/extra/calendar/holidays/us/us.factor b/extra/calendar/holidays/us/us.factor
index a4fb19c5979204b93e63f466c3ece97651d6b261..308bb2b51cef76cc58a999a19883edee8743beba 100644 (file)
--- a/extra/calendar/holidays/us/us.factor
+++ b/extra/calendar/holidays/us/us.factor
@@ -1,64 +1,89 @@
 ! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs calendar calendar.holidays
-calendar.holidays.private combinators combinators.short-circuit
-fry kernel lexer math namespaces parser sequences shuffle
-vocabs words ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors calendar calendar.holidays
+calendar.holidays.private calendar.private combinators
+combinators.short-circuit kernel math sequences ;
 IN: calendar.holidays.us
 
-SINGLETONS: us us-federal ;
+SINGLETONS: us us-federal us-market ;
+
+HOLIDAY: new-years-day january 1 >>day ;
+HOLIDAY-NAME: new-years-day world "New Year's Day"
+HOLIDAY-NAME: new-years-day us-federal "New Year's Day"
+HOLIDAY-NAME: new-years-day us-market "New Year's Day"
 
 <PRIVATE
 
-: adjust-federal-holiday ( timestamp -- timestamp' )
+: adjust-federal-holiday ( timestamp -- timestamp )
     {
-        { [ dup saturday? ] [ 1 days time- ] }
-        { [ dup sunday? ] [ 1 days time+ ] }
+        ! Don't adjust to Dec 31
+        { [ dup { [ dup new-years-day same-day? ] [ saturday? ] } 1&& ] [ ] }
+        { [ dup saturday? ] [ -1 days (time+) ] }
+        { [ dup sunday? ] [ 1 days (time+) ] }
         [ ]
     } cond ;
 
 PRIVATE>
 
+: adjust-federal-holidays ( timestamp seq -- seq' )
+    [
+        [ clone ] dip execute( timestamp -- timestamp ) adjust-federal-holiday
+    ] with map ;
+
 M: us-federal holidays
-    (holidays)
-    [ execute( timestamp -- timestamp' ) adjust-federal-holiday ] with map ;
+    (holidays) adjust-federal-holidays ;
+
+M: us-market holidays
+    (holidays) adjust-federal-holidays ;
 
 : us-post-office-open? ( timestamp -- ? )
     { [ sunday? not ] [ us-federal holiday? not ] } 1&& ;
 
-HOLIDAY: new-years-day january 1 >>day ;
-HOLIDAY-NAME: new-years-day world "New Year's Day"
-HOLIDAY-NAME: new-years-day us-federal "New Year's Day"
-
-HOLIDAY: martin-luther-king-day january 3 monday-of-month ;
+HOLIDAY: martin-luther-king-day january 2 monday-of-month ;
 HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day"
+HOLIDAY-NAME: martin-luther-king-day us-market "Martin Luther King Day"
 
-HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ;
+HOLIDAY: inauguration-day january 20 >>day [ dup 4 neg rem + ] change-year ;
 HOLIDAY-NAME: inauguration-day us "Inauguration Day"
 
-HOLIDAY: washingtons-birthday february 3 monday-of-month ;
-HOLIDAY-NAME: washingtons-birthday us-federal "Washington's Birthday"
+HOLIDAY: washingtons-birthday february 2 monday-of-month ;
+HOLIDAY-NAME: washingtons-birthday us-market "Washington's Birthday"
+
+HOLIDAY: good-friday easter 2 days time- ;
+HOLIDAY-NAME: good-friday us-market "Good Friday"
+
+HOLIDAY: presidents-day february 2 monday-of-month ;
+HOLIDAY-NAME: presidents-day us-federal "President's Day"
 
 HOLIDAY: memorial-day may last-monday-of-month ;
 HOLIDAY-NAME: memorial-day us-federal "Memorial Day"
+HOLIDAY-NAME: memorial-day us-market "Memorial Day"
+
+HOLIDAY: juneteenth-national-independence-day june 19 >>day ;
+HOLIDAY-NAME: juneteenth-national-independence-day us-federal "Juneteenth National Independence Day"
+HOLIDAY-NAME: juneteenth-national-independence-day us-market "Juneteenth National Independence Day"
 
 HOLIDAY: independence-day july 4 >>day ;
 HOLIDAY-NAME: independence-day us-federal "Independence Day"
+HOLIDAY-NAME: independence-day us-market "Independence Day"
 
-HOLIDAY: labor-day september 1 monday-of-month ;
+HOLIDAY: labor-day september 0 monday-of-month ;
 HOLIDAY-NAME: labor-day us-federal "Labor Day"
+HOLIDAY-NAME: labor-day us-market "Labor Day"
 
-HOLIDAY: columbus-day october 2 monday-of-month ;
+HOLIDAY: columbus-day october 1 monday-of-month ;
 HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
 
 HOLIDAY-NAME: armistice-day us-federal "Veterans Day"
 
-HOLIDAY: thanksgiving-day november 4 thursday-of-month ;
+HOLIDAY: thanksgiving-day november 3 thursday-of-month ;
 HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day"
+HOLIDAY-NAME: thanksgiving-day us-market "Thanksgiving Day"
 
 HOLIDAY: christmas-day december 25 >>day ;
 HOLIDAY-NAME: christmas-day world "Christmas Day"
 HOLIDAY-NAME: christmas-day us-federal "Christmas Day"
+HOLIDAY-NAME: christmas-day us-market "Christmas Day"
 
 HOLIDAY: belly-laugh-day january 24 >>day ;
 
@@ -76,8 +101,6 @@ ALIAS: first-day-of-lent ash-wednesday
 
 HOLIDAY: fat-tuesday ash-wednesday 1 days time- ;
 
-HOLIDAY: good-friday easter 2 days time- ;
-
 HOLIDAY: tax-day april 15 >>day ;
 
 HOLIDAY: earth-day april 22 >>day ;
@@ -86,13 +109,15 @@ HOLIDAY: administrative-professionals-day april last-saturday-of-month wednesday
 
 HOLIDAY: cinco-de-mayo may 5 >>day ;
 
-HOLIDAY: mothers-day may 2 sunday-of-month ;
+HOLIDAY: mothers-day may 1 sunday-of-month ;
+
+HOLIDAY: armed-forces-day may 2 saturday-of-month ;
 
-HOLIDAY: armed-forces-day may 3 saturday-of-month ;
+HOLIDAY: national-donut-day june 0 friday-of-month ;
 
 HOLIDAY: flag-day june 14 >>day ;
 
-HOLIDAY: parents-day july 4 sunday-of-month ;
+HOLIDAY: parents-day july 3 sunday-of-month ;
 
 HOLIDAY: grandparents-day labor-day 1 weeks time+ ;
 
@@ -104,11 +129,11 @@ HOLIDAY: citizenship-day september 17 >>day ;
 
 HOLIDAY: bosss-day october 16 >>day ;
 
-HOLIDAY: sweetest-day october 3 saturday-of-month ;
+HOLIDAY: sweetest-day october 2 saturday-of-month ;
 
 HOLIDAY: halloween october 31 >>day ;
 
-HOLIDAY: election-day november 1 monday-of-month 1 days time+ ;
+HOLIDAY: election-day november 0 monday-of-month 1 days time+ ;
 
 HOLIDAY: black-friday thanksgiving-day 1 days time+ ;