(* Copyright 2012 Tony Garnock-Jones . *) (* This file is part of Hop. *) (* Hop is free software: you can redistribute it and/or modify it *) (* under the terms of the GNU General Public License as published by the *) (* Free Software Foundation, either version 3 of the License, or (at your *) (* option) any later version. *) (* Hop is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* General Public License for more details. *) (* You should have received a copy of the GNU General Public License *) (* along with Hop. If not, see . *) open Lwt open Datastructures let continue_running = ref true let (cq_in, cq_out) = Lwt_stream.create () let achieved_milestones = ref BytesSet.empty let milestone name = cq_out (Some (`Milestone name)) let shutdown_now details = cq_out (Some (`Shutdown details)) let is_milestone_achieved m = match m with | Some m' -> BytesSet.mem m' !achieved_milestones | None -> false let rec run' until_milestone = match is_milestone_achieved until_milestone with | true -> return () | false -> (match_lwt Lwt_stream.next cq_in with | `Shutdown details -> ignore (Log.error "Shutting down server" details); continue_running := false; return () | `Milestone name -> ignore (Log.info "Achieved milestone" [Sexp.Str name]); achieved_milestones := BytesSet.add name !achieved_milestones; run' until_milestone) let is_running () = !continue_running let run_until milestone = if !continue_running then (ignore (Log.info "Waiting for milestone" [Sexp.Str milestone]); run' (Some milestone)) else return () let run_forever () = if !continue_running then run' None else return ()