calendar.ranges: supporting reverse ranges

diff --git a/extra/calendar/ranges/ranges-tests.factor b/extra/calendar/ranges/ranges-tests.factor
index 23b6e66439ee77fc926e06928b1ca3c14a3da8bc..71de175d5c5d61718e723538ab57698c295a7215 100644 (file)
--- a/extra/calendar/ranges/ranges-tests.factor
+++ b/extra/calendar/ranges/ranges-tests.factor
@@ -1,5 +1,19 @@
 USING: arrays calendar calendar.ranges kernel tools.test ;
 
+! from>to (empty)
+{ { } } [
+    now-utc dup 10 minutes time- 1 seconds <timestamp-range> >array
+] unit-test
+
+! from=to (length=1)
+{ t } [
+    now-utc
+    [ 1array ] [ dup 1 seconds <timestamp-range> >array ] bi
+    =
+] unit-test
+
+
+! forwards
 {
     {
         T{ timestamp { year 2023 } { month 6 } { day 21 } }
@@ -10,14 +24,26 @@ USING: arrays calendar calendar.ranges kernel tools.test ;
         T{ timestamp { year 2023 } { month 6 } { day 26 } }
         T{ timestamp { year 2023 } { month 6 } { day 27 } }
         T{ timestamp { year 2023 } { month 6 } { day 28 } }
-        T{ timestamp { year 2023 } { month 6 } { day 29 } }
-        T{ timestamp { year 2023 } { month 6 } { day 30 } }
-        T{ timestamp { year 2023 } { month 7 } { day 1 } }
-        T{ timestamp { year 2023 } { month 7 } { day 2 } }
-        T{ timestamp { year 2023 } { month 7 } { day 3 } }
-        T{ timestamp { year 2023 } { month 7 } { day 4 } }
     }
 } [
-    2023 06 21 <date-utc> dup 2 weeks time+
+    2023 06 21 <date-utc> dup 1 weeks time+
     1 days <timestamp-range> >array
 ] unit-test
+
+! backwards
+{
+    {
+        T{ timestamp { year 2023 } { month 6 } { day 21 } }
+        T{ timestamp { year 2023 } { month 6 } { day 20 } }
+        T{ timestamp { year 2023 } { month 6 } { day 19 } }
+        T{ timestamp { year 2023 } { month 6 } { day 18 } }
+        T{ timestamp { year 2023 } { month 6 } { day 17 } }
+        T{ timestamp { year 2023 } { month 6 } { day 16 } }
+        T{ timestamp { year 2023 } { month 6 } { day 15 } }
+        T{ timestamp { year 2023 } { month 6 } { day 14 } }
+    }
+} [
+    2023 06 21 <date-utc> dup 1 weeks time-
+    -1 days <timestamp-range> >array
+] unit-test
+

diff --git a/extra/calendar/ranges/ranges.factor b/extra/calendar/ranges/ranges.factor
index 7168416c15c2197132462ab3ec5c853368704f5b..042cba91be0677aa8a7ffea244df3947feb7096a 100644 (file)
--- a/extra/calendar/ranges/ranges.factor
+++ b/extra/calendar/ranges/ranges.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2023 John Benediktsson
 ! See https://factorcode.org/license.txt for BSD license
 
-USING: accessors calendar kernel math math.functions sequences
-sequences.private ;
+USING: accessors calendar kernel math math.order ranges.private
+sequences sequences.private ;
 
 IN: calendar.ranges
 
@@ -11,12 +11,10 @@ TUPLE: timestamp-range
     { length integer read-only }
     { step duration read-only } ;
 
-:: <timestamp-range> ( from to step -- timestamp-range )
-    from
-    to from time- step [ duration>seconds ] bi@ /f floor >integer
-    step
-    timestamp-range boa ;
-
+: <timestamp-range> ( from to step -- timestamp-range )
+    [ over time- ] dip [
+        [ duration>seconds ] bi@ sign/mod 0 < [ 1 + ] unless 0 max
+    ] keep timestamp-range boa ;
 
 M: timestamp-range length length>> ;