more functions in Lwt_automaton (automaton that reads/writes on a Unix FD)

META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 228a31c6369b1dd4a6ea763cff7e020e)
+# DO NOT EDIT (digest: 6c4b4efc4408717882c37d4e5ee32d91)
 version = "0.1"
 description = "A bunch of modules, including polymorphic containers."
 requires = "unix"
@@ -22,7 +22,7 @@ package "thread" (
 package "lwt" (
  version = "0.1"
  description = "A bunch of modules, including polymorphic containers."
- requires = "containers lwt"
+ requires = "containers lwt lwt.unix"
  archive(byte) = "containers_lwt.cma"
  archive(byte, plugin) = "containers_lwt.cma"
  archive(native) = "containers_lwt.cmxa"

_oasis

@@ -61,8 +61,8 @@ Library "containers_lwt"
   FindlibParent:    containers
   Build$:           flag(lwt)
   Install$:         flag(lwt)
-  BuildDepends:     containers,lwt
+  BuildDepends:     containers,lwt,lwt.unix
-  XMETARequires:    containers,lwt
+  XMETARequires:    containers,lwt,lwt.unix
 
 Library "containers_cgi"
   Path:             cgi

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: cb8d0069d6571765cb2126aec9384e1e)
+# DO NOT EDIT (digest: 9646ccb2c67bd5510c1a73553e55f6ff)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -62,6 +62,7 @@
 "lwt_automaton.cmx": for-pack(Containers_lwt)
 <*.ml{,i}>: use_containers
 <*.ml{,i}>: package(lwt)
+<*.ml{,i}>: package(lwt.unix)
 <*.ml{,i}>: package(unix)
 # Library containers_cgi
 "cgi/containers_cgi.cmxs": use_containers_cgi

lwt_automaton.ml

@@ -28,10 +28,10 @@ of this software, even if advised of the possibility of such damage.
 
 module I = struct
   let send f i =
-    Lwt.on_success f (fun x -> Automaton.I.send x i)
+    Lwt.on_success f (Automaton.I.send i)
 
   let iter_stream str i =
-    Lwt_stream.iter (fun x -> Automaton.I.send x i) str
+    Lwt_stream.iter (Automaton.I.send i) str
 end
 
 module O = struct
@@ -42,3 +42,53 @@ module O = struct
 end
 
 let next_transition a = O.next (Automaton.Instance.transitions a)
+
+let (>>=) = Lwt.bind
+
+module Unix = struct
+  let read_write fd =
+    let err_fut, err_send = Lwt.wait () in
+    let transition st i = match st, i with
+      | `Error _, _
+      | `Stopped, _ -> st, []
+      | `Active, `Failwith e ->
+          Lwt.ignore_result (Lwt_unix.close fd);
+          `Error e, [ `Error e ]
+      | `Active, `Stop ->
+          Lwt.ignore_result (Lwt_unix.close fd);
+          `Stopped, [`Closed]
+      | `Active, `Write s ->
+          let fut = Lwt_unix.write fd s 0 (String.length s) in
+          (* propagate error *)
+          Lwt.on_failure fut (fun e -> Lwt.wakeup err_send e);
+          st, []
+      | `Active, `JustRead s ->
+          st, [`Read s]
+    in
+    let a = Automaton.Instance.create ~f:transition `Active in
+    let buf = String.make 128 ' ' in
+    (* read a string from buffer *)
+    let rec _read () =
+      if Automaton.Instance.state a = `Active
+        then Lwt_unix.read fd buf 0 (String.length buf) >>= fun n ->
+        begin if n = 0
+          then Automaton.Instance.send a `Stop
+          else
+            let s = String.sub buf 0 n in
+            Automaton.Instance.send a (`JustRead s)
+        end;
+        _read ()
+      else Lwt.return_unit
+    in
+    Lwt.ignore_result (_read ());
+    Lwt.on_success err_fut
+      (fun e -> Automaton.Instance.send a (`Failwith e));
+    a
+
+  let timeout f =
+    let o = Automaton.O.create () in
+    let fut = Lwt_unix.sleep f in
+    Lwt.on_success fut
+      (fun () -> Automaton.O.send o `Timeout);
+    o
+end

lwt_automaton.mli

@@ -43,3 +43,16 @@ end
 val next_transition :
   ('s,'i,'o) Automaton.Instance.t ->
   ('s * 'i * 's * 'o list) Lwt.t
+
+(** {2 Interface with Unix} *)
+module Unix : sig
+  val read_write : Lwt_unix.file_descr ->
+    ( [  `Active | `Stopped | `Error of exn ]
+    , [ `Stop | `Write of string | `JustRead of string | `Failwith of exn ]
+    , [> `Read of string | `Closed | `Error of exn ]
+    ) Automaton.Instance.t
+  (** Read and write on the given filedescriptor *)
+
+  val timeout : float -> [`Timeout] Automaton.O.t
+  (** Wait the given amount of time, then trigger [`Timeout] *)
+end

setup.ml

@@ -1,7 +1,7 @@
 (* setup.ml generated for the first time by OASIS v0.3.0 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 7dab10989ebb7fbf9c63ffe468939fec) *)
+(* DO NOT EDIT (digest: 939751db7ca9dddc45e30f49085683b0) *)
 (*
    Regenerated by OASIS v0.4.1
    Visit http://oasis.forge.ocamlcore.org for more information and
@@ -6963,7 +6963,8 @@ let setup_t =
                       bs_build_depends =
                         [
                            InternalLibrary "containers";
-                           FindlibPackage ("lwt", None)
+                           FindlibPackage ("lwt", None);
+                           FindlibPackage ("lwt.unix", None)
                         ];
                       bs_build_tools = [ExternalTool "ocamlbuild"];
                       bs_c_sources = [];
@@ -7216,7 +7217,7 @@ let setup_t =
        };
      oasis_fn = Some "_oasis";
      oasis_version = "0.4.1";
-     oasis_digest = Some "Vjm\254\b\1605[\023\195\024\190\191}\232i";
+     oasis_digest = Some "!\199\188\179\016A\015A\130\196J\1291\159\2182";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7224,6 +7225,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7228 "setup.ml"
+# 7229 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;