From 819cebb2609be07e047a9e206d2c8ad1b4abbf49 Mon Sep 17 00:00:00 2001 From: "Hezekiah M. Carty" Date: Thu, 17 Mar 2016 14:36:22 -0400 Subject: [PATCH 1/2] Replace Lwt_chan use with Lwt_io --- src/redis_lwt.ml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/redis_lwt.ml b/src/redis_lwt.ml index 7f40c6f..f4359ad 100644 --- a/src/redis_lwt.ml +++ b/src/redis_lwt.ml @@ -2,8 +2,8 @@ module IO = struct type 'a t = 'a Lwt.t type fd = Lwt_unix.file_descr - type in_channel = Lwt_chan.in_channel - type out_channel = Lwt_chan.out_channel + type in_channel = Lwt_io.input_channel + type out_channel = Lwt_io.output_channel type 'a stream = 'a Lwt_stream.t type stream_count = unit @@ -28,12 +28,12 @@ module IO = struct let close = Lwt_unix.close let sleep = Lwt_unix.sleep - let in_channel_of_descr = Lwt_chan.in_channel_of_descr - let out_channel_of_descr = Lwt_chan.out_channel_of_descr - let input_char = Lwt_chan.input_char - let really_input = Lwt_chan.really_input - let output_string = Lwt_chan.output_string - let flush = Lwt_chan.flush + let in_channel_of_descr fd = Lwt_io.of_fd ~mode:Lwt_io.input fd + let out_channel_of_descr fd = Lwt_io.of_fd ~mode:Lwt_io.output fd + let input_char = Lwt_io.read_char + let really_input = Lwt_io.read_into_exactly + let output_string = Lwt_io.write + let flush = Lwt_io.flush let iter = Lwt_list.iter_p let iter_serial = Lwt_list.iter_s From d03dd1359fd1753382384e1aa732dc98f5bcd1c2 Mon Sep 17 00:00:00 2001 From: "Hezekiah M. Carty" Date: Thu, 17 Mar 2016 14:42:40 -0400 Subject: [PATCH 2/2] Wrap IO.fail calls with binds This should be safer in the case of Lwt-wrapped exceptions --- src/client.ml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/client.ml b/src/client.ml index 4ae2daa..8113967 100644 --- a/src/client.ml +++ b/src/client.ml @@ -395,9 +395,10 @@ module Make(IO : S.IO) = struct function | `Bulk Some next_cursor :: `Multibulk keys :: [] -> let next_cursor = int_of_string next_cursor in - let keys = List.map (function - | `Bulk (Some s) -> s - | x -> IO.fail (Unexpected x); "") keys in + IO.map_serial (function + | `Bulk (Some s) -> IO.return s + | x -> IO.fail (Unexpected x) >>= fun () -> IO.return "") keys + >>= fun keys -> IO.return (next_cursor, keys) | _ -> IO.fail (Error "SCAN returned unexpected result") @@ -748,10 +749,10 @@ module Make(IO : S.IO) = struct function | `Bulk Some next_cursor :: `Multibulk keys :: [] -> let next_cursor = int_of_string next_cursor in - let entries = - List.map (function - | `Bulk (Some s) -> s - | x -> IO.fail (Unexpected x); "") keys in + IO.map_serial (function + | `Bulk (Some s) -> IO.return s + | x -> IO.fail (Unexpected x) >>= fun () -> IO.return "") keys + >>= fun entries -> let pairs = Utils.List.pairs_of_list entries |> Utils.Option.default [] in IO.return (next_cursor, pairs) | _ -> IO.fail (Error "HSCAN returned unexpected result")