lib/whenstate.ml

   1 (* whenjobs
   2  * Copyright (C) 2012 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Whenutils
  20 open Whenexpr
  21
  22 type t = {
  23   (* Variables. *)
  24   variables : variables;
  25
  26   (* Loaded jobs. *)
  27   jobs : job list;
  28
  29   (*--- below here is "internal" state ---*)
  30
  31   jobmap : job StringMap.t;            (* job name -> job structure *)
  32
  33   (* Map variable names to jobs which depend on that variable.  This
  34    * gives us a quick way to tell which jobs might need to be reevaluated
  35    * when a variable is set.
  36    *)
  37   dependencies : string list StringMap.t; (* variable -> list of job names *)
  38
  39   (* For each job, if it has run, we store the previous variables
  40    * at that time.  This is used to implement {i previous}, {i changes} etc.
  41    *)
  42   prev_variables : variables StringMap.t; (* job name -> variables *)
  43
  44   (* For each job, if it has been evaluated before (see {!job_evaluate})
  45    * then we store the previous result of evaluation here.  This is
  46    * used to implement edge-triggering.
  47    *)
  48   prev_eval_result : bool StringMap.t;   (* job name -> bool *)
  49 }
  50
  51 let empty = {
  52   variables = StringMap.empty;
  53   jobs = [];
  54   jobmap = StringMap.empty;
  55   dependencies = StringMap.empty;
  56   prev_variables = StringMap.empty;
  57   prev_eval_result = StringMap.empty;
  58 }
  59
  60 let add_job t job =
  61   let deps = dependencies_of_job job in
  62   let dependencies' = List.fold_left (
  63     fun map d ->
  64       let names = try StringMap.find d map with Not_found -> [] in
  65       StringMap.add d (job.job_name :: names) map
  66   ) t.dependencies deps in
  67
  68   { t with
  69       jobs = job :: t.jobs;
  70       jobmap = StringMap.add job.job_name job t.jobmap;
  71       dependencies = dependencies'
  72   }
  73
  74 let set_variable t name value =
  75   { t with variables = StringMap.add name value t.variables }
  76
  77 let copy_variables old t =
  78   { t with variables = StringMap.fold StringMap.add old.variables t.variables }
  79
  80 let get_variable t name =
  81   try StringMap.find name t.variables with Not_found -> T_string ""
  82
  83 let get_variables t =
  84   StringMap.fold (
  85     fun name value xs ->
  86       if value <> T_string "" then (name, value) :: xs else xs
  87   ) t.variables []
  88
  89 let get_variable_names t =
  90   StringMap.fold (
  91     fun name value xs -> if value <> T_string "" then name :: xs else xs
  92   ) t.variables []
  93
  94 let nr_jobs t = List.length t.jobs
  95
  96 let get_dependencies t name =
  97   let jobnames = try StringMap.find name t.dependencies with Not_found -> [] in
  98   List.map (fun jn ->
  99     try
 100       let j = StringMap.find jn t.jobmap in
 101       (* If this asserts false, then there is a bug in {!add_job}. *)
 102       assert (match j.job_cond with When_job _ -> true | _ -> false);
 103       j
 104     with Not_found ->
 105       (* This should never happen.  It would indicate some bug in the
 106        * {!add_job} function.
 107        *)
 108       assert false
 109   ) jobnames
 110
 111 let get_whenjobs t =
 112   List.filter (function { job_cond = When_job _ } -> true | _ -> false) t.jobs
 113
 114 let get_everyjobs t =
 115   List.filter (function { job_cond = Every_job _ } -> true | _ -> false) t.jobs
 116
 117 let get_job t jobname =
 118   StringMap.find jobname t.jobmap
 119
 120 let evaluate_whenjob ?(onload = false) t job =
 121   match job with
 122   | { job_cond = Every_job _ } -> assert false
 123   | { job_cond = When_job whenexpr; job_name = jobname } ->
 124     let prev_variables =
 125       try Some (StringMap.find jobname t.prev_variables)
 126       with Not_found -> None in
 127
 128     let result =
 129       eval_whenexpr_as_bool t.variables prev_variables onload whenexpr in
 130
 131     let prev_eval_result =
 132       try Some (StringMap.find jobname t.prev_eval_result)
 133       with Not_found -> None in
 134
 135     let t = { t with prev_eval_result =
 136                        StringMap.add jobname result t.prev_eval_result } in
 137
 138     (* Because jobs are edge-triggered, we're only interested in the
 139      * case where the evaluation state changes from false -> true.
 140      *)
 141     match prev_eval_result, result with
 142     | None, false
 143     | Some false, false
 144     | Some true, true
 145     | Some true, false ->
 146       false, t
 147
 148     | None, true
 149     | Some false, true ->
 150       let t = { t with prev_variables =
 151                          StringMap.add jobname t.variables t.prev_variables } in
 152       true, t