1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs calendar hashtables kernel
4 parser sequences vocabs words ;
7 SINGLETONS: all world commonwealth-of-nations ;
12 parse-definition ( timestamp/n -- timestamp ) define-declared ;
15 scan-word "holiday" scan-word scan-object swap
16 '[ _ _ rot ?set-at ] change-word-prop ;
19 GENERIC: holidays ( timestamp/n singleton -- seq )
23 : (holidays) ( singleton -- seq )
24 all-words [ "holiday" word-prop key? ] with filter ;
27 (holidays) [ [ clone ] dip execute( timestamp -- timestamp ) ] with map ;
31 M: all holidays drop (holidays) ;
33 : holiday? ( timestamp/n singleton -- ? )
34 [ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
36 : holiday-assoc ( timestamp singleton -- assoc )
38 [ _ clone swap execute( timestamp -- timestamp ) ] keep
41 : holiday-name ( singleton word -- string/f )
42 "holiday" word-prop at ;
44 : holiday-names ( timestamp/n singleton -- seq )
47 [ drop ] [ holiday-assoc ] 2bi swap
48 '[ drop _ same-day? ] assoc-filter values
49 ] keep '[ _ swap "holiday" word-prop at ] map ;
51 HOLIDAY: armistice-day november 11 >>day ;
52 HOLIDAY-NAME: armistice-day world "Armistice Day"