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