steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

calendar.elapsed: Support relative times in the future with "3 hours hence" etc. 

Add unix-time>relative-time word for convenience.
db4
Doug Coleman 2015-07-30 09:10:10 -07:00
parent 4e672304b7
commit 3281541d85
2 changed files with 30 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/calendar/elapsed/elapsed-tests.factor
View File

@ -13,8 +13,6 @@ IN: calendar.elapsed.test
{ "1m 1s" } [ 61 elapsed-time ] unit-test
{ "2y 1w 6d 2h 59m 23s" } [ 64033163 elapsed-time ] unit-test
[ -1 relative-time ] [ "negative seconds" = ] must-fail-with
{ "just now" } [ 0 relative-time ] unit-test
{ "less than a minute ago" } [ 10 relative-time ] unit-test
{ "about a minute ago" } [ 60 relative-time ] unit-test

40
extra/calendar/elapsed/elapsed.factor
View File

@ -26,22 +26,42 @@ M: real elapsed-time
M: duration elapsed-time
duration>seconds elapsed-time ;
! XXX: Anything up to 2 hours is "about an hour"
: relative-time-offset ( seconds -- string )
abs {
{ [ dup 1 < ] [ drop "just now" ] }
{ [ dup 60 < ] [ drop "less than a minute" ] }
{ [ dup 120 < ] [ drop "about a minute" ] }
{ [ dup 2700 < ] [ 60 / "%d minutes" sprintf ] }
{ [ dup 7200 < ] [ drop "about an hour" ] }
{ [ dup 86400 < ] [ 3600 /i "%d hours" sprintf ] }
{ [ dup 172800 < ] [ drop "1 day" ] }
[ 86400 / "%d days" sprintf ]
} cond ;
GENERIC: relative-time ( seconds -- string )
M: real relative-time
dup 0 < [ "negative seconds" throw ] when {
{ [ dup 1 < ] [ drop "just now" ] }
{ [ dup 60 < ] [ drop "less than a minute ago" ] }
{ [ dup 120 < ] [ drop "about a minute ago" ] }
{ [ dup 2700 < ] [ 60 / "%d minutes ago" sprintf ] }
{ [ dup 5400 < ] [ drop "about an hour ago" ] }
{ [ dup 86400 < ] [ 3600 / "%d hours ago" sprintf ] }
{ [ dup 172800 < ] [ drop "1 day ago" ] }
[ 86400 / "%d days ago" sprintf ]
} cond ;
[ relative-time-offset ] [
dup abs 1 < [
drop
] [
0 < "hence" "ago" ? " " glue
] if
] bi ;
M: duration relative-time
duration>seconds relative-time ;
M: timestamp relative-time
now swap time- relative-time ;
GENERIC: unix-time>relative-time ( unix-seconds -- string )
M: real unix-time>relative-time
seconds since-1970 unix-time>relative-time ;
M: timestamp unix-time>relative-time
[ now ] dip
time- duration>seconds relative-time ;