Commits

Anonymous committed 70cb298

.

Comments (0)

Files changed (3)

+module type IO_Type
+ =
+  sig
+    type m +'a;
+    value return : 'a -> m 'a;
+    value bind_rev : m 'a -> ('a -> m 'b) -> m 'b;
+    value error : exn -> m 'a;
+    type in_channel;
+    value read_into : in_channel -> string -> int -> int -> m int;
+    type out_channel;
+    value write : out_channel -> string -> m unit;
+    value flush : out_channel -> m unit;
+    value close_out : out_channel -> m unit;
+  end
+;
+open Ds_types;
+
+module Make (IO : IO_Type)
+ =
+  struct
+
+    value ( >>= ) = IO.bind_rev
+    ;
+
+    exception Dumbstreaming of string
+    ;
+
+    value (write : IO.out_channel -> string -> IO.m unit) outch str =
+      let pre = Printf.sprintf "%i\n" (String.length str)
+      and post = "\n\n" in
+      IO.write outch pre >>= fun () ->
+      IO.write outch str >>= fun () ->
+      IO.write outch post >>= fun () ->
+      IO.flush outch
+    ;
+
+    value close_out outch =
+      IO.write outch "\n" >>= fun () ->
+      IO.flush outch >>= fun () ->
+      IO.close_out outch
+    ;
+
+    value max_len_digits = 10
+    ;
+
+    value err msg = IO.error (Dumbstreaming msg)
+    ;
+
+    value sprintf fmt = Printf.sprintf fmt
+    ;
+
+    value read_char inch =
+      let str = String.make 1 '\x00' in
+      IO.read_into inch str 0 1 >>= fun has_read ->
+      if has_read = 0
+      then err "end of channel"
+      else if has_read = 1
+      then IO.return str.[0]
+      else err "read_char: bad 'has_read'"
+    ;
+
+    value read_len inch =
+      inner max_len_digits 0
+      where rec inner left acc =
+        if left < 0
+        then
+          err (sprintf "len > %i" max_len_digits)
+        else
+          read_char inch >>= fun c ->
+          if c = '\n'
+          then
+            IO.return acc
+          else
+            if c >= '0' && c <= '9'
+            then
+              let d = (Char.code c) - (Char.code '0') in
+              let new_acc = 10 * acc + d in
+              inner (left - 1) new_acc
+            else
+              err (sprintf "excepted decimal number (length)")
+    ;
+
+    value read_into_exact inch buf ofs len =
+      loop ~ofs ~len
+      where rec loop ~ofs ~len =
+        let () = assert (len >= 0) in
+        if len = 0
+        then
+          IO.return ()
+        else
+          IO.read_into inch buf ofs len >>= fun has_read ->
+          if has_read = 0
+          then
+            err "unexpected eof"
+          else
+            loop ~ofs:(ofs + has_read) ~len:(len - has_read)
+    ;
+
+    value read_the_char inch c =
+      read_char inch >>= fun r ->
+      if r = c
+      then IO.return ()
+      else err (sprintf "excepted %C, found %C" c r)
+    ;
+
+    value read_msg_post inch =
+      read_the_char inch '\n' >>= fun () ->
+      read_the_char inch '\n'
+    ;
+
+    value read inch =
+      read_len inch >>= fun len ->
+      if len > Sys.max_string_length
+      then err "string is longer than Sys.max_string_length"
+      else
+        let r = String.make len '\x00' in
+        read_into_exact inch r 0 len >>= fun () ->
+        read_msg_post inch >>= fun () ->
+        IO.return r
+    ;
+
+  end
+;

dumbstreaming.mli

+open Ds_types;
+
+module Make (IO : IO_Type)
+ :
+  sig
+
+    value write : IO.out_channel -> string -> IO.m unit
+    ;
+
+    value close_out : IO.out_channel -> IO.m unit
+    ;
+
+
+    exception Dumbstreaming of string
+    ;
+
+    value read : IO.in_channel -> IO.m string
+    ;
+
+  end
+;