M: number +second
over second>> + seconds/minutes [ >>second ] dip +minute ;
-: (time+) ( timestamp duration -- timestamp duration )
+: (time+) ( timestamp duration -- timestamp )
{
[ second>> +second ]
[ minute>> +minute ]
[ day>> +day ]
[ month>> +month ]
[ year>> +year ]
- [ ]
} cleave ; inline
PRIVATE>
GENERIC#: time+ 1 ( time1 time2 -- time3 )
-M: timestamp time+
- [ clone ] dip (time+) drop ;
+M: timestamp time+ [ clone ] dip (time+) ;
: duration+ ( duration1 duration2 -- duration3 )
{
gmt-offset-duration >>gmt-offset ; inline
: convert-timezone ( timestamp duration -- timestamp )
- [ over gmt-offset>> time- (time+) drop ] [ >>gmt-offset ] bi ;
+ [ over gmt-offset>> time- (time+) ] [ >>gmt-offset ] bi ;
: >local-time ( timestamp -- timestamp )
gmt-offset-duration convert-timezone ;
unix-1970 (time-) 1000000 * >integer ;
: now ( -- timestamp )
- now-gmt gmt-offset-duration (time+) >>gmt-offset ;
+ now-gmt gmt-offset-duration [ (time+) ] [ >>gmt-offset ] bi ;
: hence ( duration -- timestamp ) now swap time+ ;
: ago ( duration -- timestamp ) now swap time- ;
over day-of-week - ; inline
: day-this-week ( timestamp n -- timestamp )
- day-offset days (time+) drop ;
+ day-offset days (time+) ;
: closest-day ( timestamp n -- timestamp )
{ 0 1 2 3 -3 -2 -1 } pick day-of-week 7 swap -
- <rotated> nth days (time+) drop ;
+ <rotated> nth days (time+) ;
:: nth-day-this-month ( timestamp n day -- timestamp )
timestamp clone
timestamp start-of-month day day-this-week
[ [ month>> ] same? ] keep swap
- [ 1 weeks (time+) drop ] unless
- n [ weeks (time+) drop ] unless-zero ;
+ [ 1 weeks (time+) ] unless
+ n [ weeks (time+) ] unless-zero ;
PRIVATE>
ALIAS: last-day-of-week saturday
: day< ( timestamp quot -- timestamp )
- over clone [ call dup ] dip after=? [ -7 days (time+) drop ] when ; inline
+ over clone [ call dup ] dip after=? [ -7 days (time+) ] when ; inline
: day<= ( timestamp quot -- timestamp )
- over clone [ call dup ] dip after? [ -7 days (time+) drop ] when ; inline
+ over clone [ call dup ] dip after? [ -7 days (time+) ] when ; inline
: day> ( timestamp quot -- timestamp )
- over clone [ call dup ] dip before=? [ 7 days (time+) drop ] when ; inline
+ over clone [ call dup ] dip before=? [ 7 days (time+) ] when ; inline
: day>= ( timestamp quot -- timestamp )
- over clone [ call dup ] dip before? [ 7 days (time+) drop ] when ; inline
+ over clone [ call dup ] dip before? [ 7 days (time+) ] when ; inline
: sunday< ( timestamp -- timestamp ) [ sunday ] day< ;
: monday< ( timestamp -- timestamp ) [ monday ] day< ;
: same-or-next-business-day ( timestamp -- timestamp )
dup day-of-week {
{ 0 [ monday ] }
- { 6 [ 2 days (time+) drop ] }
+ { 6 [ 2 days (time+) ] }
[ drop ]
} case ;
: same-or-previous-business-day ( timestamp -- timestamp )
dup day-of-week {
- { 0 [ -2 days (time+) drop ] }
+ { 0 [ -2 days (time+) ] }
{ 6 [ friday ] }
[ drop ]
} case ;
instant swap >time< set-time ;
: since-1970 ( duration -- timestamp )
- unix-1970 swap (time+) drop ; inline
+ unix-1970 swap (time+) ; inline
: timestamp>unix-time ( timestamp -- seconds )
unix-1970 (time-) ; inline