Commit33abe2c6Recorded18 Mar 2026Repositorysigil-later

Initial sigil-later: cron parsing, time matching, and async task runner

Message

Two-layer library:

- (sigil later) — pure functions: parse-cron-string, later-matches?, later-next. Supports *, ranges, lists, steps, named days/months.

- (sigil later runner) — async integration: make-later-runner, later-every! for recurring tasks, later-once! for deferred tasks, later-run for use within (go ...) blocks.

15 tests covering parsing, matching, and next-occurrence finding.

Changed
 .gitignore                 |   1 +
 dev-redirects.sgl          |   6 +++++
 package.sgl                |  26 ++++++++++++++++++++
 src/sigil/later.sgl        | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/later/runner.sgl | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-later.sgl        | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 491 insertions(+)
Diff
.gitignoreadded
@@ -0,0 +1 @@
+1
build/
dev-redirects.sgladded
@@ -0,0 +1,6 @@
+1
;; Development redirects — point dependencies at local Sigil checkout
+2
(redirects
+3
repos: (list
+4
(for-repo
+5
url: "codeberg:sigil/sigil"
+6
use: (from-path dir: "../sigil"))))
package.sgladded
@@ -0,0 +1,26 @@
+1
;;; sigil-later - Time-based task scheduling
+2
;;;
+3
;;; Provides cron expression parsing and a recurring/one-time task runner
+4
;;; that integrates with (sigil async). Use for periodic agent invocation,
+5
;;; background maintenance, scheduled events, and deferred execution.
+6
+7
(define sigil-repo "codeberg:sigil/sigil")
+8
+9
(package
+10
name: "sigil-later"
+11
version: "0.1.0"
+12
description: "Time-based task scheduling with cron expressions"
+13
url: "https://codeberg.org/sigil/sigil-later"
+14
license: "BSD-3-Clause"
+15
authors: (list "David Wilson <[email protected]>")
+16
+17
dependencies: (list
+18
(from-git url: sigil-repo package: "sigil-stdlib"))
+19
+20
tasks: (list
+21
(task
+22
name: 'build
+23
description: "Compile sigil-later modules"
+24
steps: (list
+25
(compile-sigil-modules sources: "src/**/*.sgl"
+26
output-dir: (config-output-subdir "lib"))))))
src/sigil/later.sgladded
@@ -0,0 +1,216 @@
+1
;;; (sigil later) - Cron expression parsing and time matching.
+2
;;;
+3
;;; Parses standard 5-field cron expressions into schedule structs
+4
;;; and provides pure functions for testing timestamps against them.
+5
;;;
+6
;;; ```scheme
+7
;;; (let ((sched (parse-cron-string "*/5 * * * *")))
+8
;;; (later-matches? sched (current-second))
+9
;;; (later-next sched (current-second)))
+10
;;; ```
+11
+12
(define-library (sigil later)
+13
(import (sigil core)
+14
(sigil struct)
+15
(sigil string)
+16
(sigil math)
+17
(sigil time))
+18
(export parse-cron-string
+19
later-schedule?
+20
later-schedule-minutes
+21
later-schedule-hours
+22
later-schedule-days-of-month
+23
later-schedule-months
+24
later-schedule-days-of-week
+25
later-matches?
+26
later-next)
+27
(begin
+28
+29
;; ============================================================
+30
;; Schedule Struct
+31
;; ============================================================
+32
+33
(define-struct later-schedule
+34
(minutes) ;; sorted list of 0-59
+35
(hours) ;; sorted list of 0-23
+36
(days-of-month) ;; sorted list of 1-31
+37
(months) ;; sorted list of 1-12
+38
(days-of-week)) ;; sorted list of 0-6 (0=Sunday)
+39
+40
;; ============================================================
+41
;; Named Value Maps
+42
;; ============================================================
+43
+44
(define day-names
+45
'(("SUN" . 0) ("MON" . 1) ("TUE" . 2) ("WED" . 3)
+46
("THU" . 4) ("FRI" . 5) ("SAT" . 6)))
+47
+48
(define month-names
+49
'(("JAN" . 1) ("FEB" . 2) ("MAR" . 3) ("APR" . 4)
+50
("MAY" . 5) ("JUN" . 6) ("JUL" . 7) ("AUG" . 8)
+51
("SEP" . 9) ("OCT" . 10) ("NOV" . 11) ("DEC" . 12)))
+52
+53
;; ============================================================
+54
;; Parsing
+55
;; ============================================================
+56
+57
;;; Parse a standard 5-field cron string into a schedule.
+58
;;;
+59
;;; Fields: minute hour day-of-month month day-of-week
+60
;;;
+61
;;; Supports: *, numbers, ranges (1-5), lists (1,3,5),
+62
;;; steps (*/5, 1-10/2), named days (MON-FRI), named months (JAN-DEC).
+63
(define (parse-cron-string str)
+64
(: string? -> later-schedule?)
+65
(let ((fields (string-split (string-trim str) " ")))
+66
(when (not (= (length fields) 5))
+67
(error (format "Invalid cron expression: expected 5 fields, got ~a" (length fields))))
+68
(later-schedule
+69
minutes: (parse-field (list-ref fields 0) 0 59 '())
+70
hours: (parse-field (list-ref fields 1) 0 23 '())
+71
days-of-month: (parse-field (list-ref fields 2) 1 31 '())
+72
months: (parse-field (list-ref fields 3) 1 12 month-names)
+73
days-of-week: (parse-field (list-ref fields 4) 0 6 day-names))))
+74
+75
;; Parse a single cron field into a sorted list of allowed values.
+76
(define (parse-field field min-val max-val names)
+77
(let ((parts (string-split field ",")))
+78
(dedup-sorted
+79
(apply append
+80
(map (lambda (part) (parse-field-part part min-val max-val names))
+81
parts)))))
+82
+83
;; Parse one part of a comma-separated cron field.
+84
;; Handles: *, N, N-M, */S, N-M/S, NAME, NAME-NAME
+85
(define (parse-field-part part min-val max-val names)
+86
(cond
+87
;; Step: */S or N-M/S
+88
((string-contains? part "/")
+89
(let* ((pieces (string-split part "/"))
+90
(range-str (car pieces))
+91
(step (string->number (cadr pieces)))
+92
(range (if (string=? range-str "*")
+93
(cons min-val max-val)
+94
(parse-range range-str min-val max-val names))))
+95
(range-with-step (car range) (cdr range) step)))
+96
;; Wildcard
+97
((string=? part "*")
+98
(iota (+ 1 (- max-val min-val)) min-val))
+99
;; Range: N-M or NAME-NAME
+100
((string-contains? part "-")
+101
(let ((range (parse-range part min-val max-val names)))
+102
(iota (+ 1 (- (cdr range) (car range))) (car range))))
+103
;; Named value
+104
((resolve-name part names)
+105
=> (lambda (val) (list val)))
+106
;; Single number
+107
(else
+108
(let ((n (string->number part)))
+109
(if n (list n)
+110
(error (format "Invalid cron field value: ~a" part)))))))
+111
+112
;; Parse a range string "N-M" or "NAME-NAME" into (start . end).
+113
(define (parse-range str min-val max-val names)
+114
(let* ((pieces (string-split str "-"))
+115
(start-str (car pieces))
+116
(end-str (cadr pieces))
+117
(start (or (resolve-name start-str names)
+118
(string->number start-str)))
+119
(end (or (resolve-name end-str names)
+120
(string->number end-str))))
+121
(when (not (and start end))
+122
(error (format "Invalid cron range: ~a" str)))
+123
(cons start end)))
+124
+125
;; Look up a named value (case-insensitive).
+126
(define (resolve-name str names)
+127
(let ((upper (string-upcase str)))
+128
(let loop ((remaining names))
+129
(cond
+130
((null? remaining) #f)
+131
((string=? (caar remaining) upper) (cdar remaining))
+132
(else (loop (cdr remaining)))))))
+133
+134
;; Generate values from start to end with a step.
+135
(define (range-with-step start end step)
+136
(let loop ((val start) (acc '()))
+137
(if (> val end)
+138
(reverse acc)
+139
(loop (+ val step) (cons val acc)))))
+140
+141
;; Remove duplicates from a list and sort ascending.
+142
(define (dedup-sorted lst)
+143
(if (null? lst) '()
+144
(let ((sorted (insertion-sort < lst)))
+145
(let loop ((rest (cdr sorted)) (prev (car sorted)) (acc (list (car sorted))))
+146
(cond
+147
((null? rest) (reverse acc))
+148
((= (car rest) prev) (loop (cdr rest) prev acc))
+149
(else (loop (cdr rest) (car rest) (cons (car rest) acc))))))))
+150
+151
;; Simple insertion sort for small integer lists.
+152
(define (insertion-sort less? lst)
+153
(define (insert x sorted)
+154
(cond
+155
((null? sorted) (list x))
+156
((less? x (car sorted)) (cons x sorted))
+157
(else (cons (car sorted) (insert x (cdr sorted))))))
+158
(fold-left (lambda (sorted x) (insert x sorted)) '() lst))
+159
+160
;; ============================================================
+161
;; Matching
+162
;; ============================================================
+163
+164
;;; Test whether a Unix timestamp matches a cron schedule.
+165
(define (later-matches? sched ts)
+166
(: later-schedule? number? -> boolean?)
+167
(let ((min (time-minute ts))
+168
(hr (time-hour ts))
+169
(dom (time-day ts))
+170
(mon (time-month ts))
+171
(dow (time-weekday ts)))
+172
(and (memv min (later-schedule-minutes sched))
+173
(memv hr (later-schedule-hours sched))
+174
(memv dom (later-schedule-days-of-month sched))
+175
(memv mon (later-schedule-months sched))
+176
(memv dow (later-schedule-days-of-week sched))
+177
#t)))
+178
+179
;; ============================================================
+180
;; Next Match
+181
;; ============================================================
+182
+183
;;; Find the next timestamp after `ts` that matches the schedule.
+184
;;;
+185
;;; Searches minute-by-minute, jumping forward when higher-order
+186
;;; fields don't match. Returns a Unix timestamp or #f if no match
+187
;;; is found within 366 days.
+188
(define (later-next sched ts)
+189
(: later-schedule? number? -> (maybe number?))
+190
;; Round up to the start of the next minute
+191
(let ((start (+ ts (- 60 (modulo (exact (floor ts)) 60)))))
+192
(let ((limit (+ start (* 366 24 60 60))))
+193
(let loop ((candidate start))
+194
(cond
+195
((> candidate limit) #f)
+196
((later-matches? sched candidate) candidate)
+197
(else
+198
;; Jump forward intelligently
+199
(let ((mon (time-month candidate))
+200
(dom (time-day candidate))
+201
(hr (time-hour candidate))
+202
(min (time-minute candidate)))
+203
(cond
+204
;; Wrong month — skip to next month
+205
((not (memv mon (later-schedule-months sched)))
+206
(loop (+ candidate (* (- 32 dom) 24 60 60))))
+207
;; Wrong day — skip to next day
+208
((or (not (memv dom (later-schedule-days-of-month sched)))
+209
(not (memv (time-weekday candidate) (later-schedule-days-of-week sched))))
+210
(loop (+ candidate (* (- 24 hr) 60 60))))
+211
;; Wrong hour — skip to next hour
+212
((not (memv hr (later-schedule-hours sched)))
+213
(loop (+ candidate (* (- 60 min) 60))))
+214
;; Wrong minute — advance one minute
+215
(else
+216
(loop (+ candidate 60)))))))))))))
src/sigil/later/runner.sgladded
@@ -0,0 +1,134 @@
+1
;;; (sigil later runner) - Async task runner for scheduled tasks.
+2
;;;
+3
;;; Integrates with (sigil async) to run recurring and one-time tasks.
+4
;;; Use within a `with-async` block via `(go (later-run runner))`.
+5
;;;
+6
;;; ```scheme
+7
;;; (let ((runner (make-later-runner)))
+8
;;; (later-every! runner "*/5 * * * *" "check-inbox"
+9
;;; (lambda () (check-inbox)))
+10
;;; (later-once! runner (+ (current-second) 3600) "reminder"
+11
;;; (lambda () (send-reminder)))
+12
;;; (with-async (go (later-run runner))))
+13
;;; ```
+14
+15
(define-library (sigil later runner)
+16
(import (sigil core)
+17
(sigil struct)
+18
(sigil string)
+19
(sigil time)
+20
(sigil async)
+21
(sigil later))
+22
(export make-later-runner
+23
later-runner?
+24
later-every!
+25
later-once!
+26
later-remove!
+27
later-run
+28
later-tick)
+29
(begin
+30
+31
;; ============================================================
+32
;; Structs
+33
;; ============================================================
+34
+35
(define-struct later-runner
+36
(tasks default: '() mutable: #t))
+37
+38
(define-struct later-task
+39
(name)
+40
(type) ;; 'every or 'once
+41
(schedule) ;; later-schedule for 'every, timestamp for 'once
+42
(handler) ;; (lambda () ...)
+43
(last-fired default: 0 mutable: #t))
+44
+45
;; ============================================================
+46
;; Task Registration
+47
;; ============================================================
+48
+49
;;; Add a recurring task that fires on a cron schedule.
+50
(define (later-every! runner cron-str name handler)
+51
(: later-runner? string? string? procedure? -> void?)
+52
(let ((sched (parse-cron-string cron-str))
+53
(task (later-task
+54
name: name
+55
type: 'every
+56
schedule: sched
+57
handler: handler)))
+58
(later-runner-tasks-set! runner
+59
(cons task (later-runner-tasks runner)))))
+60
+61
;;; Add a one-time task that fires at a specific timestamp.
+62
(define (later-once! runner timestamp name handler)
+63
(: later-runner? number? string? procedure? -> void?)
+64
(let ((task (later-task
+65
name: name
+66
type: 'once
+67
schedule: timestamp
+68
handler: handler)))
+69
(later-runner-tasks-set! runner
+70
(cons task (later-runner-tasks runner)))))
+71
+72
;;; Remove a task by name.
+73
(define (later-remove! runner name)
+74
(: later-runner? string? -> void?)
+75
(later-runner-tasks-set! runner
+76
(filter (lambda (t) (not (string=? (later-task-name t) name)))
+77
(later-runner-tasks runner))))
+78
+79
;; ============================================================
+80
;; Execution
+81
;; ============================================================
+82
+83
;;; Run the scheduler loop. Call within (go ...) in a with-async block.
+84
;;;
+85
;;; Checks every 30 seconds for tasks that should fire. Recurring
+86
;;; tasks fire at most once per minute (tracked by last-fired).
+87
;;; One-time tasks are removed after firing.
+88
(define (later-run runner)
+89
(: later-runner? -> void?)
+90
(let loop ()
+91
(later-tick runner)
+92
(sleep 30)
+93
(loop)))
+94
+95
;;; Single check-and-fire pass. Useful for custom event loops.
+96
(define (later-tick runner)
+97
(: later-runner? -> void?)
+98
(let ((now (current-second))
+99
(now-minute (truncate-to-minute (current-second))))
+100
(let ((fired-once '()))
+101
(for-each
+102
(lambda (task)
+103
(cond
+104
;; Recurring: check cron match, fire at most once per minute
+105
((eq? (later-task-type task) 'every)
+106
(when (and (later-matches? (later-task-schedule task) now)
+107
(not (= (later-task-last-fired task) now-minute)))
+108
(later-task-last-fired-set! task now-minute)
+109
(guard (exn (#t (display (format "Error in task ~a: ~a\n"
+110
(later-task-name task)
+111
exn)
+112
(current-error-port))))
+113
((later-task-handler task)))))
+114
;; One-time: fire if past the scheduled time
+115
((eq? (later-task-type task) 'once)
+116
(when (>= now (later-task-schedule task))
+117
(guard (exn (#t (display (format "Error in task ~a: ~a\n"
+118
(later-task-name task)
+119
exn)
+120
(current-error-port))))
+121
((later-task-handler task)))
+122
(set! fired-once (cons (later-task-name task) fired-once))))))
+123
(later-runner-tasks runner))
+124
;; Remove fired one-time tasks
+125
(when (pair? fired-once)
+126
(later-runner-tasks-set! runner
+127
(filter (lambda (t)
+128
(not (member (later-task-name t) fired-once)))
+129
(later-runner-tasks runner)))))))
+130
+131
;; Truncate a timestamp to the start of its minute.
+132
(define (truncate-to-minute ts)
+133
(let ((secs (exact (floor ts))))
+134
(- secs (modulo secs 60))))))
test/test-later.sgladded
@@ -0,0 +1,108 @@
+1
(import (sigil test)
+2
(sigil time)
+3
(sigil later))
+4
+5
;; ============================================================
+6
;; parse-cron-string
+7
;; ============================================================
+8
+9
(test-group "parse-cron-string"
+10
(test "parses wildcard expression"
+11
(let ((sched (parse-cron-string "* * * * *")))
+12
(assert-true (later-schedule? sched))
+13
(assert-equal 60 (length (later-schedule-minutes sched)))
+14
(assert-equal 24 (length (later-schedule-hours sched)))
+15
(assert-equal 31 (length (later-schedule-days-of-month sched)))
+16
(assert-equal 12 (length (later-schedule-months sched)))
+17
(assert-equal 7 (length (later-schedule-days-of-week sched)))))
+18
+19
(test "parses step expression"
+20
(let ((sched (parse-cron-string "*/5 * * * *")))
+21
(assert-equal '(0 5 10 15 20 25 30 35 40 45 50 55)
+22
(later-schedule-minutes sched))))
+23
+24
(test "parses specific values"
+25
(let ((sched (parse-cron-string "30 9 * * *")))
+26
(assert-equal '(30) (later-schedule-minutes sched))
+27
(assert-equal '(9) (later-schedule-hours sched))))
+28
+29
(test "parses ranges"
+30
(let ((sched (parse-cron-string "0 9-17 * * *")))
+31
(assert-equal '(9 10 11 12 13 14 15 16 17)
+32
(later-schedule-hours sched))))
+33
+34
(test "parses lists"
+35
(let ((sched (parse-cron-string "0,15,30,45 * * * *")))
+36
(assert-equal '(0 15 30 45)
+37
(later-schedule-minutes sched))))
+38
+39
(test "parses named days"
+40
(let ((sched (parse-cron-string "0 9 * * MON-FRI")))
+41
(assert-equal '(1 2 3 4 5)
+42
(later-schedule-days-of-week sched))))
+43
+44
(test "parses named months"
+45
(let ((sched (parse-cron-string "0 0 1 JAN,JUL *")))
+46
(assert-equal '(1 7)
+47
(later-schedule-months sched))))
+48
+49
(test "parses range with step"
+50
(let ((sched (parse-cron-string "0 8-18/2 * * *")))
+51
(assert-equal '(8 10 12 14 16 18)
+52
(later-schedule-hours sched))))
+53
+54
(test "rejects invalid field count"
+55
(assert-error (parse-cron-string "* * *"))))
+56
+57
;; ============================================================
+58
;; later-matches?
+59
;; ============================================================
+60
+61
(test-group "later-matches?"
+62
(test "every-minute matches any timestamp"
+63
(let ((sched (parse-cron-string "* * * * *")))
+64
(assert-true (later-matches? sched (current-second)))))
+65
+66
(test "specific minute matches"
+67
(let* ((sched (parse-cron-string "30 * * * *"))
+68
(now (current-second))
+69
(min (time-minute now)))
+70
;; If current minute is 30, it should match; otherwise not
+71
(if (= min 30)
+72
(assert-true (later-matches? sched now))
+73
(assert-false (later-matches? sched now)))))
+74
+75
(test "non-matching minute returns false"
+76
(let ((sched (parse-cron-string "0 * * * *")))
+77
;; Pick a time at minute 30
+78
;; 2026-01-01 00:30:00 = 1735689600 + 1800 = 1735691400
+79
(assert-false (later-matches? sched 1735691400)))))
+80
+81
;; ============================================================
+82
;; later-next
+83
;; ============================================================
+84
+85
(test-group "later-next"
+86
(test "finds next minute for every-minute schedule"
+87
(let* ((sched (parse-cron-string "* * * * *"))
+88
(now (current-second))
+89
(next (later-next sched now)))
+90
(assert-true (number? next))
+91
(assert-true (> next now))
+92
;; Should be within 60 seconds
+93
(assert-true (<= (- next now) 120))))
+94
+95
(test "finds next occurrence for specific time"
+96
(let* ((sched (parse-cron-string "0 * * * *"))
+97
;; Start at 2026-01-01 00:30:00 (minute 30)
+98
(start 1735691400)
+99
(next (later-next sched start)))
+100
(assert-true (number? next))
+101
;; Next :00 should be within an hour
+102
(assert-true (<= (- next start) 3600))))
+103
+104
(test "returns #f for impossible schedule"
+105
;; Feb 31 never exists
+106
(let* ((sched (parse-cron-string "0 0 31 2 *"))
+107
(next (later-next sched (current-second))))
+108
(assert-false next))))