module RunningMap = Map.Make (Id.Task) module TasksMap = Map.Make (Id.Task) module ClientsSet = Set.Make (Id.Client) type t = { queued_front : Id.Task.t list ; queued_back : Id.Task.t list ; running : Id.Client.t RunningMap.t; tasks : string TasksMap.t; clients : ClientsSet.t; next_client_id : Id.Client.t; next_task_id : Id.Task.t; number_of_queued : int; number_of_running : int; number_of_tasks : int; number_of_clients : int; } let create () = { queued_front = [] ; queued_back = [] ; running = RunningMap.empty ; tasks = TasksMap.empty; clients = ClientsSet.empty; next_client_id = Id.Client.of_int 1; next_task_id = Id.Task.of_int 1; number_of_queued = 0; number_of_running = 0; number_of_tasks = 0; number_of_clients = 0; } let add_task ~task q = let task_id = q.next_task_id in { q with queued_front = task_id :: q.queued_front ; tasks = TasksMap.add task_id task q.tasks; next_task_id = Id.Task.increment task_id ; number_of_queued = q.number_of_queued + 1; number_of_tasks = q.number_of_tasks + 1; } let add_client q = let client_id = q.next_client_id in { q with clients = ClientsSet.add client_id q.clients; next_client_id = Id.Client.increment client_id; number_of_clients = q.number_of_clients + 1; }, client_id let pop_task ~client_id q = let { queued_front ; queued_back ; running ; _ } = q in assert (ClientsSet.mem client_id q.clients); let queued_front', queued_back' = match queued_front, queued_back with | (l, []) -> ( [], List.rev l) | t -> t in match queued_back' with | task_id :: new_queue -> let new_q = { q with queued_front= queued_front' ; queued_back = new_queue ; running = RunningMap.add task_id client_id running; number_of_queued = q.number_of_queued - 1; number_of_running = q.number_of_running + 1; } and found = try Some (TasksMap.find task_id q.tasks) with Not_found -> None in new_q, Some task_id, found | [] -> q, None, None let del_client ~client_id q = assert (ClientsSet.mem client_id q.clients); { q with clients = ClientsSet.remove client_id q.clients; number_of_clients = q.number_of_clients - 1 } let end_task ~task_id ~client_id q = let { running ; tasks ; _ } = q in assert (ClientsSet.mem client_id q.clients); let () = let client_id_check = try RunningMap.find task_id running with Not_found -> failwith "Task already finished" in assert (client_id_check = client_id) in { q with running = RunningMap.remove task_id running ; number_of_running = q.number_of_running - 1 } let del_task ~task_id q = let { tasks ; _ } = q in if (TasksMap.mem task_id tasks) then { q with tasks = TasksMap.remove task_id tasks; number_of_tasks = q.number_of_tasks - 1; } else Printf.sprintf "Task %d is already deleted" (Id.Task.to_int task_id) |> failwith let number_of_tasks q = assert (q.number_of_tasks >= 0); q.number_of_tasks let number_of_queued q = assert (q.number_of_queued >= 0); q.number_of_queued let number_of_running q = assert (q.number_of_running >= 0); q.number_of_running let number_of_clients q = assert (q.number_of_clients >= 0); q.number_of_clients let to_string qs = let { queued_back ; queued_front ; running ; tasks ; _ } = qs in let q = (List.map Id.Task.to_string queued_front) @ (List.map Id.Task.to_string @@ List.rev queued_back) |> String.concat " ; " and r = RunningMap.bindings running |> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", " ^(Id.Client.to_string c)^")") |> String.concat " ; " and t = TasksMap.bindings tasks |> List.map (fun (t,c) -> "("^(Id.Task.to_string t)^", \"" ^c^"\")") |> String.concat " ; " in Printf.sprintf "{ Tasks : %d Queued : %d Running : %d Clients : %d queued : { %s } running : { %s } tasks : [ %s ] }" (number_of_tasks qs) (number_of_queued qs) (number_of_running qs) (number_of_clients qs) q r t let test () = let q = create () |> add_task ~task:"First Task" |> add_task ~task:"Second Task" in let q, client_id = add_client q in let q, task_id, task_content = match pop_task ~client_id q with | q, Some x, Some y -> q, Id.Task.to_int x, y | _ -> assert false in Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content; to_string q |> print_endline ; let q, task_id, task_content = match pop_task ~client_id q with | q, Some x, Some y -> q, Id.Task.to_int x, y | _ -> assert false in Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content; let q, task_id, task_content = match pop_task ~client_id q with | q, None, None -> q, 0, "None" | _ -> assert false in Printf.printf "Task_id : %d \t\t Task : %s\n" task_id task_content; q |> to_string |> print_endline