This commit is contained in:
bparodi@lezzo.org 2024-11-06 15:32:32 +01:00
parent 619e33196f
commit 365cbdf137
6 changed files with 112 additions and 26 deletions

View file

@ -3,8 +3,10 @@ PASSWORD := $(shell cat password.secret)
HOST := $(shell cat host.secret)
build:
cd src && dotnet build
cd src && dotnet build --no-restore
run:
cd entrypoint && dotnet run -- --user ${USER} --password ${PASSWORD} -H ${HOST}
test:
cd tests && dotnet test
restore:
dotnet restore && cd src && dotnet build

View file

@ -2,6 +2,7 @@ module Bidello.Cron
open NodaTime
open Cronos
open System.Collections.Immutable
open Pentole.Path
open Pentole
@ -9,6 +10,7 @@ open Datatypes
open Pentole.String
open Pentole.Map
open Pentole
type User = string
@ -24,11 +26,11 @@ let private parse_expr (now: Instant) text =
let to_pattern (text: string) =
match text with
| Prefix "@after" job -> After job |> Ok
| Prefix "@after " job -> After job |> Ok
| _ -> Error $"Can't parse as pattern: {text}"
match to_cron text, to_pattern text with
| Error e, Error p -> Error $"Can't parse {text} neither as pattern or cron expression"
| Error _, Error _ -> Error $"Can't parse {text} neither as pattern or cron expression"
| _, Ok p -> Ok (Pattern p)
| Ok cron_expr, _ ->
(now.ToDateTimeOffset(), local_tz_net)
@ -87,24 +89,41 @@ let sort_cron_jobs (now: Instant) (db_crons: Requirements seq) =
|> Map.ofSeq
in index, deps
in
let rec build_job_table acc (index: Map<JobKey, CronJob>) = function
| [] -> Map.values acc |> Ok
let rec build_dependencies acc (all_jobs: Map<JobKey, CronJob>) = function
| [] -> Ok acc
| {when_=Cron _}::_ -> invalidOp "The jobs should have been partitioned"
| {when_=Pattern (After jb)} as x::xs ->
let father = {j=jb; h=x.hostname}
let previous =
match Map.tryFind father acc with
| None ->
Map.find father index |> Result.map List.singleton
| Some p -> Ok p
if previous |> Result.isError then
Error $"Invalid job definition. No such job_name {jb} in host {x.hostname}"
else
let p = Result.get previous
let acc' = Map.add father (x::p) acc
build_job_table acc' index xs
let key = {j=jb; h=x.hostname}
(* Have I seen this job-hostname already? *)
match Map.tryFind key acc, Map.tryFind key all_jobs with
| Some p, _ ->
(* Yes. We have [initial_job; job_after_this; job_after_this; ...] *)
let acc' = (x::p, acc) ||> Map.add key
build_dependencies acc' all_jobs xs
| None, Some f ->
let acc' = (x::f::[], acc) ||> Map.add key
build_dependencies acc' all_jobs xs
| None, None ->
$"Invalid job definition. No such job_name {jb} in host {x.hostname}"
|> Error
db_crons
|> ResultList.collect (parse now)
|> Result.map build_deps
|> Result.bind (fun (standalone, deps) -> build_job_table Map.empty standalone deps)
|> Result.bind (fun job_list ->
let standalone, deps = build_deps job_list
// printfn "all=%A with_deps=%A" standalone deps
let jobs_with_deps = build_dependencies Map.empty standalone deps
jobs_with_deps
|> Result.map (fun jobs_with_deps ->
let _, jobs_without_deps =
Map.partition (fun k _ -> Map.containsKey k jobs_with_deps) standalone
jobs_without_deps
|> Map.values
|> List.map List.singleton
|> List.append (Map.values jobs_with_deps |> List.map List.rev)))

View file

@ -6,5 +6,5 @@ module Map =
| Some v -> Ok v
| None -> Error $"Can't find key {key}"
let values (map: Map<'k, 'v>): 'v seq =
Map.values map
let values (map: Map<'k, 'v>): 'v list =
Map.values map |> List.ofSeq

9
src/Seq.fs Normal file
View file

@ -0,0 +1,9 @@
namespace Pentole
[<AutoOpen>]
module Seq =
let tee (fun_: 'a -> unit) seq_ = seq {
for x in seq_ do
fun_ x
yield x
}

View file

@ -3,12 +3,14 @@
<PropertyGroup>
<TargetFramework>net8.0</TargetFramework>
<GenerateDocumentationFile>true</GenerateDocumentationFile>
<EnableIncrementalBuild>true</EnableIncrementalBuild>
</PropertyGroup>
<ItemGroup>
<Compile Include="Environment.fs" />
<Compile Include="LoggingHelpers.fs" />
<Compile Include="Map.fs" />
<Compile Include="Seq.fs" />
<Compile Include="Result.fs" />
<Compile Include="String.fs" />
<Compile Include="Which.fs" />

View file

@ -7,10 +7,12 @@ open Bidello
open Pentole.String
let now = NodaTime.SystemClock.Instance.GetCurrentInstant ()
[<Test>]
let string_prefix_active_pattern () =
match "@after job" with
| Prefix "@after" j -> Assert.Pass ()
| Prefix "@after" _ -> Assert.Pass ()
| _ -> Assert.Pass ()
match "@after job " with
@ -26,6 +28,25 @@ let bj =
args = [||]; environment = "";
done_at = None }
let run_function x =
let reduce (cj: CronJob) = (cj.hostname, cj.job_name)
Cron.sort_cron_jobs now x
|> Result.map (List.map (List.map reduce))
|> Pentole.Result.get
[<Test>]
let job_deps_simple () =
let requirements = [bj]
let cjs = run_function requirements
let expected = [[("h1", "j1")]]
Assert.are_seq_equal expected cjs
[<Test>]
let job_deps () =
@ -34,10 +55,43 @@ let job_deps () =
{bj with job_name = "j2"}
{bj with hostname = "h2"}
{bj with job_name = "j1_after"; ``when``="@after j1"}
// TODO: another test with this at h2
]
let now = NodaTime.SystemClock.Instance.GetCurrentInstant ()
let cjs = Cron.sort_cron_jobs now requirements
let cjs = run_function requirements
Assert.ok_is_equal Seq.empty cjs
let expected = [[("h1", "j1"); ("h1", "j1_after")]; [("h2", "j1")]; [("h1", "j2")]]
Assert.are_seq_equal expected cjs
[<Test>]
let job_deps2 () =
let requirements = [
bj
{bj with job_name = "j2"}
{bj with hostname = "h2"}
{bj with job_name = "j1_after"; ``when``="@after j1"}
{bj with job_name = "j2_after"; ``when``="@after j2"}
]
let cjs = run_function requirements
let expected = [[("h1", "j1"); ("h1", "j1_after")];
[("h1", "j2"); ("h1", "j2_after")];
[("h2", "j1")]]
Assert.are_seq_equal expected cjs
[<Test>]
let should_fail_no_host () =
let requirements = [
bj
{bj with job_name = "j2"}
{bj with hostname = "h2"}
{bj with job_name = "j1_after"; ``when``="@after j1"; hostname="nope"}
{bj with job_name = "j2_after"; ``when``="@after j2"}
]
Cron.sort_cron_jobs now requirements
|> Result.isError
|> Assert.is_true