1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs calendar fry kernel locals parser
4 sequences vocabs words memoize ;
7 SINGLETONS: all world commonwealth-of-nations ;
12 dup "holiday" word-prop [
13 dup H{ } clone "holiday" set-word-prop
15 parse-definition ( timestamp/n -- timestamp ) define-declared ;
18 [let scan-word "holiday" word-prop :> holidays scan-word :> name scan-object :> value
19 value name holidays set-at ] ;
22 GENERIC: holidays ( n singleton -- seq )
26 : (holidays) ( singleton -- seq )
27 all-words swap '[ "holiday" word-prop _ swap key? ] filter ;
30 (holidays) [ execute( timestamp -- timestamp' ) ] with map ;
36 all-words [ "holiday" word-prop key? ] with filter ;
38 : holiday? ( timestamp/n singleton -- ? )
39 [ holidays ] [ drop ] 2bi '[ _ same-day? ] any? ;
41 : holiday-assoc ( timestamp singleton -- assoc )
43 '[ [ _ swap execute( ts -- ts' ) >gmt midnight ] keep ] { } map>assoc ;
45 : holiday-name ( singleton word -- string/f )
46 "holiday" word-prop at ;
48 : holiday-names ( timestamp/n singleton -- seq )
51 [ drop ] [ holiday-assoc ] 2bi swap
52 '[ drop _ same-day? ] assoc-filter values
53 ] keep '[ _ swap "holiday" word-prop at ] map ;
55 HOLIDAY: armistice-day november 11 >>day ;
56 HOLIDAY-NAME: armistice-day world "Armistice Day"