Merge pull request #171 from inhabitedtype/call-if-some

call-if-some: add Optional_thunk.call_if_some and use it
inhabitedtype · Apr 3, 2020 · 16a2486 · 16a2486
2 parents fdda189 + 1e5dcee
commit 16a2486
Show file tree

Hide file tree

Showing 5 changed files with 6 additions and 4 deletions.
diff --git a/lib/body.ml b/lib/body.ml
@@ -79,7 +79,7 @@ let schedule_bigstring t ?off ?len (b:Bigstringaf.t) =
 let ready_to_write t =
   let callback = t.when_ready_to_write in
   t.when_ready_to_write <- Optional_thunk.none;
-  Optional_thunk.unchecked_value callback ()
+  Optional_thunk.call_if_some callback
 
 let flush t kontinue =
   Faraday.flush t.faraday kontinue;

diff --git a/lib/optional_thunk.ml b/lib/optional_thunk.ml
@@ -8,4 +8,5 @@ let some f =
 
 let is_none t = t == none
 let is_some t = not (is_none t)
+let call_if_some t = t ()
 let unchecked_value t = t
diff --git a/lib/optional_thunk.mli b/lib/optional_thunk.mli
@@ -6,4 +6,5 @@ val some : (unit -> unit) -> t
 val is_none : t -> bool
 val is_some : t -> bool
 
+val call_if_some : t -> unit
 val unchecked_value : t -> unit -> unit
diff --git a/lib/reqd.ml b/lib/reqd.ml
@@ -92,7 +92,7 @@ let create error_handler request request_body writer response_body_buffer =
 let done_waiting when_done_waiting =
   let f = !when_done_waiting in
   when_done_waiting := Optional_thunk.none;
-  Optional_thunk.unchecked_value f ()
+  Optional_thunk.call_if_some f
 
 let request { request; _ } = request
 let request_body { request_body; _ } = request_body

diff --git a/lib/server_connection.ml b/lib/server_connection.ml
@@ -91,7 +91,7 @@ let yield_reader t k =
 let wakeup_reader t =
   let f = t.wakeup_reader in
   t.wakeup_reader <- Optional_thunk.none;
-  Optional_thunk.unchecked_value f ()
+  Optional_thunk.call_if_some f
 ;;
 
 let on_wakeup_writer t k =
@@ -105,7 +105,7 @@ let on_wakeup_writer t k =
 let wakeup_writer t =
   let f = t.wakeup_writer in
   t.wakeup_writer <- Optional_thunk.none;
-  Optional_thunk.unchecked_value f ()
+  Optional_thunk.call_if_some f
 ;;
 
 let transfer_writer_callback t reqd =