calendar.format: run dos2unix on calendar.format
Doug Coleman
parent
9f28391e6b
commit
b6439e3cba
|
|
@ -1,96 +1,96 @@
|
|||
USING: calendar.format calendar kernel math tools.test
|
||||
io.streams.string accessors io math.order sequences ;
|
||||
IN: calendar.format.tests
|
||||
|
||||
[ 0 ] [
|
||||
"Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
"+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ -1 ] [
|
||||
"-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ -1-1/2 ] [
|
||||
"-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ 1+1/2 ] [
|
||||
"+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ ] [ now timestamp>rfc3339 drop ] unit-test
|
||||
[ ] [ now timestamp>rfc822 drop ] unit-test
|
||||
|
||||
[ 8/1000 -4 ] [
|
||||
"2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
|
||||
[ second>> ] [ gmt-offset>> hour>> ] bi
|
||||
] unit-test
|
||||
|
||||
[ T{ duration f 0 0 0 0 0 0 } ] [
|
||||
"GMT" parse-rfc822-gmt-offset
|
||||
] unit-test
|
||||
|
||||
[ T{ duration f 0 0 0 -5 0 0 } ] [
|
||||
"-0500" parse-rfc822-gmt-offset
|
||||
] unit-test
|
||||
|
||||
[ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } ] [
|
||||
"Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
|
||||
] unit-test
|
||||
|
||||
[ t ] [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
|
||||
|
||||
[ t ] [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
|
||||
|
||||
[ "Sun, 4 May 2008 07:00:00" ] [
|
||||
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
|
||||
timestamp>string
|
||||
] unit-test
|
||||
|
||||
[ "20080504070000" ] [
|
||||
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
|
||||
timestamp>mdtm
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp f
|
||||
2008
|
||||
5
|
||||
26
|
||||
0
|
||||
37
|
||||
42+2469/20000
|
||||
T{ duration f 0 0 0 -5 0 0 }
|
||||
}
|
||||
] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp
|
||||
{ year 2008 }
|
||||
{ month 10 }
|
||||
{ day 2 }
|
||||
{ hour 23 }
|
||||
{ minute 59 }
|
||||
{ second 59 }
|
||||
{ gmt-offset T{ duration f 0 0 0 0 0 0 } }
|
||||
}
|
||||
] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
|
||||
|
||||
|
||||
[ ]
|
||||
[ { 2008 2009 } [ year. ] each ] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp
|
||||
{ year 2013 }
|
||||
{ month 4 }
|
||||
{ day 23 }
|
||||
{ hour 13 }
|
||||
{ minute 50 }
|
||||
{ second 24 }
|
||||
}
|
||||
] [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
|
||||
USING: calendar.format calendar kernel math tools.test
|
||||
io.streams.string accessors io math.order sequences ;
|
||||
IN: calendar.format.tests
|
||||
|
||||
[ 0 ] [
|
||||
"Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ 1 ] [
|
||||
"+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ -1 ] [
|
||||
"-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ -1-1/2 ] [
|
||||
"-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ 1+1/2 ] [
|
||||
"+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
|
||||
] unit-test
|
||||
|
||||
[ ] [ now timestamp>rfc3339 drop ] unit-test
|
||||
[ ] [ now timestamp>rfc822 drop ] unit-test
|
||||
|
||||
[ 8/1000 -4 ] [
|
||||
"2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
|
||||
[ second>> ] [ gmt-offset>> hour>> ] bi
|
||||
] unit-test
|
||||
|
||||
[ T{ duration f 0 0 0 0 0 0 } ] [
|
||||
"GMT" parse-rfc822-gmt-offset
|
||||
] unit-test
|
||||
|
||||
[ T{ duration f 0 0 0 -5 0 0 } ] [
|
||||
"-0500" parse-rfc822-gmt-offset
|
||||
] unit-test
|
||||
|
||||
[ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } ] [
|
||||
"Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
|
||||
] unit-test
|
||||
|
||||
[ t ] [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
|
||||
|
||||
[ t ] [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
|
||||
|
||||
[ "Sun, 4 May 2008 07:00:00" ] [
|
||||
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
|
||||
timestamp>string
|
||||
] unit-test
|
||||
|
||||
[ "20080504070000" ] [
|
||||
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
|
||||
timestamp>mdtm
|
||||
] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp f
|
||||
2008
|
||||
5
|
||||
26
|
||||
0
|
||||
37
|
||||
42+2469/20000
|
||||
T{ duration f 0 0 0 -5 0 0 }
|
||||
}
|
||||
] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp
|
||||
{ year 2008 }
|
||||
{ month 10 }
|
||||
{ day 2 }
|
||||
{ hour 23 }
|
||||
{ minute 59 }
|
||||
{ second 59 }
|
||||
{ gmt-offset T{ duration f 0 0 0 0 0 0 } }
|
||||
}
|
||||
] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
|
||||
|
||||
|
||||
[ ]
|
||||
[ { 2008 2009 } [ year. ] each ] unit-test
|
||||
|
||||
[
|
||||
T{ timestamp
|
||||
{ year 2013 }
|
||||
{ month 4 }
|
||||
{ day 23 }
|
||||
{ hour 13 }
|
||||
{ minute 50 }
|
||||
{ second 24 }
|
||||
}
|
||||
] [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,332 +1,332 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays calendar calendar.format.macros
|
||||
combinators io io.streams.string kernel math math.functions
|
||||
math.order math.parser present sequences typed ;
|
||||
IN: calendar.format
|
||||
|
||||
: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
|
||||
|
||||
: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
|
||||
|
||||
: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
|
||||
|
||||
: write-00 ( n -- ) pad-00 write ;
|
||||
|
||||
: write-0000 ( n -- ) pad-0000 write ;
|
||||
|
||||
: write-00000 ( n -- ) pad-00000 write ;
|
||||
|
||||
: hh ( time -- ) hour>> write-00 ;
|
||||
|
||||
: mm ( time -- ) minute>> write-00 ;
|
||||
|
||||
: ss ( time -- ) second>> >integer write-00 ;
|
||||
|
||||
: D ( time -- ) day>> number>string write ;
|
||||
|
||||
: DD ( time -- ) day>> write-00 ;
|
||||
|
||||
: DAY ( time -- ) day-of-week day-abbreviation3 write ;
|
||||
|
||||
: MM ( time -- ) month>> write-00 ;
|
||||
|
||||
: MONTH ( time -- ) month>> month-abbreviation write ;
|
||||
|
||||
: YYYY ( time -- ) year>> write-0000 ;
|
||||
|
||||
: YYYYY ( time -- ) year>> write-00000 ;
|
||||
|
||||
: expect ( str -- )
|
||||
read1 swap member? [ "Parse error" throw ] unless ;
|
||||
|
||||
: read-00 ( -- n ) 2 read string>number ;
|
||||
|
||||
: read-000 ( -- n ) 3 read string>number ;
|
||||
|
||||
: read-0000 ( -- n ) 4 read string>number ;
|
||||
|
||||
: hhmm>timestamp ( hhmm -- timestamp )
|
||||
[
|
||||
0 0 0 read-00 read-00 0 instant <timestamp>
|
||||
] with-string-reader ;
|
||||
|
||||
GENERIC: day. ( obj -- )
|
||||
|
||||
M: integer day. ( n -- )
|
||||
number>string dup length 2 < [ bl ] when write ;
|
||||
|
||||
M: timestamp day. ( timestamp -- )
|
||||
day>> day. ;
|
||||
|
||||
GENERIC: month. ( obj -- )
|
||||
|
||||
M: array month. ( pair -- )
|
||||
first2
|
||||
[ month-name write bl number>string print ]
|
||||
[ 1 zeller-congruence ]
|
||||
[ (days-in-month) day-abbreviations2 " " join print ] 2tri
|
||||
over " " <repetition> "" concat-as write
|
||||
[
|
||||
[ 1 + day. ] keep
|
||||
1 + + 7 mod zero? [ nl ] [ bl ] if
|
||||
] with each-integer nl ;
|
||||
|
||||
M: timestamp month. ( timestamp -- )
|
||||
[ year>> ] [ month>> ] bi 2array month. ;
|
||||
|
||||
GENERIC: year. ( obj -- )
|
||||
|
||||
M: integer year. ( n -- )
|
||||
12 [ 1 + 2array month. nl ] with each-integer ;
|
||||
|
||||
M: timestamp year. ( timestamp -- )
|
||||
year>> year. ;
|
||||
|
||||
: timestamp>mdtm ( timestamp -- str )
|
||||
[ { YYYY MM DD hh mm ss } formatted ] with-string-writer ;
|
||||
|
||||
: (timestamp>string) ( timestamp -- )
|
||||
{ DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss } formatted ;
|
||||
|
||||
: timestamp>string ( timestamp -- str )
|
||||
[ (timestamp>string) ] with-string-writer ;
|
||||
|
||||
: (write-gmt-offset) ( duration -- )
|
||||
[ hh ] [ mm ] bi ;
|
||||
|
||||
: write-gmt-offset ( gmt-offset -- )
|
||||
dup instant <=> {
|
||||
{ +eq+ [ drop "GMT" write ] }
|
||||
{ +lt+ [ "-" write before (write-gmt-offset) ] }
|
||||
{ +gt+ [ "+" write (write-gmt-offset) ] }
|
||||
} case ;
|
||||
|
||||
: timestamp>rfc822 ( timestamp -- str )
|
||||
#! RFC822 timestamp format
|
||||
#! Example: Tue, 15 Nov 1994 08:12:31 +0200
|
||||
[
|
||||
[ (timestamp>string) bl ]
|
||||
[ gmt-offset>> write-gmt-offset ]
|
||||
bi
|
||||
] with-string-writer ;
|
||||
|
||||
: timestamp>http-string ( timestamp -- str )
|
||||
#! http timestamp format
|
||||
#! Example: Tue, 15 Nov 1994 08:12:31 GMT
|
||||
>gmt timestamp>rfc822 ;
|
||||
|
||||
: (timestamp>cookie-string) ( timestamp -- )
|
||||
>gmt
|
||||
{ DAY ", " DD "-" MONTH "-" YYYY " " hh ":" mm ":" ss " GMT" } formatted ;
|
||||
|
||||
: timestamp>cookie-string ( timestamp -- str )
|
||||
[ (timestamp>cookie-string) ] with-string-writer ;
|
||||
|
||||
: (write-rfc3339-gmt-offset) ( duration -- )
|
||||
[ hh ":" write ] [ mm ] bi ;
|
||||
|
||||
: write-rfc3339-gmt-offset ( duration -- )
|
||||
dup instant <=> {
|
||||
{ +eq+ [ drop "Z" write ] }
|
||||
{ +lt+ [ "-" write before (write-rfc3339-gmt-offset) ] }
|
||||
{ +gt+ [ "+" write (write-rfc3339-gmt-offset) ] }
|
||||
} case ;
|
||||
|
||||
: (timestamp>rfc3339) ( timestamp -- )
|
||||
{
|
||||
YYYY "-" MM "-" DD "T" hh ":" mm ":" ss
|
||||
[ gmt-offset>> write-rfc3339-gmt-offset ]
|
||||
} formatted ;
|
||||
|
||||
: timestamp>rfc3339 ( timestamp -- str )
|
||||
[ (timestamp>rfc3339) ] with-string-writer ;
|
||||
|
||||
: signed-gmt-offset ( dt ch -- dt' )
|
||||
{ { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
|
||||
|
||||
: read-rfc3339-gmt-offset ( ch -- dt )
|
||||
{
|
||||
{ f [ instant ] }
|
||||
{ CHAR: Z [ instant ] }
|
||||
[
|
||||
[
|
||||
read-00 hours
|
||||
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
|
||||
time+
|
||||
] dip signed-gmt-offset
|
||||
]
|
||||
} case ;
|
||||
|
||||
: read-ymd ( -- y m d )
|
||||
read-0000 "-" expect read-00 "-" expect read-00 ;
|
||||
|
||||
: read-hms ( -- h m s )
|
||||
read-00 ":" expect read-00 ":" expect read-00 ;
|
||||
|
||||
: read-rfc3339-seconds ( s -- s' ch )
|
||||
"+-Z" read-until [
|
||||
[ string>number ] [ length 10^ ] bi / +
|
||||
] dip ;
|
||||
|
||||
: (rfc3339>timestamp) ( -- timestamp )
|
||||
read-ymd
|
||||
"Tt" expect
|
||||
read-hms
|
||||
read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
|
||||
read-rfc3339-gmt-offset
|
||||
<timestamp> ;
|
||||
|
||||
: rfc3339>timestamp ( str -- timestamp )
|
||||
[ (rfc3339>timestamp) ] with-string-reader ;
|
||||
|
||||
ERROR: invalid-timestamp-format ;
|
||||
|
||||
: check-timestamp ( obj/f -- obj )
|
||||
[ invalid-timestamp-format ] unless* ;
|
||||
|
||||
: read-token ( seps -- token )
|
||||
[ read-until ] keep member? check-timestamp drop ;
|
||||
|
||||
: read-sp ( -- token ) " " read-token ;
|
||||
|
||||
: checked-number ( str -- n )
|
||||
string>number check-timestamp ;
|
||||
|
||||
: parse-rfc822-gmt-offset ( string -- dt )
|
||||
dup "GMT" = [ drop instant ] [
|
||||
unclip [
|
||||
2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
|
||||
] dip signed-gmt-offset
|
||||
] if ;
|
||||
|
||||
: (rfc822>timestamp) ( -- timestamp )
|
||||
timestamp new
|
||||
"," read-token day-abbreviations3 member? check-timestamp drop
|
||||
read1 CHAR: \s assert=
|
||||
read-sp checked-number >>day
|
||||
read-sp month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: rfc822>timestamp ( str -- timestamp )
|
||||
[ (rfc822>timestamp) ] with-string-reader ;
|
||||
|
||||
: check-day-name ( str -- )
|
||||
[ day-abbreviations3 member? ] [ day-names member? ] bi or
|
||||
check-timestamp drop ;
|
||||
|
||||
: (cookie-string>timestamp-1) ( -- timestamp )
|
||||
timestamp new
|
||||
"," read-token check-day-name
|
||||
read1 CHAR: \s assert=
|
||||
"-" read-token checked-number >>day
|
||||
"-" read-token month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: cookie-string>timestamp-1 ( str -- timestamp )
|
||||
[ (cookie-string>timestamp-1) ] with-string-reader ;
|
||||
|
||||
: (cookie-string>timestamp-2) ( -- timestamp )
|
||||
timestamp new
|
||||
read-sp check-day-name
|
||||
read-sp month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>day
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
read-sp checked-number >>year
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: cookie-string>timestamp-2 ( str -- timestamp )
|
||||
[ (cookie-string>timestamp-2) ] with-string-reader ;
|
||||
|
||||
: cookie-string>timestamp ( str -- timestamp )
|
||||
{
|
||||
[ cookie-string>timestamp-1 ]
|
||||
[ cookie-string>timestamp-2 ]
|
||||
[ rfc822>timestamp ]
|
||||
} attempt-all-quots ;
|
||||
|
||||
: (ymdhms>timestamp) ( -- timestamp )
|
||||
read-ymd " " expect read-hms instant <timestamp> ;
|
||||
|
||||
: ymdhms>timestamp ( str -- timestamp )
|
||||
[ (ymdhms>timestamp) ] with-string-reader ;
|
||||
|
||||
: (hms>timestamp) ( -- timestamp )
|
||||
0 0 0 read-hms instant <timestamp> ;
|
||||
|
||||
: hms>timestamp ( str -- timestamp )
|
||||
[ (hms>timestamp) ] with-string-reader ;
|
||||
|
||||
: (ymd>timestamp) ( -- timestamp )
|
||||
read-ymd <date-gmt> ;
|
||||
|
||||
: ymd>timestamp ( str -- timestamp )
|
||||
[ (ymd>timestamp) ] with-string-reader ;
|
||||
|
||||
: (timestamp>ymd) ( timestamp -- )
|
||||
{ YYYY "-" MM "-" DD } formatted ;
|
||||
|
||||
TYPED: timestamp>ymd ( timestamp: timestamp -- str )
|
||||
[ (timestamp>ymd) ] with-string-writer ;
|
||||
|
||||
: (timestamp>hms) ( timestamp -- )
|
||||
{ hh ":" mm ":" ss } formatted ;
|
||||
|
||||
TYPED: timestamp>hms ( timestamp: timestamp -- str )
|
||||
[ (timestamp>hms) ] with-string-writer ;
|
||||
|
||||
: (timestamp>hm) ( timestamp -- )
|
||||
{ hh ":" mm } formatted ;
|
||||
|
||||
TYPED: timestamp>hm ( timestamp: timestamp -- str )
|
||||
[ (timestamp>hm) ] with-string-writer ;
|
||||
|
||||
TYPED: timestamp>ymdhms ( timestamp: timestamp -- str )
|
||||
[
|
||||
>gmt
|
||||
{ (timestamp>ymd) " " (timestamp>hms) } formatted
|
||||
] with-string-writer ;
|
||||
|
||||
: file-time-string ( timestamp -- string )
|
||||
[
|
||||
{
|
||||
MONTH " " DD " "
|
||||
[
|
||||
dup now [ year>> ] same?
|
||||
[ [ hh ":" write ] [ mm ] bi ] [ YYYYY ] if
|
||||
]
|
||||
} formatted
|
||||
] with-string-writer ;
|
||||
|
||||
M: timestamp present timestamp>string ;
|
||||
|
||||
TYPED: duration>hm ( duration: duration -- string )
|
||||
[ duration>hours >integer 24 mod pad-00 ]
|
||||
[ duration>minutes >integer 60 mod pad-00 ] bi ":" glue ;
|
||||
|
||||
TYPED: duration>human-readable ( duration: duration -- string )
|
||||
[
|
||||
[
|
||||
duration>years >integer
|
||||
[
|
||||
[ number>string write ]
|
||||
[ 1 > " years, " " year, " ? write ] bi
|
||||
] unless-zero
|
||||
] [
|
||||
duration>days >integer 365 mod
|
||||
[
|
||||
[ number>string write ]
|
||||
[ 1 > " days, " " day, " ? write ] bi
|
||||
] unless-zero
|
||||
] [ duration>hm write ] tri
|
||||
] with-string-writer ;
|
||||
! Copyright (C) 2008, 2010 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays calendar calendar.format.macros
|
||||
combinators io io.streams.string kernel math math.functions
|
||||
math.order math.parser present sequences typed ;
|
||||
IN: calendar.format
|
||||
|
||||
: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
|
||||
|
||||
: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
|
||||
|
||||
: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
|
||||
|
||||
: write-00 ( n -- ) pad-00 write ;
|
||||
|
||||
: write-0000 ( n -- ) pad-0000 write ;
|
||||
|
||||
: write-00000 ( n -- ) pad-00000 write ;
|
||||
|
||||
: hh ( time -- ) hour>> write-00 ;
|
||||
|
||||
: mm ( time -- ) minute>> write-00 ;
|
||||
|
||||
: ss ( time -- ) second>> >integer write-00 ;
|
||||
|
||||
: D ( time -- ) day>> number>string write ;
|
||||
|
||||
: DD ( time -- ) day>> write-00 ;
|
||||
|
||||
: DAY ( time -- ) day-of-week day-abbreviation3 write ;
|
||||
|
||||
: MM ( time -- ) month>> write-00 ;
|
||||
|
||||
: MONTH ( time -- ) month>> month-abbreviation write ;
|
||||
|
||||
: YYYY ( time -- ) year>> write-0000 ;
|
||||
|
||||
: YYYYY ( time -- ) year>> write-00000 ;
|
||||
|
||||
: expect ( str -- )
|
||||
read1 swap member? [ "Parse error" throw ] unless ;
|
||||
|
||||
: read-00 ( -- n ) 2 read string>number ;
|
||||
|
||||
: read-000 ( -- n ) 3 read string>number ;
|
||||
|
||||
: read-0000 ( -- n ) 4 read string>number ;
|
||||
|
||||
: hhmm>timestamp ( hhmm -- timestamp )
|
||||
[
|
||||
0 0 0 read-00 read-00 0 instant <timestamp>
|
||||
] with-string-reader ;
|
||||
|
||||
GENERIC: day. ( obj -- )
|
||||
|
||||
M: integer day. ( n -- )
|
||||
number>string dup length 2 < [ bl ] when write ;
|
||||
|
||||
M: timestamp day. ( timestamp -- )
|
||||
day>> day. ;
|
||||
|
||||
GENERIC: month. ( obj -- )
|
||||
|
||||
M: array month. ( pair -- )
|
||||
first2
|
||||
[ month-name write bl number>string print ]
|
||||
[ 1 zeller-congruence ]
|
||||
[ (days-in-month) day-abbreviations2 " " join print ] 2tri
|
||||
over " " <repetition> "" concat-as write
|
||||
[
|
||||
[ 1 + day. ] keep
|
||||
1 + + 7 mod zero? [ nl ] [ bl ] if
|
||||
] with each-integer nl ;
|
||||
|
||||
M: timestamp month. ( timestamp -- )
|
||||
[ year>> ] [ month>> ] bi 2array month. ;
|
||||
|
||||
GENERIC: year. ( obj -- )
|
||||
|
||||
M: integer year. ( n -- )
|
||||
12 [ 1 + 2array month. nl ] with each-integer ;
|
||||
|
||||
M: timestamp year. ( timestamp -- )
|
||||
year>> year. ;
|
||||
|
||||
: timestamp>mdtm ( timestamp -- str )
|
||||
[ { YYYY MM DD hh mm ss } formatted ] with-string-writer ;
|
||||
|
||||
: (timestamp>string) ( timestamp -- )
|
||||
{ DAY ", " D " " MONTH " " YYYY " " hh ":" mm ":" ss } formatted ;
|
||||
|
||||
: timestamp>string ( timestamp -- str )
|
||||
[ (timestamp>string) ] with-string-writer ;
|
||||
|
||||
: (write-gmt-offset) ( duration -- )
|
||||
[ hh ] [ mm ] bi ;
|
||||
|
||||
: write-gmt-offset ( gmt-offset -- )
|
||||
dup instant <=> {
|
||||
{ +eq+ [ drop "GMT" write ] }
|
||||
{ +lt+ [ "-" write before (write-gmt-offset) ] }
|
||||
{ +gt+ [ "+" write (write-gmt-offset) ] }
|
||||
} case ;
|
||||
|
||||
: timestamp>rfc822 ( timestamp -- str )
|
||||
#! RFC822 timestamp format
|
||||
#! Example: Tue, 15 Nov 1994 08:12:31 +0200
|
||||
[
|
||||
[ (timestamp>string) bl ]
|
||||
[ gmt-offset>> write-gmt-offset ]
|
||||
bi
|
||||
] with-string-writer ;
|
||||
|
||||
: timestamp>http-string ( timestamp -- str )
|
||||
#! http timestamp format
|
||||
#! Example: Tue, 15 Nov 1994 08:12:31 GMT
|
||||
>gmt timestamp>rfc822 ;
|
||||
|
||||
: (timestamp>cookie-string) ( timestamp -- )
|
||||
>gmt
|
||||
{ DAY ", " DD "-" MONTH "-" YYYY " " hh ":" mm ":" ss " GMT" } formatted ;
|
||||
|
||||
: timestamp>cookie-string ( timestamp -- str )
|
||||
[ (timestamp>cookie-string) ] with-string-writer ;
|
||||
|
||||
: (write-rfc3339-gmt-offset) ( duration -- )
|
||||
[ hh ":" write ] [ mm ] bi ;
|
||||
|
||||
: write-rfc3339-gmt-offset ( duration -- )
|
||||
dup instant <=> {
|
||||
{ +eq+ [ drop "Z" write ] }
|
||||
{ +lt+ [ "-" write before (write-rfc3339-gmt-offset) ] }
|
||||
{ +gt+ [ "+" write (write-rfc3339-gmt-offset) ] }
|
||||
} case ;
|
||||
|
||||
: (timestamp>rfc3339) ( timestamp -- )
|
||||
{
|
||||
YYYY "-" MM "-" DD "T" hh ":" mm ":" ss
|
||||
[ gmt-offset>> write-rfc3339-gmt-offset ]
|
||||
} formatted ;
|
||||
|
||||
: timestamp>rfc3339 ( timestamp -- str )
|
||||
[ (timestamp>rfc3339) ] with-string-writer ;
|
||||
|
||||
: signed-gmt-offset ( dt ch -- dt' )
|
||||
{ { CHAR: + [ 1 ] } { CHAR: - [ -1 ] } } case time* ;
|
||||
|
||||
: read-rfc3339-gmt-offset ( ch -- dt )
|
||||
{
|
||||
{ f [ instant ] }
|
||||
{ CHAR: Z [ instant ] }
|
||||
[
|
||||
[
|
||||
read-00 hours
|
||||
read1 { { CHAR: : [ read-00 ] } { f [ 0 ] } } case minutes
|
||||
time+
|
||||
] dip signed-gmt-offset
|
||||
]
|
||||
} case ;
|
||||
|
||||
: read-ymd ( -- y m d )
|
||||
read-0000 "-" expect read-00 "-" expect read-00 ;
|
||||
|
||||
: read-hms ( -- h m s )
|
||||
read-00 ":" expect read-00 ":" expect read-00 ;
|
||||
|
||||
: read-rfc3339-seconds ( s -- s' ch )
|
||||
"+-Z" read-until [
|
||||
[ string>number ] [ length 10^ ] bi / +
|
||||
] dip ;
|
||||
|
||||
: (rfc3339>timestamp) ( -- timestamp )
|
||||
read-ymd
|
||||
"Tt" expect
|
||||
read-hms
|
||||
read1 { { CHAR: . [ read-rfc3339-seconds ] } [ ] } case
|
||||
read-rfc3339-gmt-offset
|
||||
<timestamp> ;
|
||||
|
||||
: rfc3339>timestamp ( str -- timestamp )
|
||||
[ (rfc3339>timestamp) ] with-string-reader ;
|
||||
|
||||
ERROR: invalid-timestamp-format ;
|
||||
|
||||
: check-timestamp ( obj/f -- obj )
|
||||
[ invalid-timestamp-format ] unless* ;
|
||||
|
||||
: read-token ( seps -- token )
|
||||
[ read-until ] keep member? check-timestamp drop ;
|
||||
|
||||
: read-sp ( -- token ) " " read-token ;
|
||||
|
||||
: checked-number ( str -- n )
|
||||
string>number check-timestamp ;
|
||||
|
||||
: parse-rfc822-gmt-offset ( string -- dt )
|
||||
dup "GMT" = [ drop instant ] [
|
||||
unclip [
|
||||
2 cut [ string>number ] bi@ [ hours ] [ minutes ] bi* time+
|
||||
] dip signed-gmt-offset
|
||||
] if ;
|
||||
|
||||
: (rfc822>timestamp) ( -- timestamp )
|
||||
timestamp new
|
||||
"," read-token day-abbreviations3 member? check-timestamp drop
|
||||
read1 CHAR: \s assert=
|
||||
read-sp checked-number >>day
|
||||
read-sp month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: rfc822>timestamp ( str -- timestamp )
|
||||
[ (rfc822>timestamp) ] with-string-reader ;
|
||||
|
||||
: check-day-name ( str -- )
|
||||
[ day-abbreviations3 member? ] [ day-names member? ] bi or
|
||||
check-timestamp drop ;
|
||||
|
||||
: (cookie-string>timestamp-1) ( -- timestamp )
|
||||
timestamp new
|
||||
"," read-token check-day-name
|
||||
read1 CHAR: \s assert=
|
||||
"-" read-token checked-number >>day
|
||||
"-" read-token month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>year
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: cookie-string>timestamp-1 ( str -- timestamp )
|
||||
[ (cookie-string>timestamp-1) ] with-string-reader ;
|
||||
|
||||
: (cookie-string>timestamp-2) ( -- timestamp )
|
||||
timestamp new
|
||||
read-sp check-day-name
|
||||
read-sp month-abbreviations index 1 + check-timestamp >>month
|
||||
read-sp checked-number >>day
|
||||
":" read-token checked-number >>hour
|
||||
":" read-token checked-number >>minute
|
||||
read-sp checked-number >>second
|
||||
read-sp checked-number >>year
|
||||
readln parse-rfc822-gmt-offset >>gmt-offset ;
|
||||
|
||||
: cookie-string>timestamp-2 ( str -- timestamp )
|
||||
[ (cookie-string>timestamp-2) ] with-string-reader ;
|
||||
|
||||
: cookie-string>timestamp ( str -- timestamp )
|
||||
{
|
||||
[ cookie-string>timestamp-1 ]
|
||||
[ cookie-string>timestamp-2 ]
|
||||
[ rfc822>timestamp ]
|
||||
} attempt-all-quots ;
|
||||
|
||||
: (ymdhms>timestamp) ( -- timestamp )
|
||||
read-ymd " " expect read-hms instant <timestamp> ;
|
||||
|
||||
: ymdhms>timestamp ( str -- timestamp )
|
||||
[ (ymdhms>timestamp) ] with-string-reader ;
|
||||
|
||||
: (hms>timestamp) ( -- timestamp )
|
||||
0 0 0 read-hms instant <timestamp> ;
|
||||
|
||||
: hms>timestamp ( str -- timestamp )
|
||||
[ (hms>timestamp) ] with-string-reader ;
|
||||
|
||||
: (ymd>timestamp) ( -- timestamp )
|
||||
read-ymd <date-gmt> ;
|
||||
|
||||
: ymd>timestamp ( str -- timestamp )
|
||||
[ (ymd>timestamp) ] with-string-reader ;
|
||||
|
||||
: (timestamp>ymd) ( timestamp -- )
|
||||
{ YYYY "-" MM "-" DD } formatted ;
|
||||
|
||||
TYPED: timestamp>ymd ( timestamp: timestamp -- str )
|
||||
[ (timestamp>ymd) ] with-string-writer ;
|
||||
|
||||
: (timestamp>hms) ( timestamp -- )
|
||||
{ hh ":" mm ":" ss } formatted ;
|
||||
|
||||
TYPED: timestamp>hms ( timestamp: timestamp -- str )
|
||||
[ (timestamp>hms) ] with-string-writer ;
|
||||
|
||||
: (timestamp>hm) ( timestamp -- )
|
||||
{ hh ":" mm } formatted ;
|
||||
|
||||
TYPED: timestamp>hm ( timestamp: timestamp -- str )
|
||||
[ (timestamp>hm) ] with-string-writer ;
|
||||
|
||||
TYPED: timestamp>ymdhms ( timestamp: timestamp -- str )
|
||||
[
|
||||
>gmt
|
||||
{ (timestamp>ymd) " " (timestamp>hms) } formatted
|
||||
] with-string-writer ;
|
||||
|
||||
: file-time-string ( timestamp -- string )
|
||||
[
|
||||
{
|
||||
MONTH " " DD " "
|
||||
[
|
||||
dup now [ year>> ] same?
|
||||
[ [ hh ":" write ] [ mm ] bi ] [ YYYYY ] if
|
||||
]
|
||||
} formatted
|
||||
] with-string-writer ;
|
||||
|
||||
M: timestamp present timestamp>string ;
|
||||
|
||||
TYPED: duration>hm ( duration: duration -- string )
|
||||
[ duration>hours >integer 24 mod pad-00 ]
|
||||
[ duration>minutes >integer 60 mod pad-00 ] bi ":" glue ;
|
||||
|
||||
TYPED: duration>human-readable ( duration: duration -- string )
|
||||
[
|
||||
[
|
||||
duration>years >integer
|
||||
[
|
||||
[ number>string write ]
|
||||
[ 1 > " years, " " year, " ? write ] bi
|
||||
] unless-zero
|
||||
] [
|
||||
duration>days >integer 365 mod
|
||||
[
|
||||
[ number>string write ]
|
||||
[ 1 > " days, " " day, " ? write ] bi
|
||||
] unless-zero
|
||||
] [ duration>hm write ] tri
|
||||
] with-string-writer ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue