1 ! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs calendar calendar.english combinators
4 combinators.short-circuit continuations generalizations io
5 io.streams.string kernel math math.functions math.parser
9 : read-00 ( -- n ) 2 read string>number ;
11 : read-000 ( -- n ) 3 read string>number ;
13 : read-0000 ( -- n ) 4 read string>number ;
16 read1 swap member? [ "Parse error" throw ] unless ;
18 ERROR: invalid-timestamp-format ;
20 : check-timestamp ( obj/f -- obj )
21 [ invalid-timestamp-format ] unless* ;
23 : checked-number ( str -- n )
24 string>number check-timestamp ;
26 : read-token ( seps -- token )
27 [ read-until ] keep member? check-timestamp drop ;
29 : read-sp ( -- token ) " " read-token ;
31 : signed-gmt-offset ( dt ch -- dt' )
32 { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case duration* ;
34 : read-rfc3339-gmt-offset ( ch -- dt )
37 { CHAR: Z [ instant ] }
41 read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
43 ] dip signed-gmt-offset
47 : read-ymd ( -- y m d )
48 read-0000 "-" expect read-00 "-" expect read-00 ;
50 : read-hms ( -- h m s )
51 read-00 ":" expect read-00 ":" expect read-00 ;
53 : read-rfc3339-seconds ( s -- s' ch )
55 [ string>number ] [ length 10^ ] bi / +
58 : read-rfc3339 ( -- timestamp )
62 read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
63 read-rfc3339-gmt-offset
66 : rfc3339>timestamp ( str -- timestamp )
67 [ read-rfc3339 ] with-string-reader ;
69 : parse-rfc822-military-offset ( string -- dt )
71 -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
72 1 2 3 4 5 6 7 8 9 10 11 12 0
75 CONSTANT: rfc822-named-zones H{
86 : parse-rfc822-gmt-offset ( string -- dt )
88 { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
89 { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
90 { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
93 2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
94 ] dip signed-gmt-offset
98 : read-hh:mm:ss ( -- hh mm ss )
99 ":" read-token checked-number
100 ":" read-token checked-number
101 read-sp checked-number ;
103 : read-rfc822 ( -- timestamp )
104 "," read-token day-abbreviations3 member? check-timestamp drop
105 read1 CHAR: \s assert=
106 read-sp checked-number
107 read-sp month-abbreviations index 1 + check-timestamp
108 read-sp checked-number spin
110 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
112 : rfc822>timestamp ( str -- timestamp )
113 [ read-rfc822 ] with-string-reader ;
115 : check-day-name ( str -- )
116 [ day-abbreviations3 member? ] [ day-names member? ] bi or
117 check-timestamp drop ;
119 : read-cookie-string-1 ( -- timestamp )
120 "," read-token check-day-name
121 read1 CHAR: \s assert=
122 "-" read-token checked-number
123 "-" read-token month-abbreviations index 1 + check-timestamp
124 read-sp checked-number spin
126 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
128 : cookie-string>timestamp-1 ( str -- timestamp )
129 [ read-cookie-string-1 ] with-string-reader ;
131 : read-cookie-string-2 ( -- timestamp )
132 read-sp check-day-name
133 read-sp month-abbreviations index 1 + check-timestamp
134 read-sp checked-number
136 [ read-sp checked-number ] 5 ndip
137 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
139 : cookie-string>timestamp-2 ( str -- timestamp )
140 [ read-cookie-string-2 ] with-string-reader ;
142 : cookie-string>timestamp ( str -- timestamp )
144 [ [ cookie-string>timestamp-1 ] [ 2drop f ] recover ]
145 [ [ cookie-string>timestamp-2 ] [ 2drop f ] recover ]
146 [ [ rfc822>timestamp ] [ 2drop f ] recover ]
149 : ymdhms>timestamp ( str -- timestamp )
150 [ read-ymd " " expect read-hms instant <timestamp> ] with-string-reader ;
152 : ymd>timestamp ( str -- timestamp )
153 [ read-ymd <date-gmt> ] with-string-reader ;
155 : hhmm>duration ( hhmm -- duration )
156 [ instant read-00 >>hour read-00 >>minute ] with-string-reader ;
158 : hms>duration ( str -- duration )
159 [ 0 0 0 read-hms <duration> ] with-string-reader ;