Improve the README example by making 'read' return an option

Signed-off-by: David Scott <dave.scott@citrix.com>

CHANGES

@@ -5,6 +5,7 @@ trunk (unreleased)
 * replace old read/write interface with read;advance/write;advance for restartability
 * breaking API change: client: don't expose the client to users
 * breaking API change: client: use monads for immediate/transaction/wait compound operations
+* breaking API change: client: split 'read' into 'read_exn' and 'read'
 
 1.2.5 (04-Oct-2013):
 * Add Travis continuous integration scripts

README.md

@@ -1,7 +1,8 @@
-XenStore protocol implementation for Mirage
-===========================================
+XenStore protocol in OCaml
+==========================
 
 Layout of this project:
+
   core/        : protocol parser/printer, Lwt-based client
   core_test/   : unit tests for the protocol parser/printer
   unix/        : userspace 'transport' over sockets and xenbus mmap
@@ -25,7 +26,7 @@ module Client = Xenstore.Client.Make(Userspace)
 ```
 To perform a single non-transactional read or wrote:
 ```
-lwt my_domid = Client.(immediate (read "domid"));;
+lwt my_domid = Client.(immediate (read_exn "domid"));;
 ```
 To perform a transactional update:
 ```
@@ -43,12 +44,13 @@ Client.(wait (
   read "hotplug-status" >>= fun status ->
   read "hotplug-error" >>= fun error ->
   match status, error with
-  | "", "" -> return `Retry
-  | status, _ when status <> "" -> return (`Ok status)
-  | _, error -> return (`Error error)
+  | None, None -> return `Retry
+  | _, Some error -> return (`Error error)
+  | Some status, _ -> return (`Ok status)
 ))
 
 Open issues
 -----------
-  1. Xenstore.Client.Make is a nice name. Global 'Userspace' and 'Kernelspace' are a bit rude. Can these be made part of the Xenstore.* space somehow, even through they are optional?
+
+1. Xenstore.Client.Make is a nice name. Global 'Userspace' and 'Kernelspace' are a bit rude. Can these be made part of the Xenstore.* space somehow, even through they are optional?
 

_tags

@@ -131,3 +131,4 @@ true: annot
 <client_lwt>: include
 <client_unix>: include
 <server>: include
+<core_test/core_test.ml>: pkg_cstruct.syntax, syntax_camlp4o

core/client.ml

@@ -263,9 +263,13 @@ module Make = functor(IO: S.CONNECTION) -> struct
   let directory path h = rpc (Handle.accessed_path h path) Request.(PathOp(path, Directory))
       (function Response.Directory ls -> return ls
               | x -> error "directory" x)
-  let read path h = rpc (Handle.accessed_path h path) Request.(PathOp(path, Read))
+  let read_exn path h = rpc (Handle.accessed_path h path) Request.(PathOp(path, Read))
       (function Response.Read x -> return x
               | x -> error "read" x)
+  let read path h = rpc (Handle.accessed_path h path) Request.(PathOp(path, Read))
+      (function Response.Read x -> return (Some x)
+              | Response.Error "ENOENT" -> return None
+              | x -> error "read" x)
   let write path data h = rpc (Handle.accessed_path h path) Request.(PathOp(path, Write data))
       (function Response.Write -> return ()
               | x -> error "write" x)

core/s.ml

@@ -180,7 +180,8 @@ module type CLIENT = sig
   module M: MONAD with type 'a t = ctx -> 'a t
 
   val directory     : string -> ctx -> string list t
-  val read          : string -> ctx -> string t
+  val read_exn      : string -> ctx -> string t
+  val read          : string -> ctx -> string option t
   val write         : string -> string -> ctx -> unit t
   val rm            : string -> ctx -> unit t
   val mkdir         : string -> ctx -> unit t

core_test/core_test.ml

@@ -30,6 +30,7 @@ let failure_on_error = function
 let check_readme_typechecks () =
   let module Client = Xenstore.Client.Make(Userspace) in
   let open Lwt in
+  lwt my_domid = Client.(immediate (read_exn "domid")) in
   Client.(transaction (
     let open M in
     write "a" "b" >>= fun () ->
@@ -41,9 +42,9 @@ let check_readme_typechecks () =
     read "hotplug-status" >>= fun status ->
     read "hotplug-error" >>= fun error ->
     match status, error with
-    | "", "" -> return `Retry
-    | status, _ when status <> "" -> return (`Ok status)
-    | _, error -> return (`Error error)
+    | None, None -> return `Retry
+    | _, Some error -> return (`Error error)
+    | Some status, _ -> return (`Ok status)
   ))
 
 let unbox = function

xs/xs.ml

@@ -23,11 +23,17 @@ let error fmt = Xenstore.Logging.error "xs" fmt
 
 open Lwt
 
+exception Exit of int
+
 (* Implementations of 'simple' commands: *)
 
 let read path () =
-  Client.(immediate (read path)) >>= fun v ->
-  Lwt_io.write Lwt_io.stdout v
+  Client.(immediate (read path)) >>= function
+  | None ->
+    Lwt_io.write Lwt_io.stderr "Path does not exist.\n" >>= fun () ->
+    fail (Exit 1)
+  | Some v ->
+    Lwt_io.write Lwt_io.stdout v
 
 let write path value () =
   Client.(immediate (write path value))
@@ -103,12 +109,8 @@ let parse_expr s =
 (* Return true if [expr] holds. Used in the xenstore 'wait' operation *)
 let rec eval_expression expr xs = match expr with
   | Val path ->
-    begin try_lwt
-        Client.read path xs >>= fun k ->
-        return true
-      with Xenstore.Protocol.Enoent _ ->
-        return false
-    end
+    Client.read path xs >>= fun k ->
+    return (k <> None)
   | Not a ->
     lwt a' = eval_expression a xs in
     return (not(a'))
@@ -119,12 +121,8 @@ let rec eval_expression expr xs = match expr with
     lwt a' = eval_expression a xs and b' = eval_expression b xs in
     return (a' || b')
   | Eq (Val path, Val v) ->
-    begin try_lwt
-        Client.read path xs >>= fun v' ->
-        return (v = v')
-      with Xenstore.Protocol.Enoent _ ->
-        return false
-    end
+    Client.read path xs >>= fun v' ->
+    return (Some v = v')
   | _ -> fail Invalid_expression
 
 let wait expr () =
@@ -187,6 +185,7 @@ let command f common =
     `Error(false, String.concat "\n" lines)
      | Invalid_expression ->
        `Error(true, "My expression parser couldn't understand your expression")
+  | Exit x -> exit x
 
 (* Command-line interface *)