factor: trim using lists

[factor.git] / extra / crontab / crontab.factor

diff --git a/extra/crontab/crontab.factor b/extra/crontab/crontab.factor
index 50c9e069516834f7e4279c8ee3c79ef4bc90a8b4..402ec1073bb957011a13dffa852c4a66da57f913 100644 (file)
--- a/extra/crontab/crontab.factor
+++ b/extra/crontab/crontab.factor
@@ -2,11 +2,13 @@
 ! See http://factorcode.org/license.txt for BSD license
 
 USING: accessors arrays ascii assocs calendar calendar.english
-calendar.private combinators io kernel literals locals math
-math.order math.parser math.ranges sequences splitting ;
+calendar.private combinators combinators.short-circuit io kernel
+literals math math.order math.parser ranges sequences splitting ;
 
 IN: crontab
 
+ERROR: invalid-cronentry value ;
+
 :: parse-value ( value quot: ( value -- value' ) seq -- value )
     value {
         { [ CHAR: , over member? ] [
@@ -16,7 +18,7 @@ IN: crontab
             "/" split1 [ quot seq parse-value 0 over length 1 - ] dip
             string>number <range> swap nths ] }
         { [ CHAR: - over member? ] [
-            "-" split1 quot bi@ [a,b] ] }
+            "-" split1 quot bi@ [a..b] ] }
         [ quot call 1array ]
     } cond ; inline recursive
 
@@ -42,67 +44,92 @@ CONSTANT: aliases H{
     { "@hourly"   "0 * * * *" }
 }
 
+: check-cronentry ( cronentry -- cronentry )
+    dup {
+        [ days-of-week>> [ 0 6 between? ] all? ]
+        [ months>> [ 1 12 between? ] all? ]
+        [
+            [ days>> 1 ] [ months>> ] bi [
+                { 0 31 29 31 30 31 30 31 31 30 31 30 31 } nth
+            ] map supremum [ between? ] 2curry all?
+        ]
+        [ minutes>> [ 0 59 between? ] all? ]
+        [ hours>> [ 0 23 between? ] all? ]
+    } 1&& [ invalid-cronentry ] unless ;
+
 : parse-cronentry ( entry -- cronentry )
     " " split1 [ aliases ?at drop ] dip " " glue
     " " split1 " " split1 " " split1 " " split1 " " split1 {
         [ [ string>number ] T{ range f 0 60 1 } parse-value ]
         [ [ string>number ] T{ range f 0 24 1 } parse-value ]
-        [ [ string>number ] T{ range f 0 31 1 } parse-value ]
-        [ [ parse-month ] T{ range f 0 12 1 } parse-value ]
+        [ [ string>number ] T{ range f 1 31 1 } parse-value ]
+        [ [ parse-month ] T{ range f 1 12 1 } parse-value ]
         [ [ parse-day ] T{ range f 0 7 1 } parse-value ]
         [ ]
-    } spread cronentry boa ;
+    } spread cronentry boa check-cronentry ;
 
-:: next-time-after ( cronentry timestamp -- )
+<PRIVATE
 
-    timestamp second>> 0 > [
-        timestamp 0 >>second 1 minutes (time+) 2drop
-    ] when
-
-    timestamp month>> :> month
-    cronentry months>> [ month >= ] find nip [
-        dup month = [ drop f ] [ timestamp month<< t ] if
-    ] [
-        timestamp cronentry months>> first >>month 1 +year
-    ] if* [ cronentry timestamp next-time-after ] when
+:: (next-time-after) ( cronentry timestamp -- )
 
-    timestamp hour>> :> hour
-    cronentry hours>> [ hour >= ] find nip [
-        dup hour = [ drop f ] [
-            timestamp hour<< 0 timestamp minute<< t
-        ] if
-    ] [
-        timestamp cronentry hours>> first >>hour 1 +day
-    ] if* [ cronentry timestamp next-time-after ] when
+    f ! should we keep searching for a matching time
 
-    timestamp minute>> :> minute
-    cronentry minutes>> [ minute >= ] find nip [
-        dup minute = [ drop f ] [ timestamp minute<< t ] if
-    ] [
-        timestamp cronentry minutes>> first >>minute 1 +hour
-    ] if* [ cronentry timestamp next-time-after ] when
+    timestamp month>> :> month
+    cronentry months>> [ month >= ] find nip
+    dup month = [ drop ] [
+        [ cronentry months>> first timestamp 1 +year drop ] unless*
+        timestamp 1 >>day 0 >>hour 0 >>minute month<< drop t
+    ] if
 
     timestamp day-of-week :> weekday
     cronentry days-of-week>> [ weekday >= ] find nip [
         cronentry days-of-week>> first 7 +
-    ] unless* weekday -
+    ] unless* weekday - :> days-to-weekday
 
     timestamp day>> :> day
     cronentry days>> [ day >= ] find nip [
-        day -
-    ] [
-        timestamp 1 months time+
-        cronentry days>> first >>day
-        day-of-year timestamp day-of-year -
-    ] if*
-
-    min [
-        timestamp swap +day drop
-        cronentry timestamp next-time-after
-    ] unless-zero ;
+        cronentry days>> first timestamp days-in-month +
+    ] unless* day - :> days-to-day
+
+    cronentry days-of-week>> T{ range f 0 7 1 } =
+    cronentry days>> T{ range f 1 31 1 } = 2array
+    {
+        { { f t } [ days-to-weekday ] }
+        { { t f } [ days-to-day ] }
+        [ drop days-to-weekday days-to-day min ]
+    } case [
+        timestamp 0 >>hour 0 >>minute swap +day 2drop t
+    ] unless-zero
+
+    timestamp hour>> :> hour
+    cronentry hours>> [ hour >= ] find nip
+    dup hour = [ drop ] [
+        [ cronentry hours>> first timestamp 1 +day drop ] unless*
+        timestamp 0 >>minute hour<< drop t
+    ] if
+
+    timestamp minute>> :> minute
+    cronentry minutes>> [ minute >= ] find nip
+    dup minute = [ drop ] [
+        [ cronentry minutes>> first timestamp 1 +hour drop ] unless*
+        timestamp minute<< drop t
+    ] if
+
+    [ cronentry timestamp (next-time-after) ] when ;
+
+PRIVATE>
+
+: next-time-after ( cronentry timestamp -- timestamp )
+    1 minutes time+ 0 >>second [ (next-time-after) ] keep ;
 
 : next-time ( cronentry -- timestamp )
-    now [ next-time-after ] keep ;
+    now next-time-after ;
+
+: next-times-after ( cronentry n timestamp -- timestamps )
+    swap [ dupd next-time-after dup ] replicate 2nip ;
+
+: next-times ( cronentry n -- timestamps )
+    now next-times-after ;
 
-: parse-crontab ( -- entries )
-    lines harvest [ parse-cronentry ] map ;
+: read-crontab ( -- entries )
+    read-lines harvest [ parse-cronentry ] map ;