Skip to content

Commit

Permalink
Add an interval of "never" to never schedule a job.
Browse files Browse the repository at this point in the history
This solves #32 -- at first insertion, the job is scheduled, and then only at
Ptime.max. This allows manual scheduling of a job.
  • Loading branch information
hannesm committed Aug 26, 2023
1 parent 086f84e commit b160fc2
Show file tree
Hide file tree
Showing 3 changed files with 18 additions and 11 deletions.
1 change: 1 addition & 0 deletions app/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -174,6 +174,7 @@ let p =
"hourly", Builder.Hourly ;
"daily", Builder.Daily ;
"weekly", Builder.Weekly ;
"never", Builder.Never ;
]

let period =
Expand Down
21 changes: 12 additions & 9 deletions app/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -109,13 +109,14 @@ let find_queue t p =
q

let p_to_span p =
let one_hour = 60 * 60 in
let s = match p with
| Builder.Hourly -> one_hour
| Builder.Daily -> 24 * one_hour
| Builder.Weekly -> 7 * 24 * one_hour
let one_hour = 60 * 60
and to_span = Ptime.Span.of_int_s
in
Ptime.Span.of_int_s s
match p with
| Builder.Hourly -> to_span one_hour
| Builder.Daily -> to_span (24 * one_hour)
| Builder.Weekly -> to_span (7 * 24 * one_hour)
| Builder.Never -> Ptime.(to_span max)

let add_to_queue t platform job =
match SM.find_opt platform t.queues with
Expand Down Expand Up @@ -183,9 +184,11 @@ let add_to_queues t = function
Lwt_condition.broadcast t.waiter ()

let schedule_job t now period job =
match Ptime.add_span now (p_to_span period) with
| None -> Logs.err (fun m -> m "ptime add span failed when scheduling job")
| Some next -> S.add t.schedule Builder.{ next ; period ; job }
let next =
Option.value ~default:Ptime.max
(Ptime.add_span now (p_to_span period))
in
S.add t.schedule Builder.{ next ; period ; job }

let schedule t =
let now = Ptime_clock.now () in
Expand Down
7 changes: 5 additions & 2 deletions lib/builder.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,12 +40,13 @@ let pp_execution_result ppf = function
| Stopped i -> Fmt.pf ppf "stopped %d" i
| Msg m -> Fmt.pf ppf "execution aborted: %s" m

type period = Hourly | Daily | Weekly
type period = Hourly | Daily | Weekly | Never

let pp_period ppf = function
| Hourly -> Fmt.string ppf "hourly"
| Daily -> Fmt.string ppf "daily"
| Weekly -> Fmt.string ppf "weekly"
| Never -> Fmt.string ppf "never"

type job =
| Script_job of script_job
Expand Down Expand Up @@ -238,13 +239,15 @@ module Asn = struct
| `C1 () -> Hourly
| `C2 () -> Daily
| `C3 () -> Weekly
| `C4 () -> Never
and g = function
| Hourly -> `C1 ()
| Daily -> `C2 ()
| Weekly -> `C3 ()
| Never -> `C4 ()
in
Asn.S.(map f g
(choice3 (explicit 0 null) (explicit 1 null) (explicit 2 null)))
(choice4 (explicit 0 null) (explicit 1 null) (explicit 2 null) (explicit 3 null)))

let old_schedule =
let f (next, period, job) = {next; period; job = Script_job job}
Expand Down

0 comments on commit b160fc2

Please sign in to comment.