diff --git a/Makefile b/Makefile index db23012..187eb53 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/src/Cron.fs b/src/Cron.fs index f7089c9..e149a8f 100644 --- a/src/Cron.fs +++ b/src/Cron.fs @@ -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) = function - | [] -> Map.values acc |> Ok + let rec build_dependencies acc (all_jobs: Map) = 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))) diff --git a/src/Map.fs b/src/Map.fs index 8066daa..71ea639 100644 --- a/src/Map.fs +++ b/src/Map.fs @@ -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 diff --git a/src/Seq.fs b/src/Seq.fs new file mode 100644 index 0000000..eb6be87 --- /dev/null +++ b/src/Seq.fs @@ -0,0 +1,9 @@ +namespace Pentole + +[] +module Seq = + let tee (fun_: 'a -> unit) seq_ = seq { + for x in seq_ do + fun_ x + yield x + } diff --git a/src/src.fsproj b/src/src.fsproj index 56710bc..a2d0bed 100644 --- a/src/src.fsproj +++ b/src/src.fsproj @@ -3,12 +3,14 @@ net8.0 true + true + diff --git a/tests/UnitTest1.fs b/tests/UnitTest1.fs index cfba32e..5f6ba79 100644 --- a/tests/UnitTest1.fs +++ b/tests/UnitTest1.fs @@ -7,10 +7,12 @@ open Bidello open Pentole.String +let now = NodaTime.SystemClock.Instance.GetCurrentInstant () + [] 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 + +[] +let job_deps_simple () = + + let requirements = [bj] + let cjs = run_function requirements + + + let expected = [[("h1", "j1")]] + + + Assert.are_seq_equal expected cjs + [] 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 + +[] +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 + +[] +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