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 continuations generalizations io io.streams.string kernel macros math
5 math.functions math.parser sequences ;
8 : read-00 ( -- n ) 2 read string>number ;
10 : read-000 ( -- n ) 3 read string>number ;
12 : read-0000 ( -- n ) 4 read string>number ;
15 read1 swap member? [ "Parse error" throw ] unless ;
17 ERROR: invalid-timestamp-format ;
19 : check-timestamp ( obj/f -- obj )
20 [ invalid-timestamp-format ] unless* ;
22 : checked-number ( str -- n )
23 string>number check-timestamp ;
25 : read-token ( seps -- token )
26 [ read-until ] keep member? check-timestamp drop ;
28 : read-sp ( -- token ) " " read-token ;
30 : signed-gmt-offset ( dt ch -- dt' )
31 { { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
33 : read-rfc3339-gmt-offset ( ch -- dt )
36 { CHAR: Z [ instant ] }
40 read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
42 ] dip signed-gmt-offset
46 : read-ymd ( -- y m d )
47 read-0000 "-" expect read-00 "-" expect read-00 ;
49 : read-hms ( -- h m s )
50 read-00 ":" expect read-00 ":" expect read-00 ;
52 : read-rfc3339-seconds ( s -- s' ch )
54 [ string>number ] [ length 10^ ] bi / +
57 : (rfc3339>timestamp) ( -- timestamp )
61 read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
62 read-rfc3339-gmt-offset
65 : rfc3339>timestamp ( str -- timestamp )
66 [ (rfc3339>timestamp) ] with-string-reader ;
68 : parse-rfc822-military-offset ( string -- dt )
70 -1 -2 -3 -4 -5 -6 -7 -8 -9 f -10 -11 -12
71 1 2 3 4 5 6 7 8 9 10 11 12 0
74 CONSTANT: rfc822-named-zones H{
85 : parse-rfc822-gmt-offset ( string -- dt )
87 { [ dup { "UTC" "GMT" } member? ] [ drop instant ] }
88 { [ dup length 1 = ] [ parse-rfc822-military-offset ] }
89 { [ dup rfc822-named-zones key? ] [ rfc822-named-zones at hours ] }
92 2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
93 ] dip signed-gmt-offset
97 : read-hh:mm:ss ( -- hh mm ss )
98 ":" read-token checked-number
99 ":" read-token checked-number
100 read-sp checked-number ;
102 : (rfc822>timestamp) ( -- timestamp )
103 "," read-token day-abbreviations3 member? check-timestamp drop
104 read1 CHAR: \s assert=
105 read-sp checked-number
106 read-sp month-abbreviations index 1 + check-timestamp
107 read-sp checked-number -rot swap
109 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
111 : rfc822>timestamp ( str -- timestamp )
112 [ (rfc822>timestamp) ] with-string-reader ;
114 : check-day-name ( str -- )
115 [ day-abbreviations3 member? ] [ day-names member? ] bi or
116 check-timestamp drop ;
118 : (cookie-string>timestamp-1) ( -- timestamp )
119 "," read-token check-day-name
120 read1 CHAR: \s assert=
121 "-" read-token checked-number
122 "-" read-token month-abbreviations index 1 + check-timestamp
123 read-sp checked-number -rot swap
125 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
127 : cookie-string>timestamp-1 ( str -- timestamp )
128 [ (cookie-string>timestamp-1) ] with-string-reader ;
130 : (cookie-string>timestamp-2) ( -- timestamp )
131 read-sp check-day-name
132 read-sp month-abbreviations index 1 + check-timestamp
133 read-sp checked-number
135 [ read-sp checked-number ] 5 ndip
136 " " read-until drop parse-rfc822-gmt-offset <timestamp> ;
138 : cookie-string>timestamp-2 ( str -- timestamp )
139 [ (cookie-string>timestamp-2) ] with-string-reader ;
141 MACRO: attempt-all-quots ( quots -- quot )
142 dup length 1 = [ first ] [
144 [ nip attempt-all-quots ] curry
148 : cookie-string>timestamp ( str -- timestamp )
150 [ cookie-string>timestamp-1 ]
151 [ cookie-string>timestamp-2 ]
153 } attempt-all-quots ;
155 : (ymdhms>timestamp) ( -- timestamp )
156 read-ymd " " expect read-hms instant <timestamp> ;
158 : ymdhms>timestamp ( str -- timestamp )
159 [ (ymdhms>timestamp) ] with-string-reader ;
161 : (ymd>timestamp) ( -- timestamp )
162 read-ymd <date-gmt> ;
164 : ymd>timestamp ( str -- timestamp )
165 [ (ymd>timestamp) ] with-string-reader ;
168 : hhmm>duration ( hhmm -- duration )
169 [ instant read-00 >>hour read-00 >>minute ] with-string-reader ;
171 : hms>duration ( str -- duration )
172 [ 0 0 0 read-hms <duration> ] with-string-reader ;