struct
type failure_reason = State.process_failure_reason
type progress = [ `Changed_state | `No_change ]
type 'a transition_callback = ?log:string -> 'a -> t * progress
type severity = [ `Try_again | `Fatal ]
type bookkeeping = State.run_bookkeeping =
{ plugin_name: string; run_parameters: string }
type long_running_failure = severity * string * bookkeeping
type long_running_action = (bookkeeping, long_running_failure) Pvem.Result.t
type process_check =
[ `Successful of bookkeeping | `Still_running of bookkeeping ]
type process_status_check = (process_check, long_running_failure) Pvem.Result.t
type condition_evaluation = (bool, severity * string) Pvem.Result.t
type dependencies_status =
[ `All_succeeded | `At_least_one_failed of id list | `Still_processing ]
type transition = [
| `Do_nothing of unit transition_callback
| `Activate of id list * unit transition_callback
| `Check_and_activate_dependencies of dependencies_status transition_callback
| `Start_running of bookkeeping * long_running_action transition_callback
| `Eval_condition of Condition.t * condition_evaluation transition_callback
| `Check_process of bookkeeping * process_status_check transition_callback
| `Kill of bookkeeping * long_running_action transition_callback
]
open State
let transition t : transition =
let return_with_history ?(no_change=false) t h =
with_history t h, (if no_change then `No_change else `Changed_state) in
let activate_failures c =
`Activate (t.on_failure_activate, (fun ?log () ->
return_with_history t (`Finished (to_history ?log c)))) in
let activate_successes c =
`Activate (t.on_success_activate, (fun ?log () ->
return_with_history t (`Finished (to_history ?log c)))) in
let from_killing_state killable_history current_state =
let{ log; previous_state } = killable_history in
begin match previous_state with
| `Building _
| `Starting _
| `Passive _
| `Tried_to_start _
| `Still_building _
| `Tried_to_eval_condition _
| `Tried_to_reeval_condition _
| `Active _ ->
`Do_nothing (fun ?log () ->
return_with_history t (`Killed (to_history ?log current_state)))
| `Still_running (_, bookkeeping)
| `Still_running_despite_recoverable_error (_, _, bookkeeping)
| `Started_running (_, bookkeeping) ->
`Kill (bookkeeping, begin fun ?log -> function
| `Ok bookkeeping ->
return_with_history t (`Killed (to_history ?log current_state))
| `Error (`Try_again, reason, bookeeping) ->
return_with_history ~no_change:true t
(`Tried_to_kill (to_history ?log current_state))
| `Error (`Fatal, log, bookeeping) ->
return_with_history t (`Failed_to_kill (to_history ~log current_state))
end)
end
in
begin match t.history with
| `Finished _
| `Passive _ ->
`Do_nothing (fun ?log () -> t, `No_change)
| `Tried_to_eval_condition _
| `Active _ as c ->
begin match t.condition with
| Some cond ->
`Eval_condition (cond, begin fun ?log -> function
| `Ok true -> return_with_history t (`Already_done (to_history ?log c))
| `Ok false -> return_with_history t (`Building (to_history ?log c))
| `Error (`Try_again, log) ->
return_with_history t ~no_change:true
(`Tried_to_eval_condition (to_history ~log c))
| `Error (`Fatal, log) ->
return_with_history t (`Failed_to_eval_condition (to_history ~log c))
end)
| None ->
`Do_nothing (fun ?log () ->
return_with_history t (`Building (to_history ?log c)))
end
| `Already_done _ as c ->
activate_successes c
| `Still_building _
| `Building _ as c ->
`Check_and_activate_dependencies begin fun ?log -> function
| `All_succeeded ->
return_with_history t (`Starting (to_history ?log c))
| `At_least_one_failed id_list ->
return_with_history t (`Dependencies_failed (to_history ?log c, id_list))
| `Still_processing ->
return_with_history ~no_change:true t
(`Still_building (to_history ?log c))
end
| `Did_not_ensure_condition _
| `Dependencies_failed _ as c -> activate_failures c
| `Starting _
| `Tried_to_start _ as c ->
begin match build_process t with
| `Long_running (plugin_name, created_run_paramters) ->
let bookeeping =
{plugin_name; run_parameters = created_run_paramters } in
`Start_running (bookeeping, begin fun ?log -> function
| `Ok bookkeeping ->
return_with_history t (`Started_running (to_history ?log c, bookkeeping))
| `Error (`Try_again, log, bookkeeping) ->
return_with_history t ~no_change:true
(`Tried_to_start (to_history ~log c, bookkeeping))
| `Error (`Fatal, log, bookkeeping) ->
return_with_history t (`Failed_to_start (to_history ~log c, bookkeeping))
end)
| `No_operation ->
`Do_nothing (fun ?log () ->
return_with_history t (`Successfully_did_nothing (to_history ?log c)))
end
| `Started_running (_, bookkeeping)
| `Still_running_despite_recoverable_error (_, _, bookkeeping)
| `Still_running (_, bookkeeping) as c ->
`Check_process (bookkeeping, begin fun ?log -> function
| `Ok (`Still_running bookkeeping) ->
return_with_history t ~no_change:true
(`Still_running (to_history ?log c, bookkeeping))
| `Ok (`Successful bookkeeping) ->
return_with_history t (`Ran_successfully (to_history ?log c, bookkeeping))
| `Error (`Try_again, how, bookkeeping) ->
return_with_history t ~no_change:true
(`Still_running_despite_recoverable_error
(how, to_history ?log c, bookkeeping))
| `Error (`Fatal, log, bookkeeping) ->
return_with_history t
(`Failed_running (to_history ~log c,
`Long_running_failure log, bookkeeping))
end)
| `Successfully_did_nothing _
| `Tried_to_reeval_condition _
| `Ran_successfully _ as c ->
begin match t.condition with
| Some cond ->
`Eval_condition (cond, begin fun ?log -> function
| `Ok true -> return_with_history t (`Verified_success (to_history ?log c))
| `Ok false ->
return_with_history t (`Did_not_ensure_condition (to_history ?log c))
| `Error (`Try_again, how) ->
return_with_history t ~no_change:true
(`Tried_to_reeval_condition (how, to_history ?log c))
| `Error (`Fatal, log) ->
return_with_history t (`Did_not_ensure_condition (to_history ~log c))
end)
| None ->
`Do_nothing (fun ?log () ->
return_with_history t (`Verified_success (to_history ?log c)))
end
| `Verified_success _ as c ->
activate_successes c
| `Failed_running _ as c ->
activate_failures c
| `Tried_to_kill _ as c ->
let killable_history =
let rec go =
function
| `Killing h -> h
| `Tried_to_kill {previous_state; _} ->
go previous_state in
(go c)
in
from_killing_state killable_history c
| `Killing history as c ->
from_killing_state history c
| `Killed _
| `Failed_to_start _
| `Failed_to_eval_condition _
| `Failed_to_kill _ as c ->
activate_failures c
end
end