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