trainmap: fixes to connect clear priority

Author: bluddy

src/rails_lib/backend/backend_low.ml

@@ -482,8 +482,14 @@ let try_create_priority_shipment ?(force=false) v =
   | _ -> None
 
 let try_cancel_priority_shipments ?(force=false) v =
-  Player.cancel_priority ~force v.players ~cycle:v.cycle ~year:v.year v.region
-  |> List.map (fun i -> PriorityShipmentCanceled{player=i})
+  (* Try to cancel and create corresponding messages *)
+  match Player.cancel_priority_shipment ~force v.players ~cycle:v.cycle ~year:v.year v.region with
+  | _::_ as players ->
+    let station_map = Station_map.clear_priority_shipment_for_all v.stations ~players in
+    [%upf v.stations <- station_map];
+    List.map (fun i -> PriorityShipmentCanceled{player=i}) players
+  | _ -> []
+    
 
 (** Most time-based work happens here **)
 let handle_cycle v =
@@ -529,7 +535,6 @@ let handle_cycle v =
       else ui_msgs
     in
     (* Cancel any expired priority shipments *)
-
     let ui_msgs = (try_cancel_priority_shipments v) @ ui_msgs in
 
     (* adjust time *)

src/rails_lib/backend/player.ml

@@ -385,23 +385,30 @@ let set_priority priority player = {player with priority}
 
 let has_priority player = Option.is_some player.priority
 
-let check_cancel_priority player ~cycle ~year region =
+let check_cancel_priority_shipment player ~cycle ~year region =
   (* Priority shipments are cancelled when the bonus is < 20 *)
   match player.priority with
   | None -> false
   | Some pr_data ->
      Priority_shipment.should_be_cancelled pr_data ~cycle ~year region
 
-let cancel_priority ?(force=false) players ~cycle ~year region =
+let cancel_priority_shipment ?(force=false) players ~cycle ~year region =
   (* Cancel priority and let us know which players' were canceled *)
-  Array.foldi (fun acc i player ->
-    if has_priority player &&
-      (check_cancel_priority player ~cycle ~year region || force) then (
-      players.(i) <- {player with priority=None};
-      i::acc
-    ) else acc)
-  []
-  players
+  let cancel_players =
+    Array.foldi (fun acc i player ->
+      if has_priority player &&
+        (check_cancel_priority_shipment player ~cycle ~year region || force)
+      then i::acc else acc) []
+    players
+  in
+  List.iter (fun i ->
+    let player = players.(i) in
+    let trains = Trainmap.clear_priority_shipment player.trains in
+    let player = [%up {player with trains; priority=None}] in
+    players.(i) <- player
+    )
+  cancel_players;
+  cancel_players
 
 let update players idx f =
   let p = players.(idx) in

src/rails_lib/backend/trainmap.ml

@@ -143,13 +143,13 @@ let total_engine_value (v:t) =
 let total_car_value (v:t) =
   C.car_cost * fold (fun acc train -> acc + Train.get_num_of_cars train) v ~init:0
 
-let clear_priority_shipment_for_all v ~players =
+let clear_priority_shipment v =
   (* Clear priority shipment holding for the given players *)
   let open Train in
   Vector.map_in_place (fun train ->
-    if List.mem ~eq:Int.equal train.player players then
+    if Train.holds_priority_shipment train then
       Train.set_priority_shipment train false
     else train)
-    v.trains
-
+    v.trains;
+  v
 

src/rails_lib/backend/trainmap.mli

@@ -39,3 +39,6 @@ val get_at_loc: Utils.loc -> t -> Id.t list
 val total_engine_value: t -> int
 
 val total_car_value: t -> int
+
+val clear_priority_shipment: t -> t
+