From b6439e3cbaff3337fd19ead786a44e6ba973e076 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 24 Apr 2013 08:22:33 -0700 Subject: [PATCH] calendar.format: run dos2unix on calendar.format --- basis/calendar/format/format-tests.factor | 192 +++---- basis/calendar/format/format.factor | 664 +++++++++++----------- 2 files changed, 428 insertions(+), 428 deletions(-) diff --git a/basis/calendar/format/format-tests.factor b/basis/calendar/format/format-tests.factor index 4fee482df5..a4d20492ba 100644 --- a/basis/calendar/format/format-tests.factor +++ b/basis/calendar/format/format-tests.factor @@ -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 diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index e6e30136e7..206b1422bb 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -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 - ] 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 " " "" 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 - ; - -: 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 ; - -: ymdhms>timestamp ( str -- timestamp ) - [ (ymdhms>timestamp) ] with-string-reader ; - -: (hms>timestamp) ( -- timestamp ) - 0 0 0 read-hms instant ; - -: hms>timestamp ( str -- timestamp ) - [ (hms>timestamp) ] with-string-reader ; - -: (ymd>timestamp) ( -- timestamp ) - read-ymd ; - -: 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 + ] 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 " " "" 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 + ; + +: 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 ; + +: ymdhms>timestamp ( str -- timestamp ) + [ (ymdhms>timestamp) ] with-string-reader ; + +: (hms>timestamp) ( -- timestamp ) + 0 0 0 read-hms instant ; + +: hms>timestamp ( str -- timestamp ) + [ (hms>timestamp) ] with-string-reader ; + +: (ymd>timestamp) ( -- timestamp ) + read-ymd ; + +: 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 ;