! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors calendar kernel math 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
-<<
-SYNTAX: us-federal
- word "us-federal" dup set-word-prop ;
->>
+SINGLETONS: us us-federal us-market ;
-! Federal Holidays
-: new-years-day ( timestamp/n -- timestamp )
- january 1 >>day ; us-federal
+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"
-: martin-luther-king-day ( timestamp/n -- timestamp )
- january 3 monday-of-month ; us-federal
+<PRIVATE
-: inauguration-day ( timestamp/n -- timestamp )
- year dup neg 4 rem + january 20 >>day ; us-federal
+: adjust-federal-holiday ( timestamp -- timestamp )
+ {
+ ! 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 ;
-: washington's-birthday ( timestamp/n -- timestamp )
- february 3 monday-of-month ; us-federal
+PRIVATE>
-ALIAS: presidents-day washington's-birthday us-federal
+: adjust-federal-holidays ( timestamp seq -- seq' )
+ [
+ [ clone ] dip execute( timestamp -- timestamp ) adjust-federal-holiday
+ ] with map ;
-: memorial-day ( timestamp/n -- timestamp )
- may last-monday-of-month ; us-federal
+M: us-federal holidays
+ (holidays) adjust-federal-holidays ;
-: independence-day ( timestamp/n -- timestamp )
- july 4 >>day ; us-federal
+M: us-market holidays
+ (holidays) adjust-federal-holidays ;
-: labor-day ( timestamp/n -- timestamp )
- september 1 monday-of-month ; us-federal
+: us-post-office-open? ( timestamp -- ? )
+ { [ sunday? not ] [ us-federal holiday? not ] } 1&& ;
-: columbus-day ( timestamp/n -- timestamp )
- october 2 monday-of-month ; us-federal
+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"
-: veterans'-day ( timestamp/n -- timestamp )
- november 11 >>day ; us-federal
+HOLIDAY: inauguration-day january 20 >>day [ dup 4 neg rem + ] change-year ;
+HOLIDAY-NAME: inauguration-day us "Inauguration Day"
-: thanksgiving-day ( timestamp/n -- timestamp )
- november 4 thursday-of-month ; us-federal
+HOLIDAY: washingtons-birthday february 2 monday-of-month ;
+HOLIDAY-NAME: washingtons-birthday us-market "Washington's Birthday"
-: christmas-day ( timestamp/n -- timestamp )
- december 25 >>day ; us-federal
+HOLIDAY: good-friday easter 2 days time- ;
+HOLIDAY-NAME: good-friday us-market "Good Friday"
-! Other Holidays
+HOLIDAY: presidents-day february 2 monday-of-month ;
+HOLIDAY-NAME: presidents-day us-federal "President's Day"
-: belly-laugh-day ( timestamp/n -- timestamp )
- january 24 >>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"
-: groundhog-day ( timestamp/n -- timestamp )
- february 2 >>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"
-: lincoln's-birthday ( timestamp/n -- timestamp )
- february 12 >>day ;
+HOLIDAY: independence-day july 4 >>day ;
+HOLIDAY-NAME: independence-day us-federal "Independence Day"
+HOLIDAY-NAME: independence-day us-market "Independence Day"
-: valentine's-day ( timestamp/n -- timestamp )
- february 14 >>day ;
+HOLIDAY: labor-day september 0 monday-of-month ;
+HOLIDAY-NAME: labor-day us-federal "Labor Day"
+HOLIDAY-NAME: labor-day us-market "Labor Day"
-: st-patrick's-day ( timestamp/n -- timestamp )
- march 17 >>day ;
+HOLIDAY: columbus-day october 1 monday-of-month ;
+HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
-: ash-wednesday ( timestamp/n -- timestamp )
- easter 46 days time- ;
+HOLIDAY-NAME: armistice-day us-federal "Veterans Day"
+
+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 ;
+
+HOLIDAY: groundhog-day february 2 >>day ;
+
+HOLIDAY: lincolns-birthday february 12 >>day ;
+
+HOLIDAY: valentines-day february 14 >>day ;
+
+HOLIDAY: st-patricks-day march 17 >>day ;
+
+HOLIDAY: ash-wednesday easter 46 days time- ;
ALIAS: first-day-of-lent ash-wednesday
-: fat-tuesday ( timestamp/n -- timestamp )
- ash-wednesday 1 days time- ;
+HOLIDAY: fat-tuesday ash-wednesday 1 days time- ;
-: good-friday ( timestamp/n -- timestamp )
- easter 2 days time- ;
+HOLIDAY: tax-day april 15 >>day ;
-: tax-day ( timestamp/n -- timestamp )
- april 15 >>day ;
+HOLIDAY: earth-day april 22 >>day ;
-: earth-day ( timestamp/n -- timestamp )
- april 22 >>day ;
+HOLIDAY: administrative-professionals-day april last-saturday-of-month wednesday ;
-: administrative-professionals'-day ( timestamp/n -- timestamp )
- april last-saturday-of-month wednesday ;
+HOLIDAY: cinco-de-mayo may 5 >>day ;
-: cinco-de-mayo ( timestamp/n -- timestamp )
- may 5 >>day ;
+HOLIDAY: mothers-day may 1 sunday-of-month ;
-: mother's-day ( timestamp/n -- timestamp )
- may 2 sunday-of-month ;
+HOLIDAY: armed-forces-day may 2 saturday-of-month ;
-: armed-forces-day ( timestamp/n -- timestamp )
- may 3 saturday-of-month ;
+HOLIDAY: national-donut-day june 0 friday-of-month ;
-: flag-day ( timestamp/n -- timestamp )
- june 14 >>day ;
+HOLIDAY: flag-day june 14 >>day ;
-: parents'-day ( timestamp/n -- timestamp )
- july 4 sunday-of-month ;
+HOLIDAY: parents-day july 3 sunday-of-month ;
-: grandparents'-day ( timestamp/n -- timestamp )
- labor-day 1 weeks time+ ;
+HOLIDAY: grandparents-day labor-day 1 weeks time+ ;
-: patriot-day ( timestamp/n -- timestamp )
- september 11 >>day ;
+HOLIDAY: patriot-day september 11 >>day ;
-: stepfamily-day ( timestamp/n -- timestamp )
- september 16 >>day ;
+HOLIDAY: stepfamily-day september 16 >>day ;
-: citizenship-day ( timestamp/n -- timestamp )
- september 17 >>day ;
+HOLIDAY: citizenship-day september 17 >>day ;
-: boss's-day ( timestamp/n -- timestamp )
- october 16 >>day ;
+HOLIDAY: bosss-day october 16 >>day ;
-: sweetest-day ( timestamp/n -- timestamp )
- october 3 saturday-of-month ;
+HOLIDAY: sweetest-day october 2 saturday-of-month ;
-: halloween ( timestamp/n -- timestamp )
- october 31 >>day ;
+HOLIDAY: halloween october 31 >>day ;
-: election-day ( timestamp/n -- timestamp )
- november 1 monday-of-month 1 days time+ ;
+HOLIDAY: election-day november 0 monday-of-month 1 days time+ ;
-: black-friday ( timestamp/n -- timestamp )
- thanksgiving-day 1 days time+ ;
+HOLIDAY: black-friday thanksgiving-day 1 days time+ ;
-: pearl-harbor-remembrance-day ( timestamp/n -- timestamp )
- december 7 >>day ;
+HOLIDAY: pearl-harbor-remembrance-day december 7 >>day ;
-: new-year's-eve ( timestamp/n -- timestamp )
- december 31 >>day ;
+HOLIDAY: new-years-eve december 31 >>day ;
projects / factor.git / blobdiff