add mem; remove custom result; better error reporting

_oasis

@@ -12,8 +12,8 @@ Library fat
   CompiledObject:     best
   Path:               lib
   Findlibname:        fat-filesystem
-  Modules:            Fat_format, Boot_sector, Entry, Name, Path, Fs, Update, SectorMap, Result, MemoryIO, S, KV_RO
-  BuildDepends:       cstruct, cstruct.ppx,re, re.str, mirage-types, lwt
+  Modules:            Fat_format, Boot_sector, Entry, Name, Path, Fs, Update, SectorMap, MemoryIO, S, KV_RO
+  BuildDepends:       cstruct, cstruct.ppx,re, re.str, mirage-types, lwt, result, rresult
 
 Executable fat
   CompiledObject:     best

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 6be1f2fc4591a45a457c1cf22f497bcf)
+# DO NOT EDIT (digest: 10b5a5533bbbf4d3bdeb84b24d2fa168)
 # 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
@@ -24,7 +24,6 @@ true: annot, bin_annot
 "lib/fs.cmx": for-pack(Fat)
 "lib/update.cmx": for-pack(Fat)
 "lib/sectorMap.cmx": for-pack(Fat)
-"lib/result.cmx": for-pack(Fat)
 "lib/memoryIO.cmx": for-pack(Fat)
 "lib/s.cmx": for-pack(Fat)
 "lib/KV_RO.cmx": for-pack(Fat)
