extra/zoneinfo/zoneinfo.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: combinators combinators.smart io.encodings.utf8 io.files
   4 kernel namespaces sequences splitting unicode.case accessors
   5 math.parser calendar ;
   6 IN: zoneinfo
   7
   8 CONSTANT: zoneinfo-paths
   9 {
  10     "vocab:zoneinfo/africa"
  11     "vocab:zoneinfo/antarctica"
  12     "vocab:zoneinfo/asia"
  13     "vocab:zoneinfo/australasia"
  14     "vocab:zoneinfo/europe"
  15     "vocab:zoneinfo/northamerica"
  16     "vocab:zoneinfo/pacificnew"
  17     "vocab:zoneinfo/solar87"
  18     "vocab:zoneinfo/solar88"
  19     "vocab:zoneinfo/solar89"
  20     "vocab:zoneinfo/southamerica"
  21     "vocab:zoneinfo/systemv"
  22     "vocab:zoneinfo/leapseconds"
  23 }
  24
  25 SYMBOL: last-zone
  26
  27 TUPLE: raw-zone name gmt-offset rules/save format until ;
  28 TUPLE: raw-rule name from to type in on at save letters ;
  29 TUPLE: raw-link from to ;
  30 TUPLE: raw-leap year month day hms corr r/s ;
  31
  32 TUPLE: zone name ;
  33 TUPLE: rule name from to at ;
  34 TUPLE: link ;
  35 TUPLE: leap ;
  36
  37 : rule-to ( m string -- m n )
  38     {
  39         { "only" [ dup ] }
  40         { "max" [ 1/0. ] }
  41         [ string>number ]
  42     } case ;
  43
  44 /*
  45 : rule-on ( string -- obj )
  46     {
  47         { [ dup string>number ] [ ] }
  48         { [ "last" ?head ] [ month-abbreviation>n ] }
  49         { [ ] [ month-abbreviation>n ] }
  50     } cond ;
  51 */
  52
  53             ! [ string>number -1/0. or ]
  54             ! [ rule-to ]
  55
  56             ! [ month-abbreviation>n ]
  57             ! [ rule-on ]
  58
  59 : raw-rule>rule ( raw-rule -- rule )
  60     ;
  61
  62 : parse-rule ( seq -- rule )
  63     [
  64         {
  65             [ drop ]
  66             [ ]
  67             [ ]
  68             [ ]
  69             [ ]
  70             [ ]
  71             [ ]
  72             [ ]
  73             [ ]
  74             [ ]
  75         } spread
  76     ] input<sequence raw-rule boa ;
  77
  78 : raw-zone>zone ( raw-zone -- zone )
  79     ;
  80
  81 : parse-zone ( seq -- zone )
  82     {
  83         [ second ]
  84         [ third ]
  85         [ fourth ]
  86         [ 4 swap nth ]
  87         [ 5 tail harvest ]
  88     } cleave raw-zone boa ;
  89
  90 : parse-partial-zone ( seq -- zone )
  91     [ last-zone get name>> ] dip
  92     {
  93         [ first ]
  94         [ second ]
  95         [ 2 swap nth ]
  96         [ 3 tail harvest ]
  97     } cleave raw-zone boa ;
  98
  99 : raw-link>link ( raw-link -- link )
 100     ;
 101
 102 : parse-link ( seq -- link )
 103     [
 104         {
 105             [ drop ]
 106             [ ]
 107             [ ]
 108         } spread
 109     ] input<sequence raw-link boa ;
 110
 111 : raw-leap>leap ( raw-leap -- leap )
 112     ;
 113
 114 : parse-leap ( seq -- link )
 115     [
 116         {
 117             [ drop ]
 118             [ ]
 119             [ ]
 120             [ ]
 121             [ ]
 122             [ ]
 123             [ ]
 124         } spread
 125     ] input<sequence raw-leap boa ;
 126
 127 : parse-line ( seq -- tuple )
 128     dup first >lower
 129     {
 130         { "zone" [ parse-zone dup last-zone set raw-zone>zone ] }
 131         { "rule" [ parse-rule raw-rule>rule ] }
 132         { "link" [ parse-link raw-link>link ] }
 133         { "leap" [ parse-leap raw-leap>leap ] }
 134         [ drop harvest parse-partial-zone ]
 135     } case ;
 136
 137 : parse-zoneinfo-file ( path -- seq )
 138     utf8 file-lines
 139     [ "#" split1 drop ] map harvest
 140     [ "\t " split harvest ] map harvest
 141     [ [ parse-line ] map ] with-scope ;
 142
 143 : load-zoneinfo-files ( -- seq )
 144     zoneinfo-paths [ parse-zoneinfo-file ] map ;
 145
 146
 147
 148 ! Rule
 149 ! name - string
 150 ! from - year or "min"
 151 ! name    "France"
 152 ! from    "1938"  or "min"
 153 ! to      "1945" or "max" or "only"
 154 ! type    "-"  always "-"
 155 ! in      "Mar"  -- 3-letter month name
 156 ! on      "26"  or "Mon>=15"  or lastSun lastFri
 157 ! at      "23:00s"  "12:13:00s" "1:00s" "1:00u"
 158 ! save    "-0:00:05" "1:00" "0:14:15"
 159 ! letters "S" or "-" or "AMT" "BDST"
 160
 161 ! Zone
 162 ! name       "Indian/Maldives"
 163 ! gmt-offset "4:54:00" "9:55:56" "-9:55:56"
 164 ! rules/save "-" "0:20" "0:30" "1:00" "AN" "W-Eur" "Winn" "Zion" "sol87" "sol88"
 165 ! format     "LMT" "%s" "%sT" "A%sT" "AC%sT" "ACT"
 166 ! until      { "1880" }
 167     ! { "1847" "Dec" "1" "0:00s" }
 168     ! { "1883" "Nov" "18" "12:12:57" }
 169     ! { "1989" "Sep" "lastSun" "2:00s" }
 170
 171 ! Link
 172 ! T{ link { from "Asia/Riyadh88" } { to "Mideast/Riyadh88" } }