From b160fc2830fcdba59c40041f23ebfe3fc661d18b Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sat, 26 Aug 2023 17:40:17 +0200
Subject: [PATCH] Add an interval of "never" to never schedule a job.

This solves #32 -- at first insertion, the job is scheduled, and then only at
Ptime.max. This allows manual scheduling of a job.
---
 app/client.ml  |  1 +
 app/server.ml  | 21 ++++++++++++---------
 lib/builder.ml |  7 +++++--
 3 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/app/client.ml b/app/client.ml
index b26f2ed..cc1e4d4 100644
--- a/app/client.ml
+++ b/app/client.ml
@@ -174,6 +174,7 @@ let p =
     "hourly", Builder.Hourly ;
     "daily", Builder.Daily ;
     "weekly", Builder.Weekly ;
+    "never", Builder.Never ;
   ]
 
 let period =
diff --git a/app/server.ml b/app/server.ml
index 8f6593b..c523fd9 100644
--- a/app/server.ml
+++ b/app/server.ml
@@ -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
@@ -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
diff --git a/lib/builder.ml b/lib/builder.ml
index 867921f..a3bdf03 100644
--- a/lib/builder.ml
+++ b/lib/builder.ml
@@ -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
@@ -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}