@@ -34,6 +33,8 @@ true: annot, bin_annot
 <lib/*.ml{,i,y}>: pkg_mirage-types
 <lib/*.ml{,i,y}>: pkg_re
 <lib/*.ml{,i,y}>: pkg_re.str
+<lib/*.ml{,i,y}>: pkg_result
+<lib/*.ml{,i,y}>: pkg_rresult
 # Executable fat
 <fat/main.{native,byte}>: pkg_cmdliner
 <fat/main.{native,byte}>: pkg_cstruct
@@ -45,6 +46,8 @@ true: annot, bin_annot
 <fat/main.{native,byte}>: pkg_mirage-types
 <fat/main.{native,byte}>: pkg_re
 <fat/main.{native,byte}>: pkg_re.str
+<fat/main.{native,byte}>: pkg_result
+<fat/main.{native,byte}>: pkg_rresult
 <fat/main.{native,byte}>: use_fat
 <fat/*.ml{,i,y}>: pkg_cmdliner
 <fat/*.ml{,i,y}>: pkg_cstruct
@@ -56,6 +59,8 @@ true: annot, bin_annot
 <fat/*.ml{,i,y}>: pkg_mirage-types
 <fat/*.ml{,i,y}>: pkg_re
 <fat/*.ml{,i,y}>: pkg_re.str
+<fat/*.ml{,i,y}>: pkg_result
+<fat/*.ml{,i,y}>: pkg_rresult
 <fat/*.ml{,i,y}>: use_fat
 <fat/main.{native,byte}>: custom
 # Executable shell
@@ -68,6 +73,8 @@ true: annot, bin_annot
 <shell/main.{native,byte}>: pkg_mirage-types
 <shell/main.{native,byte}>: pkg_re
 <shell/main.{native,byte}>: pkg_re.str
+<shell/main.{native,byte}>: pkg_result
+<shell/main.{native,byte}>: pkg_rresult
 <shell/main.{native,byte}>: use_fat
 <shell/*.ml{,i,y}>: pkg_cstruct
 <shell/*.ml{,i,y}>: pkg_cstruct.ppx
@@ -78,6 +85,8 @@ true: annot, bin_annot
 <shell/*.ml{,i,y}>: pkg_mirage-types
 <shell/*.ml{,i,y}>: pkg_re
 <shell/*.ml{,i,y}>: pkg_re.str
+<shell/*.ml{,i,y}>: pkg_result
+<shell/*.ml{,i,y}>: pkg_rresult
 <shell/*.ml{,i,y}>: use_fat
 <shell/main.{native,byte}>: custom
 # Executable test
@@ -92,6 +101,8 @@ true: annot, bin_annot
 <lib_test/test.{native,byte}>: pkg_oUnit
 <lib_test/test.{native,byte}>: pkg_re
 <lib_test/test.{native,byte}>: pkg_re.str
+<lib_test/test.{native,byte}>: pkg_result
+<lib_test/test.{native,byte}>: pkg_rresult
 <lib_test/test.{native,byte}>: use_fat
 <lib_test/*.ml{,i,y}>: pkg_cstruct
 <lib_test/*.ml{,i,y}>: pkg_cstruct.ppx
@@ -104,6 +115,8 @@ true: annot, bin_annot
 <lib_test/*.ml{,i,y}>: pkg_oUnit
 <lib_test/*.ml{,i,y}>: pkg_re
 <lib_test/*.ml{,i,y}>: pkg_re.str
+<lib_test/*.ml{,i,y}>: pkg_result
+<lib_test/*.ml{,i,y}>: pkg_rresult
 <lib_test/*.ml{,i,y}>: use_fat
 <lib_test/test.{native,byte}>: custom
 # OASIS_STOP

lib/KV_RO.ml

@@ -26,7 +26,7 @@ module Make(FS: FS with
   type id = FS.t
   type page_aligned_buffer = FS.page_aligned_buffer
 
-  type error = Unknown_key of string
+  type error = Unknown_key of string | Failure of string
 
   let connect t = return (`Ok t)
 
@@ -35,15 +35,22 @@ module Make(FS: FS with
 
   let id t = t
 
+  let mem t name =
+    FS.stat t name >|= function
+    | `Ok _ -> `Ok true
+    | `Error `Not_a_directory _ | `Error `No_directory_entry _ -> `Ok false
+    | `Error _ -> `Error (Failure "Failure in the underlying filesystem")
+
   let read t name off len =
-    FS.read t name off len
-    >>= function
-    | `Error _ -> return (`Error (Unknown_key name))
-    | `Ok l -> return (`Ok l)
+    FS.read t name off len >|= function
+    | `Error `Not_a_directory _ | `Error `No_directory_entry _ -> `Error (Unknown_key name)
+    | `Error _ -> `Error (Failure name)
+    | `Ok l -> `Ok l
 
   let size t name =
-    FS.stat t name
-    >>= function
-    | `Error _ -> return (`Error (Unknown_key name))
-    | `Ok stat -> return (`Ok (stat.FS.size))
+    FS.stat t name >|= function
+    | `Error `Not_a_directory _ | `Error `No_directory_entry _ -> `Error (Unknown_key name)
+    | `Error _ -> `Error (Failure name)
+    | `Ok stat -> `Ok (stat.FS.size)
+
 end

lib/result.ml → lib/KV_RO.mli

@@ -1,5 +1,5 @@
 (*
- * Copyright (C) 2011-2013 Citrix Systems Inc
+ * Copyright (C) 2013 Anil Madhavapeddy <anil@recoil.org>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -14,11 +14,9 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-type ('a, 'b) result = [
-  | `Ok of 'a
-  | `Error of 'b
-]
+open V1
 
-let ( >>= ) x f = match x with
-  | `Error y -> `Error y
-  | `Ok z -> f z
+module Make(FS : FS with type 'a io = 'a Lwt.t) : sig
+  include KV_RO
+  val connect : FS.t -> [`Error of error | `Ok of t] FS.io
+end

lib/META

@@ -1,8 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: 01d8de93c6eb4a15a1a4509fc45eb076)
+# DO NOT EDIT (digest: c15a0b94276d5cdc0b8c46005b010455)
 version = "0.11.0"
 description = "FAT filesystem manipulation"
-requires = "cstruct cstruct.ppx re re.str mirage-types lwt"
+requires = "cstruct cstruct.ppx re re.str mirage-types lwt result rresult"
 archive(byte) = "fat.cma"
 archive(byte, plugin) = "fat.cma"
 archive(native) = "fat.cmxa"

lib/boot_sector.ml

@@ -14,8 +14,6 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-open Result
-
 type t = {
   oem_name: string;
   bytes_per_sector: int; (* usually 512 *)
@@ -78,13 +76,14 @@ let marshal (buf: Cstruct.t) t =
   set_t_signature buf 0xaa55
 
 let unmarshal (buf: Cstruct.t) : (t, string) result =
+  let open Rresult in
   ( if Cstruct.len buf < sizeof
-    then `Error (Printf.sprintf "boot sector too small: %d < %d" (Cstruct.len buf) sizeof)
-    else `Ok () ) >>= fun () ->
+    then Error (Printf.sprintf "boot sector too small: %d < %d" (Cstruct.len buf) sizeof)
+    else Ok () ) >>= fun () ->
   let signature = get_t_signature buf in
   ( if signature <> 0xaa55
-    then `Error (Printf.sprintf "boot sector signature invalid: %04x <> %04x" signature 0xaa55)
-    else `Ok () ) >>= fun () ->
+    then Error (Printf.sprintf "boot sector signature invalid: %04x <> %04x" signature 0xaa55)
+    else Ok () ) >>= fun () ->
   let oem_name = Cstruct.to_string (get_t_oem_name buf) in
   let bytes_per_sector = get_t_bytes_per_sector buf in
   let sectors_per_cluster = get_t_sectors_per_cluster buf in
@@ -95,7 +94,7 @@ let unmarshal (buf: Cstruct.t) : (t, string) result =
   let sectors_per_fat = get_t_sectors_per_fat buf in
   let hidden_preceeding_sectors = get_t_hidden_preceeding_sectors buf in
   let total_sectors_large = get_t_total_sectors_large buf in
-  `Ok {
+  Ok {
     oem_name; bytes_per_sector; sectors_per_cluster;
     reserved_sectors; number_of_fats; number_of_root_dir_entries;
     total_sectors = max (Int32.of_int total_sectors_small) total_sectors_large;
@@ -147,8 +146,8 @@ let format_of_clusters number_of_clusters =
 exception Unknown_FAT_cluster_type
 
 let detect_format x = match format_of_clusters (clusters x) with
-  | None -> `Error "unknown cluster type"
-  | Some x -> `Ok x
+  | None -> Error "unknown cluster type"
+  | Some x -> Ok x
 
 let make size =
   let bytes_per_sector = 512 in

lib/fat.mlpack

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2a18a52246061cc96029e574457a25ef)
+# DO NOT EDIT (digest: 8ff44075ee1b4010187f5bd8c1b7d885)
 Fat_format
 Boot_sector
 Entry
@@ -8,7 +8,6 @@ Path
 Fs
 Update
 SectorMap
-Result
 MemoryIO
 S
 KV_RO

lib/fs.ml

@@ -128,7 +128,7 @@ module Make (B: BLOCK_DEVICE
     return ()
 
   let make size =
-    let open Result in
+    let open Rresult in
     let boot = Boot_sector.make size in
     Boot_sector.detect_format boot >>= fun format ->
 
@@ -140,14 +140,14 @@ module Make (B: BLOCK_DEVICE
       Cstruct.set_uint8 root i 0
     done;
     let fs = { boot = boot; format = format; fat = fat; root = root } in
-    `Ok fs
+    Ok fs
 
   let format t size =
     let device = t.device in
 
     (match make size with
-     | `Ok x -> return x
-     | `Error x -> fail (Failure x)
+     | Ok x -> return x
+     | Error x -> fail (Failure x)
     )
     >>= fun fs ->
     let sector = alloc 512 in
@@ -179,11 +179,11 @@ module Make (B: BLOCK_DEVICE
     let sector = Cstruct.sub page 0 info.B.sector_size in
     B.read device 0L [ sector ] >>|= fun () ->
     ( match Boot_sector.unmarshal sector with
-      | `Error _ -> return None
-      | `Ok boot ->
+      | Error _ -> return None
+      | Ok boot ->
         match Boot_sector.detect_format boot with
-        | `Error reason -> return None
-        | `Ok format ->
+        | Error reason -> return None
+        | Ok format ->
           read_sectors boot.Boot_sector.bytes_per_sector device (Boot_sector.sectors_of_fat boot) >>= fun fat ->
           read_sectors boot.Boot_sector.bytes_per_sector device (Boot_sector.sectors_of_root_dir boot) >>= fun root ->
           return (Some { boot; format; fat; root }) ) >>= fun fs ->

lib_test/test.ml

@@ -98,12 +98,12 @@ let test_chains () =
     let open Boot_sector in
     read_sector "lib_test/bootsector.dat" >>= fun bytes ->
     let boot = match unmarshal bytes with
-      | `Error x -> failwith x
-      | `Ok x -> x in
+      | Error x -> failwith x
+      | Ok x -> x in
     let printer = function
-      | `Error e -> e
-      | `Ok x -> Fat_format.to_string x in
-    assert_equal ~printer (`Ok Fat_format.FAT16) (Boot_sector.detect_format boot);
+      | Error e -> e
+      | Ok x -> Fat_format.to_string x in
+    assert_equal ~printer (Ok Fat_format.FAT16) (Boot_sector.detect_format boot);
     read_whole_file "lib_test/root.dat" >>= fun bytes ->
     let all = Name.list bytes in
     read_whole_file "lib_test/fat.dat" >>= fun fat ->
@@ -125,8 +125,8 @@ let test_parse_boot_sector () =
     let open Boot_sector in
     read_sector "lib_test/bootsector.dat" >>= fun bytes ->
     let x = match unmarshal bytes with
-      | `Error x -> failwith x
-      | `Ok x -> x in
+      | Error x -> failwith x
+      | Ok x -> x in
     let check x =
       assert_equal ~printer:(fun x -> x) "mkdosfs\000" x.oem_name;
       assert_equal ~printer:string_of_int 512 x.bytes_per_sector;
@@ -145,8 +145,8 @@ let test_parse_boot_sector () =
     let buf = alloc sizeof in
     marshal buf x;
     let x = match unmarshal buf with
-      | `Error x -> failwith x
-      | `Ok x -> x in
+      | Error x -> failwith x
+      | Ok x -> x in
     check x;
     return () in
   Lwt_main.run t