steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

redo holidays

db4
Doug Coleman 2009-11-12 14:43:11 -06:00
parent 4dce86cbad
commit 0c56f2d6af
1 changed files with 95 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

177
extra/calendar/holidays/us/us.factor
View File

@ -1,130 +1,143 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar kernel math words ; USING: accessors assocs calendar combinators.short-circuit fry
kernel lexer math namespaces parser sequences shuffle vocabs
words ;
IN: calendar.holidays.us IN: calendar.holidays.us
SYMBOLS: world us us-federal canada
commonwealth-of-nations ;
<< <<
SYNTAX: us-federal SYNTAX: HOLIDAY:
word "us-federal" dup set-word-prop ; CREATE-WORD
dup H{ } clone "holiday" set-word-prop
parse-definition (( timestamp/n -- timestamp )) define-declared ;
SYNTAX: HOLIDAY-NAME:
scan-word "holiday" word-prop scan-word scan-object >at drop ;
>> >>
! Federal Holidays : holiday>timestamp ( n word -- timestamp )
: new-years-day ( timestamp/n -- timestamp ) execute( timestamp -- timestamp' ) ;
january 1 >>day ; us-federal
: martin-luther-king-day ( timestamp/n -- timestamp ) : find-holidays ( n symbol -- seq )
january 3 monday-of-month ; us-federal all-words swap '[ "holiday" word-prop _ swap key? ] filter
[ holiday>timestamp ] with map ;
: inauguration-day ( timestamp/n -- timestamp ) : adjust-federal-holiday ( timestamp -- timestamp' )
year dup neg 4 rem + january 20 >>day ; us-federal dup saturday? [
1 days time-
] [
dup sunday? [
1 days time+
] when
] if ;
: washington's-birthday ( timestamp/n -- timestamp ) : us-federal-holidays ( timestamp/n -- seq )
february 3 monday-of-month ; us-federal us-federal find-holidays [ adjust-federal-holiday ] map ;
ALIAS: presidents-day washington's-birthday us-federal : canadian-holidays ( timestamp/n -- seq )
canada find-holidays ;
: memorial-day ( timestamp/n -- timestamp ) HOLIDAY: new-year's-day january 1 >>day ;
may last-monday-of-month ; us-federal HOLIDAY-NAME: new-year's-day world "New Year's Day"
HOLIDAY-NAME: new-year's-day us-federal "New Year's Day"
: independence-day ( timestamp/n -- timestamp ) HOLIDAY: martin-luther-king-day january 3 monday-of-month ;
july 4 >>day ; us-federal HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day"
: labor-day ( timestamp/n -- timestamp ) HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ;
september 1 monday-of-month ; us-federal HOLIDAY-NAME: inauguration-day us "Inauguration Day"
: columbus-day ( timestamp/n -- timestamp ) HOLIDAY: washington's-birthday february 3 monday-of-month ;
october 2 monday-of-month ; us-federal HOLIDAY-NAME: washington's-birthday us-federal "Washington's Birthday"
: veterans'-day ( timestamp/n -- timestamp ) HOLIDAY: memorial-day may last-monday-of-month ;
november 11 >>day ; us-federal HOLIDAY-NAME: memorial-day us-federal "Memorial Day"
: thanksgiving-day ( timestamp/n -- timestamp ) HOLIDAY: independence-day july 4 >>day ;
november 4 thursday-of-month ; us-federal HOLIDAY-NAME: independence-day us-federal "Independence Day"
: christmas-day ( timestamp/n -- timestamp ) HOLIDAY: labor-day september 1 monday-of-month ;
december 25 >>day ; us-federal HOLIDAY-NAME: labor-day us-federal "Labor Day"
! Other Holidays HOLIDAY: columbus-day october 2 monday-of-month ;
HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
: belly-laugh-day ( timestamp/n -- timestamp ) HOLIDAY: veterans-day november 11 >>day ;
january 24 >>day ; HOLIDAY-NAME: veterans-day us-federal "Veterans Day"
HOLIDAY-NAME: veterans-day world "Armistice Day"
HOLIDAY-NAME: veterans-day commonwealth-of-nations "Remembrance Day"
: groundhog-day ( timestamp/n -- timestamp ) HOLIDAY: thanksgiving-day november 4 thursday-of-month ;
february 2 >>day ; HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day"
: lincoln's-birthday ( timestamp/n -- timestamp ) HOLIDAY: canadian-thanksgiving-day october 2 monday-of-month ;
february 12 >>day ; HOLIDAY-NAME: canadian-thanksgiving-day canada "Thanksgiving Day"
: valentine's-day ( timestamp/n -- timestamp ) HOLIDAY: christmas-day december 25 >>day ;
february 14 >>day ; HOLIDAY-NAME: christmas-day world "Christmas Day"
HOLIDAY-NAME: christmas-day us-federal "Christmas Day"
: st-patrick's-day ( timestamp/n -- timestamp ) HOLIDAY: belly-laugh-day january 24 >>day ;
march 17 >>day ;
: ash-wednesday ( timestamp/n -- timestamp ) HOLIDAY: groundhog-day february 2 >>day ;
easter 46 days time- ;
HOLIDAY: lincoln's-birthday february 12 >>day ;
HOLIDAY: valentine's-day february 14 >>day ;
HOLIDAY: st-patrick's-day march 17 >>day ;
HOLIDAY: ash-wednesday easter 46 days time- ;
ALIAS: first-day-of-lent ash-wednesday ALIAS: first-day-of-lent ash-wednesday
: fat-tuesday ( timestamp/n -- timestamp ) HOLIDAY: fat-tuesday ash-wednesday 1 days time- ;
ash-wednesday 1 days time- ;
: good-friday ( timestamp/n -- timestamp ) HOLIDAY: good-friday easter 2 days time- ;
easter 2 days time- ;
: tax-day ( timestamp/n -- timestamp ) HOLIDAY: tax-day april 15 >>day ;
april 15 >>day ;
: earth-day ( timestamp/n -- timestamp ) HOLIDAY: earth-day april 22 >>day ;
april 22 >>day ;
: administrative-professionals'-day ( timestamp/n -- timestamp ) HOLIDAY: administrative-professionals'-day april last-saturday-of-month wednesday ;
april last-saturday-of-month wednesday ;
: cinco-de-mayo ( timestamp/n -- timestamp ) HOLIDAY: cinco-de-mayo may 5 >>day ;
may 5 >>day ;
: mother's-day ( timestamp/n -- timestamp ) HOLIDAY: mother's-day may 2 sunday-of-month ;
may 2 sunday-of-month ;
: armed-forces-day ( timestamp/n -- timestamp ) HOLIDAY: armed-forces-day may 3 saturday-of-month ;
may 3 saturday-of-month ;
: flag-day ( timestamp/n -- timestamp ) HOLIDAY: flag-day june 14 >>day ;
june 14 >>day ;
: parents'-day ( timestamp/n -- timestamp ) HOLIDAY: parents'-day july 4 sunday-of-month ;
july 4 sunday-of-month ;
: grandparents'-day ( timestamp/n -- timestamp ) HOLIDAY: grandparents'-day labor-day 1 weeks time+ ;
labor-day 1 weeks time+ ;
: patriot-day ( timestamp/n -- timestamp ) HOLIDAY: patriot-day september 11 >>day ;
september 11 >>day ;
: stepfamily-day ( timestamp/n -- timestamp ) HOLIDAY: stepfamily-day september 16 >>day ;
september 16 >>day ;
: citizenship-day ( timestamp/n -- timestamp ) HOLIDAY: citizenship-day september 17 >>day ;
september 17 >>day ;
: boss's-day ( timestamp/n -- timestamp ) HOLIDAY: boss's-day october 16 >>day ;
october 16 >>day ;
: sweetest-day ( timestamp/n -- timestamp ) HOLIDAY: sweetest-day october 3 saturday-of-month ;
october 3 saturday-of-month ;
: halloween ( timestamp/n -- timestamp ) HOLIDAY: halloween october 31 >>day ;
october 31 >>day ;
: election-day ( timestamp/n -- timestamp ) HOLIDAY: election-day november 1 monday-of-month 1 days time+ ;
november 1 monday-of-month 1 days time+ ;
: black-friday ( timestamp/n -- timestamp ) HOLIDAY: black-friday thanksgiving-day 1 days time+ ;
thanksgiving-day 1 days time+ ;
: pearl-harbor-remembrance-day ( timestamp/n -- timestamp ) HOLIDAY: pearl-harbor-remembrance-day december 7 >>day ;
december 7 >>day ;
: new-year's-eve ( timestamp/n -- timestamp ) HOLIDAY: new-year's-eve december 31 >>day ;
december 31 >>day ;
: post-office-open? ( timestamp -- ? )
{
[ sunday? not ]
[ dup us-federal-holidays [ same-day? ] with any? not ]
} 1&& ;