diff --git a/src/Cron.fs b/src/Cron.fs index 96528b4..0d27168 100644 --- a/src/Cron.fs +++ b/src/Cron.fs @@ -9,6 +9,7 @@ open Datatypes open Pentole.String open Pentole.Path +open Pentole.Map type User = string @@ -78,10 +79,6 @@ type JobKey = { let sort_cron_jobs (now: Instant) (db_crons: Database.Requirements seq) = - let all_jobs = - db_crons - |> ResultList.collect (parse now) - let build_deps (lst: CronJob list) = let standalone, deps = List.partition (function | {when_=Cron _} -> true | _ -> false) lst @@ -93,18 +90,23 @@ let sort_cron_jobs (now: Instant) (db_crons: Database.Requirements seq) = in index, deps in let rec build_job_table acc (index: Map) = function - | [] -> acc + | [] -> 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 - // TODO: error handling - | None -> Map.find father index |> List.singleton - | Some p -> p - let acc' = Map.add father (x::previous) acc - build_job_table acc' index xs - | {when_=Cron _}::_ -> failwith "TODO" // TODO + | 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 - all_jobs + db_crons + |> ResultList.collect (parse now) |> Result.map build_deps |> Result.map (fun (standalone, deps) -> build_job_table Map.empty standalone deps) diff --git a/src/Map.fs b/src/Map.fs new file mode 100644 index 0000000..2ab33c2 --- /dev/null +++ b/src/Map.fs @@ -0,0 +1,7 @@ +namespace Pentole + +module Map = + let find (key: 'key) (map: Map<'key, 'value>) = + match Map.tryFind key map with + | Some v -> Ok v + | None -> Error $"Can't find key {key}" diff --git a/src/Result.fs b/src/Result.fs index a60e265..03cefa8 100644 --- a/src/Result.fs +++ b/src/Result.fs @@ -21,6 +21,14 @@ module Result = | Error e, _ -> Error e | _, Error e -> Error e + let inline get r = + match r with + | Ok o -> o + | Error e -> + $"Tried to access value from Result r, error={e}" + |> System.ArgumentException + |> raise + type ToStringWrapper(toString) = override _.ToString() = toString () diff --git a/src/src.fsproj b/src/src.fsproj index d0436bf..72bc45a 100644 --- a/src/src.fsproj +++ b/src/src.fsproj @@ -8,6 +8,7 @@ +