more
This commit is contained in:
parent
f67d752533
commit
e037b0b102
4 changed files with 30 additions and 12 deletions
26
src/Cron.fs
26
src/Cron.fs
|
@ -9,6 +9,7 @@ open Datatypes
|
||||||
|
|
||||||
open Pentole.String
|
open Pentole.String
|
||||||
open Pentole.Path
|
open Pentole.Path
|
||||||
|
open Pentole.Map
|
||||||
|
|
||||||
type User = string
|
type User = string
|
||||||
|
|
||||||
|
@ -78,10 +79,6 @@ type JobKey = {
|
||||||
let sort_cron_jobs (now: Instant) (db_crons: Database.Requirements seq) =
|
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 build_deps (lst: CronJob list) =
|
||||||
let standalone, deps =
|
let standalone, deps =
|
||||||
List.partition (function | {when_=Cron _} -> true | _ -> false) lst
|
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 index, deps
|
||||||
in
|
in
|
||||||
let rec build_job_table acc (index: Map<JobKey, CronJob>) = function
|
let rec build_job_table acc (index: Map<JobKey, CronJob>) = function
|
||||||
| [] -> acc
|
| [] -> Ok acc
|
||||||
|
| {when_=Cron _}::_ -> invalidOp "The jobs should have been partitioned"
|
||||||
| {when_=Pattern (After jb)} as x::xs ->
|
| {when_=Pattern (After jb)} as x::xs ->
|
||||||
let father = {j=jb; h=x.hostname}
|
let father = {j=jb; h=x.hostname}
|
||||||
let previous =
|
let previous =
|
||||||
match Map.tryFind father acc with
|
match Map.tryFind father acc with
|
||||||
// TODO: error handling
|
| None ->
|
||||||
| None -> Map.find father index |> List.singleton
|
Map.find father index |> Result.map List.singleton
|
||||||
| Some p -> p
|
| Some p -> Ok p
|
||||||
let acc' = Map.add father (x::previous) acc
|
if previous |> Result.isError then
|
||||||
build_job_table acc' index xs
|
Error "Invalid job definition. No such job_name {jb} in host {x.hostname}"
|
||||||
| {when_=Cron _}::_ -> failwith "TODO" // TODO
|
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 build_deps
|
||||||
|> Result.map (fun (standalone, deps) -> build_job_table Map.empty standalone deps)
|
|> Result.map (fun (standalone, deps) -> build_job_table Map.empty standalone deps)
|
||||||
|
|
7
src/Map.fs
Normal file
7
src/Map.fs
Normal file
|
@ -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}"
|
|
@ -21,6 +21,14 @@ module Result =
|
||||||
| Error e, _ -> Error e
|
| Error e, _ -> Error e
|
||||||
| _, 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) =
|
type ToStringWrapper(toString) =
|
||||||
override _.ToString() = toString ()
|
override _.ToString() = toString ()
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<Compile Include="Environment.fs" />
|
<Compile Include="Environment.fs" />
|
||||||
<Compile Include="LoggingHelpers.fs" />
|
<Compile Include="LoggingHelpers.fs" />
|
||||||
|
<Compile Include="Map.fs" />
|
||||||
<Compile Include="Result.fs" />
|
<Compile Include="Result.fs" />
|
||||||
<Compile Include="String.fs" />
|
<Compile Include="String.fs" />
|
||||||
<Compile Include="Datatypes.fs" />
|
<Compile Include="Datatypes.fs" />
|
||||||
|
|
Loading…
Reference in a new issue