extra/calendar/holidays/us/us.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs calendar combinators
   4 combinators.short-circuit fry kernel lexer math namespaces
   5 parser sequences shuffle vocabs words ;
   6 IN: calendar.holidays.us
   7
   8 SINGLETONS: world us us-federal canada commonwealth-of-nations ;
   9
  10 <<
  11 SYNTAX: HOLIDAY:
  12     CREATE-WORD
  13     dup H{ } clone "holiday" set-word-prop
  14     parse-definition (( timestamp/n -- timestamp )) define-declared ;
  15
  16 SYNTAX: HOLIDAY-NAME:
  17     scan-word "holiday" word-prop scan-word scan-object spin set-at ;
  18 >>
  19
  20 GENERIC: holidays ( n symbol -- seq )
  21
  22 <PRIVATE
  23
  24 : (holidays) ( singleton -- seq )
  25     all-words swap '[ "holiday" word-prop _ swap key? ] filter ;
  26
  27 : adjust-federal-holiday ( timestamp -- timestamp' )
  28     {
  29         { [ dup saturday? ] [ 1 days time- ] }
  30         { [ dup sunday? ] [ 1 days time+ ] }
  31         [ ]
  32     } cond ;
  33
  34 M: us-federal holidays
  35     (holidays)
  36     [ execute( timestamp -- timestamp' ) adjust-federal-holiday ] with map ;
  37
  38 M: object holidays
  39     (holidays) [ execute( timestamp -- timestamp' ) ] with map ;
  40
  41 PRIVATE>
  42
  43 : holiday? ( timestamp/n singleton -- ? )
  44     [ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
  45
  46 : us-post-office-open? ( timestamp -- ? )
  47     { [ sunday? not ] [ us-federal holiday? not ] } 1&& ;
  48
  49 HOLIDAY: new-years-day january 1 >>day ;
  50 HOLIDAY-NAME: new-years-day world "New Year's Day"
  51 HOLIDAY-NAME: new-years-day us-federal "New Year's Day"
  52
  53 HOLIDAY: martin-luther-king-day january 3 monday-of-month ;
  54 HOLIDAY-NAME: martin-luther-king-day us-federal "Martin Luther King Day"
  55
  56 HOLIDAY: inauguration-day year dup 4 neg rem + january 20 >>day ;
  57 HOLIDAY-NAME: inauguration-day us "Inauguration Day"
  58
  59 HOLIDAY: washingtons-birthday february 3 monday-of-month ;
  60 HOLIDAY-NAME: washingtons-birthday us-federal "Washington's Birthday"
  61
  62 HOLIDAY: memorial-day may last-monday-of-month ;
  63 HOLIDAY-NAME: memorial-day us-federal "Memorial Day"
  64
  65 HOLIDAY: independence-day july 4 >>day ;
  66 HOLIDAY-NAME: independence-day us-federal "Independence Day"
  67
  68 HOLIDAY: labor-day september 1 monday-of-month ;
  69 HOLIDAY-NAME: labor-day us-federal "Labor Day"
  70
  71 HOLIDAY: columbus-day october 2 monday-of-month ;
  72 HOLIDAY-NAME: columbus-day us-federal "Columbus Day"
  73
  74 HOLIDAY: veterans-day november 11 >>day ;
  75 HOLIDAY-NAME: veterans-day us-federal "Veterans Day"
  76 HOLIDAY-NAME: veterans-day world "Armistice Day"
  77 HOLIDAY-NAME: veterans-day commonwealth-of-nations "Remembrance Day"
  78
  79 HOLIDAY: thanksgiving-day november 4 thursday-of-month ;
  80 HOLIDAY-NAME: thanksgiving-day us-federal "Thanksgiving Day"
  81
  82 HOLIDAY: canadian-thanksgiving-day october 2 monday-of-month ;
  83 HOLIDAY-NAME: canadian-thanksgiving-day canada "Thanksgiving Day"
  84
  85 HOLIDAY: christmas-day december 25 >>day ;
  86 HOLIDAY-NAME: christmas-day world "Christmas Day"
  87 HOLIDAY-NAME: christmas-day us-federal "Christmas Day"
  88
  89 HOLIDAY: belly-laugh-day january 24 >>day ;
  90
  91 HOLIDAY: groundhog-day february 2 >>day ;
  92
  93 HOLIDAY: lincolns-birthday february 12 >>day ;
  94
  95 HOLIDAY: valentines-day february 14 >>day ;
  96
  97 HOLIDAY: st-patricks-day march 17 >>day ;
  98
  99 HOLIDAY: ash-wednesday easter 46 days time- ;
 100
 101 ALIAS: first-day-of-lent ash-wednesday
 102
 103 HOLIDAY: fat-tuesday ash-wednesday 1 days time- ;
 104
 105 HOLIDAY: good-friday easter 2 days time- ;
 106
 107 HOLIDAY: tax-day april 15 >>day ;
 108
 109 HOLIDAY: earth-day april 22 >>day ;
 110
 111 HOLIDAY: administrative-professionals-day april last-saturday-of-month wednesday ;
 112
 113 HOLIDAY: cinco-de-mayo may 5 >>day ;
 114
 115 HOLIDAY: mothers-day may 2 sunday-of-month ;
 116
 117 HOLIDAY: armed-forces-day may 3 saturday-of-month ;
 118
 119 HOLIDAY: flag-day june 14 >>day ;
 120
 121 HOLIDAY: parents-day july 4 sunday-of-month ;
 122
 123 HOLIDAY: grandparents-day labor-day 1 weeks time+ ;
 124
 125 HOLIDAY: patriot-day september 11 >>day ;
 126
 127 HOLIDAY: stepfamily-day september 16 >>day ;
 128
 129 HOLIDAY: citizenship-day september 17 >>day ;
 130
 131 HOLIDAY: bosss-day october 16 >>day ;
 132
 133 HOLIDAY: sweetest-day october 3 saturday-of-month ;
 134
 135 HOLIDAY: halloween october 31 >>day ;
 136
 137 HOLIDAY: election-day november 1 monday-of-month 1 days time+ ;
 138
 139 HOLIDAY: black-friday thanksgiving-day 1 days time+ ;
 140
 141 HOLIDAY: pearl-harbor-remembrance-day december 7 >>day ;
 142
 143 HOLIDAY: new-years-eve december 31 >>day ;